C Copyright(c) 1999, Space Science and Engineering Center, UW-Madison C Refer to "McIDAS Software Acquisition and Distribution Policies" C in the file mcidas/data/license.txt C *** $Id: smpaddepnt.f,v 1.0 1999/09/28 14:38:32 russd Tst $ *** C ? SMPADDEPNT - McIDAS ADDE point interface sample C ? SMPADDEPNT sdataset C ? Parameters: C ? sdataset | source dataset name (group/description.pos) C ? Keywords: C ? SELect=' select ' | list of point selection criteria C ? PARam=' param ' | list of point parameters to return C ? Remarks: C ? McIDAS programing sample. C ? C ? Demonstrate reading point data via ADDE. Point data matching C ? the provided selection conditions are read from a ADDE point C ? server. Specified parameters are listed for all point records C ? matching the request. C ? ---------- subroutine main0 implicit none c --- external functions integer mccmdstr ! character string parameter c --- internal functions integer adde_read_point c --- internal variables character*12 option ! program option string integer status ! function status c **************** Program Body ************** c --- set initial program status to FAILED call MCCODESET( -1 ) c --- fetch the command option status = MCCMDSTR( ' ', 1, ' ', option ) if( status.lt.0 ) return c --- Force the contents of the option string to upper case call MCUPCASE( option ) status = adde_read_point () c --- set the program status to SUCCESS call mccodeset( 0 ) call sdest ('Done...', 0) return end ** Name: ** adde_read_point - ADDE point data interface function ** ** Interface: ** integer function ** adde_read_point( ) ** ** Input: ** none ** ** Input and Output: ** none ** ** Output: ** none ** ** Return values: ** 0 - Success ** -1 - Failed ** ** Remarks: ** illustrates basic ADDE point API utilities ** ** Categories: ** adde ** point integer function adde_read_point( ) implicit none include 'ptparm.inc' c --- internal constants integer MAXSEL ! max number of selections conditions parameter (MAXSEL = 12) integer MAXBYTES ! max number of bytes to be returned by parameter (MAXBYTES = MAXNUMPARM * 4)! server c --- external functions character*12 cff ! float to string character*12 cfi ! integer to string integer mccmdstr ! get command line string integer m0dsnnam ! parse dataset name into components integer m0ptget ! open connection to read a point integer m0ptparm ! extract parameter information from ! command line integer m0ptrd ! read a point data block from server integer m0psort ! get the selection parameters from ! the command line and adds them to a ! selection array integer m0ptbufinit ! initialize datablock parser integer m0ptbufc ! return character from datablock integer m0ptbufi ! return integer from datablock integer m0ptbuff ! return real from datablock c --- internal functions c --- internal variables character*12 parms(MAXNUMPARM) ! list of parameters returned ! from server character*12 units(MAXNUMPARM) ! list of parameters returned ! from server character*12 forms(MAXNUMPARM) ! list of formats returned from ! from server for each parameter character*12 cpos ! position number (character) character*12 cval ! value as character character*40 dataset ! name of source dataset character*40 input_dataset ! name of source dataset character*120 sorts(MAXSEL) integer data_block(MAXNUMPARM) ! data block returned by server integer nsorts ! number of selection clauses integer i ! loop counter integer ival ! value as integer integer err_flag ! error flag integer nparms ! number of parameters integer scales(MAXNUMPARM) ! list of scaling factors returned ! from the server integer status ! return status variable double precision fval ! value as double adde_read_point = -1 c --- get the dataset name from the command line status = mccmdstr (' ', 2, ' ', input_dataset) if (status .le. 0) then call edest ('Unable to get dataset name', 0) return endif adde_read_point = -2 c --- build the selection conditions c --- tell the server we want all matching point records nsorts = 1 sorts(nsorts) = 'MAX= ALL' c --- extract the position from the dataset name. Needed for the call to c --- M0PSORT. status = M0DSNNAM (input_dataset, dataset, cpos, cval, 1) if (status .lt. 0) then call edest ('Error parsing dataset name', 0) return endif c --- parse the SELECT= and PARAM= strings from the command line and convert c --- them into select clauses to send to the server. The third parameter is c --- blank to specify to the server to locate the position in the dataset c --- If you wish to specifically specify a point file within the dataset, then c --- pass this position number to the function status = M0PSORT (nsorts, sorts, cpos) if (status .lt. 0) then call edest ('Error building select clauses', 0) return endif c --- Initialize the parm, units, and forms arrays. This must be done c --- otherwise the call to M0PTGET may not function properly. do i=1, MAXNUMPARM parms(i) = ' ' units(i) = ' ' forms(i) = ' ' end do c --- parse the PARAM= strings from the command line. This returns the c --- parameter and unit lists we later pass into the M0PTGET call later status = M0PTPARM (nparms, parms, units) if (status .lt. 0) then call edest ('Error getting parameter and unit lists', 0) return endif do 100 i=1, nsorts call sdest ('select='//sorts(i), 0) 100 continue c --- open connection to the server for this request err_flag = 1 status = M0PTGET (dataset, nsorts, sorts, nparms, parms, & units, forms, scales, MAXBYTES, err_flag) if (status .lt. 0) then call edest ('Error connecting to point server', status) return endif c --- initialize the system so m0ptbufc/f/i can be used to c --- extract the buffer values status = M0PTBUFINIT (nparms, forms, scales) if (status .lt. 0) then call edest ('Error initializing buf parser', 0) return endif call sdest (' ', 0) call sdest (' Params Units Form Scale', 0) do 110 i=1, nparms call sdest (' '//parms(i)//' '//units(i)//' '//forms(i)// & ' ', scales(i)) 110 continue c --- Read each point data block call sdest (' ', 0) call sdest (' Data Records.....', 0) 150 continue status = M0PTRD (data_block) if (status .lt. 0) then call edest ('Error reading point data block', 0) return endif if (status .eq. 1) return c --- print out each requested parameter. Use the functions m0ptbufc/f/i c --- to retreive the values from the data_block call sdest (' ', 0) do 200 i=1, nparms if (forms(i) .eq. 'C4') then status = M0PTBUFC (i, data_block, cval) call sdest (' '//parms(i)//' '//cval, 0) endif if (forms(i) .eq. 'F4') then status = M0PTBUFF (i, data_block, fval) cval = cff (fval, 2) call sdest (' '//parms(i)//' '//cval//' '//units(i), 0) endif if (forms(i) .eq. 'I4') then status = M0PTBUFI (i, data_block, ival) cval = cfi (ival) call sdest (' '//parms(i)//' '//cval//' '//units(i), 0) endif 200 continue goto 150 return end