C Copyright(c) 1997, 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: m0ptget.f,v 1.26 1999/05/06 19:22:44 russd Rel $ ***

*$ Name:
*$      m0ptget - client stub to McIDAS MD parameter server
*$
*$ Interface:
*$      integer function
*$      m0ptget(character name, integer nsort, character sort(*),
*$              integer asknparm, character askparms(*),
*$              character askunits(*), character form(*),
*$              integer gotscales(*), integer maxbytes,
*$              integer msgflg)
*$
*$ Input:
*$      name      - ADDE dataset name or nickname
*$      nsort     - number of search condition clauses in the sort array
*$      sort      - array of search condition clauses
*$      maxbytes  - max. number of bytes which mcmdrd call should return
*$      msgflg    - zero means suppress textual error messages
*$
*$ Input and Output:
*$      asknparm  - number of parameters requested
*$                - if zero on input, filled in with the total number
*$                - of parameters
*$      askparms  - list of parameters requested
*$                - if blank on input, filled with all params contained
*$                - in file
*$      askunits  - units in which the parameters will be returned
*$                - if blank, filled in with source format
*$
*$ Output:
*$      form      - array of forms for each param ('f4', 'i4' or 'c4')
*$
*$      gotscales - array of scaling factors for floating point values
*$
*$ Return values:
*$      0 - success
*$     <0 - failure
*$
*$ Remarks:
*$      Sort clauses are of the form KEYWORD=VAL1[UNIT1] VAL2[UNIT2] ...
*$      The units are optional and default to the native units stored
*$      in the file.
*$
*$      Example: sort(1) =  MAX=1
*$               sort(2) =  POS=2
*$               sort(3) =  PARM=T[F] TD ID
*$               sort(4) =  TRACE=0
*$               sort(5) =  SELECT='T 50 TO 60 F' 'TIME 12'
*$
*$      Select cluases can be used to specify several constraints
*$      in one sort clause. An entire SELECT cluase constitutes one
*$      SORT clause. The format looks like this:
*$
*$      SELECT= 'param val1 TO val2 [unit]' 'param val1,val2,val3'
*$
*$      Values separated by a space denote a range of values (low to
*$      high). Values separated by commas denote a list of specific
*$      values. In both cases [unit] is optional. Single quotes
*$      encapsulate the parameter for the SELECT keyword.
*$
*$      Example: SELECT= 'T 50 TO 60 F' 'ID MSN,LNR,MKE' 'TIME 12'
*$
*$ Categories:
*$      point

      integer function m0ptget
     & (name, nsort, sort, asknparm, askparms, askunits,
     &  form, gotscales, maxbytes, msgflg)

      implicit none

c --- parameters
      character*(*)	form(*)
      character*(*)	askparms(*)
      character*(*)	name
      character*(*)	sort(*)
      character*(*)	askunits(*)
      integer	asknparm
      integer	msgflg
      integer	nsort
      integer	maxbytes

c --- symbolic constants & shared data
      include 'hex80.inc'
      include 'ptparm.inc'		! general point source parameters

      integer	miss		
      parameter	(miss = hex80)		! missing value code

c --- external functions
      character*4	clit		! integer -> character
      character*12	cfu		! integer -> character (left just)
      integer		lit		! character -> integer conversion
      integer		len_trim 	! length of a character string
      integer		m0catstr 	! builds server request string
      integer		m0cxread 	! read from the server pipe
      integer		m0cxreq		! initiates server transaction
      integer		m0ptrd		! reads output from pt server
      integer   	m0pttot		! reads total number bytes sent
      integer		m0split		! resolves and splits dataset name
      integer		mcucvtr		! unit conversion
      integer   	mddates 	! CYD, SYD, YYDD conversions
      integer 		m0ptmem		! dynamic memory alloc for derive 
      integer		m0ptmwt		! dynamic memory write for derive
      integer		m0ptmrd		! dynamic memory read for derive
      integer		m0ptmfre	! free dynamic memory  
      real		ftime		! time conversion


c --- internal functions
      integer		pt_derive 	! evaluate a equation for derived parm 
      integer		pt_parms 	! get the parm list for derived parm
      integer		pt_read 	! read server pipe for derived parm


c --- local variables
      character*1       cblank		! blank character
      character*4	cparm		! temporary parameter name
      character*4	cunit		! temporary unit name
      character*4	ctemp		! generic char variable
      character*4       ctemp1		! generic char variable
      character*12      ctemp2		! generic char variable
      character*12	gotform(MAXNUMPARM)! formats to use in entry point
      character*80	Parm		! derivation parameter name
      character*80	Xparm_units(MAXNUMPARM) ! extended param units
      character*80	Xparm_list(MAXNUMPARM)  ! extended param names
      character*80	Xparm_forms(MAXNUMPARM) ! extended param formats
      character*80	Vars(MAXNUMPARM) ! derivation variable names
      character*32	verstr		! version number string
      character*80	pt_name
      character*128	err		! error string
      character*(MAXPTREQLEN) tempname 	! request to server
      character*(MAXPTREQLEN)serverreq 	! request to server
      character*(MAXPTNAMLEN)splitname 	! dataset name without '/'
      character*(MAXSORTLEN)math	! math equation string
      character*(MAXSORTLEN)parm_string ! parameter string
      character*(MAXSORTLEN)select_string ! select string
      integer		beg		! beginning of sub_string
      integer		count		! record counter
      integer		datarec(MAXNUMPARM) ! one data record from server
      integer		derive(MAXNUMPARM) ! derive clauses)       
      integer		end		! end of a sub_string
      integer		morebytes 	! dummy variable to read from server
      integer		gotbytes 	! number of bytes returned from server
      integer		gotnparm 	! number of parms returned from server
      integer		gotparm(MAXNUMPARM)   ! paramters returned from server
      integer		gotscales(MAXNUMPARM) ! scaling factors returned from server
      integer		gotunits(MAXNUMPARM)  ! units returned from server
      integer		ibuf(*)		! buffer to return one data record
      integer		ii		! loop index
      integer		IParm		! derivation parameter index
      integer		istat		! function return status
      integer   	ival 		! output variable from conversion functions
      integer		IVars(MAXNUMPARM) ! derivation variable record indicies
      integer		jj		! loop index
      integer		jbuf(MAXNUMPARM) ! dynamic memory record array
      integer		iaskparms(MAXNUMPARM) ! requested parms
      integer		iaskunits(MAXNUMPARM) ! requested units
      integer		kk		! loop index
      integer		left		! sub_string left hand pointer
      integer		len		! generic length of a character string
      integer		len_pt_name     ! length of pt_name char string
      integer		litchar		! int representation of 'char'
      integer 		nderive		! number of derived parameter clauses
      integer		nother		! number of unclassified clauses
      integer 		nrequest 	! number of requests
      integer 		nselect		! number of select clauses
      integer 		nsource 	! number of source clauses
      integer		NVars		! derivation number of variables
      integer		other(MAXNUMPARM) ! unclassified clauses
      integer		P0_flag		! current request is type P0
      integer		P0_parm_pos 	! pointer to P0 request PARM sort clause 
      integer		P0_select_pos 	! pointer to P0 request SELECT sort clause
      integer		parm_pos 	! pointer to current PARM clause
      integer		printerr 	! flag to print error messages
      integer		rc		! return code for this function
      integer		req 		! request counter
      integer           request(MAXNUMPARM) ! request clauses
      integer		right		! sub_string right hand pointer
      integer		scales(MAXNUMPARM) ! scaling factor
      integer           select(MAXNUMPARM) ! select clauses
      integer		select_pos 	! pointer to current select clause
      integer		size		! derivation first pass counter
      integer		SParm		! derivation parameter scale
      integer           source(MAXNUMPARM) ! source clauses
      integer		status		! function status
      integer		SVars(MAXNUMPARM) ! derivation variavle scales
      integer		total		! entry point total bytes
      integer   	totbytsent 	! total bytes sent server to client
      integer   	totrecords 	! total number of records received
      integer		usage		! dynamic record write usage type
      integer		Xparm_index(MAXNUMPARM) ! extended parameter index 
      integer		Xparm_scales(MAXNUMPARM) ! extended parameter scales
      integer		Xparm_used(MAXNUMPARM) ! extended parameter used
      integer		Xparm_num	! number of extended parameters
      integer		Xparm_pos 	! position of XPARM_LIST clause
      integer		Xparm_lat	! record index for the LAT key
      integer		Xparm_lon	! record index fo rthr LON key
      integer		Xparm_nindex	! number of extended parameter indiciesr
      integer		Xparm_nscales 	! number of extended parameter scales
      real		floatdat(MAXNUMPARM) ! equivalenced data value in record
      real		rval		! generic real value
      real		scaledval 	! data value after scaling applied


c --- variables for derivation
      
      equivalence( ival, rval )

c
c--- equivalence floating point and
c--- integer variables in a data record
c

      equivalence(floatdat, datarec)


c
c--- initialize return code and total number of records received
c

      rc = 0
      totrecords = 0

      totbytsent = 0

c
c--- initialize server request string to blank
c

      serverreq = ' '

c
c--- flag for printing errors
c

      printerr = msgflg

c
c--- save the integer representation
c--- of the word 'char'
c

      litchar = lit('CHAR')



c--- Determine if the request contains derived parameters
c    Here we examine the sort clauses recieved from the 
c    application. We identify the clause type, count them 
c    and log their positions in the sort clause array.
c    The existance of Pnn_ type sort clauses indicates that
c    the application is requesting derived parameter(s). 

c --- initialize pointers and counters
      usage = 0
      nderive = 0
      nrequest = 0
      nselect = 0
      nsource = 0
      nother = 0
      parm_pos = 0
      select_pos = 0
      P0_parm_pos = 0
      P0_select_pos = 0
      Xparm_pos = 0

c --- zero the pointer arrays
      do 3000 ii=1,MAXNUMPARM
      select(ii) = 0
      request(ii) = 0
      source(ii) = 0
      derive(ii) = 0
      other(ii) = 0
3000  continue

c --- identify the sort clauses
      do 3100 ii = 1, nsort

c --- tabulate derived parameters
      if( sort(ii)(1:1).eq.'*' ) then
         nderive = nderive+1
         derive(nderive) = ii
         goto 3100
      endif

c --- find the X-tended parameter strings
      if( sort(ii)(1:11).eq.'XPARM_LIST=' ) then
         Xparm_pos = ii
         goto 3100
      endif

c --- tabulate the PARM strings
      status = index( sort(ii), '_PARM=' )
      if( status.ne.0 ) then
         if( sort(ii)(1:3).eq.'P0_' ) then
            P0_parm_pos = ii
         else
            nrequest = nrequest+1
            request(nrequest) = ii
         endif
         goto 3100
      endif

c --- tabulate the SELECT strings
      status = index( sort(ii), '_SELECT=' )
      if( status.ne.0 ) then
         if( sort(ii)(1:3).eq.'P0_' ) then
            P0_select_pos = ii
         else
            nselect = nselect+1
            select(nselect) = ii
         endif
         goto 3100
      endif

c --- tabulate the SOURCE strings
      status = index( sort(ii), '_SOURCE=' )
      if( status.ne.0 ) then
         nsource = nsource+1
         source(nsource) = ii
         goto 3100
      endif

c --- find the PARM string
      status = index( sort(ii), 'PARM=' ) 
      if( status.ne.0 ) then
         parm_pos = ii
         goto 3100
      endif

c --- find the SELECT string
      status = index( sort(ii), 'SELECT=' ) 
      if( status.ne.0 ) then
         select_pos = ii
         goto 3100
      endif

c --- tabulate all other strings
      nother = nother+1
      other(nother) = ii

3100  continue


c --- break down the Xparm_list string
c     We have the position of the sort clause that is the list of
c     extended parameters for the transaction. This code segment 
c     fills the Xparm list array and counts the number of total 
c     parameters. Once we know how many parameters are in the 
c     transaction, we can allocate memory for the data as it is
c     transfered from the server. 
      if( Xparm_pos.ne.0 ) then
         Xparm_num = 0
         len = len_trim( sort(Xparm_pos) ) +1
         sort(Xparm_pos)(len:len) = ' '
         left = index( sort(Xparm_pos), '=' ) + 1
3110     continue
            right = left + index( sort(Xparm_pos)(left:len), ' ' ) -1 
            Xparm_num = Xparm_num+1
            Xparm_list(Xparm_num) = sort(Xparm_pos)(left:right-1)
            if( Xparm_list(Xparm_num).eq.'LAT' ) Xparm_lat = Xparm_num
            if( Xparm_list(Xparm_num).eq.'LON' ) Xparm_lon = Xparm_num
            left = right + 1
         if( left.lt.len ) goto 3110
         Xparm_nindex = 0
         Xparm_nscales = 0

      endif

         
c --- zero the used array
      call zerow( MAXNUMPARM, Xparm_used )


c --- Main request loop 
c     At this point we know how many requests are necessary to
c     satisfy the transaction. If NREQUEST is 1, we will follow 
c     the "normal" proceedure of generating the request, confirming
c     the transaction and returning directly to the application.
c     If NREQUEST is greater than 1, we will generate a series of 
c     requests. Once each request is validated, the pipe is drained 
c     into dynamic memory records. This process is repeated until 
c     all the requests have been exhausted. 

      do 9000  req = 0, nrequest
      serverreq = ' '

c --- handle multiple requests
      if( nderive.ne.0 ) then 

c ------ first time through multi-request 
         if( req.eq.0 ) then 

c --------- Initialize memory list
c           On the initial pass through a multi-request transaction,
c           dynamic memory is allocated to hold the total number of
c           parameters for 1000 records. If more records are needed,
c           the write routine (M0PTMWT) will reallocate another 1000
c           records, until the initial request is exhausted. d
            if( m0ptmem( Xparm_num ).ne.0 ) then
               call edest('Unable to alloacte memory for lists',0)
               rc = -32002
               return
            endif

c --------- Check for P0_PARM request
c           The P0_ request is special because it holds all the parameters
c           which are not part of the derivation process. It will controll
c           how many records are stored in the initial allocation of memory 
c           and therefore how many records will be returned by the client 
c           to the application
            if(P0_parm_pos.ne.0 ) then
               status = pt_parms( sort(P0_parm_pos),          
     &                            asknparm, iaskparms, askunits )
               ii=index( sort(P0_parm_pos), '_' ) + 1
               len = len_trim( sort(P0_parm_pos) ) 
               parm_string = sort(P0_parm_pos)(ii:len) 
               ii=index( sort(P0_select_pos), '_' ) + 1
               len = len_trim( sort(P0_select_pos) ) 
               select_string = sort(P0_select_pos)(ii:len)

c ------------ identify the parameters in the Xparm list
               len = len_trim( parm_string ) + 1
               left = index( parm_string, '=' ) + 1
3200           continue
                  right=left+index(parm_string(left:len),' ')-1 
                  do 3210 ii = 1, Xparm_num
                  if( Xparm_used(ii).eq.0 ) then
                     if(Xparm_list(ii).eq.parm_string(left:right-1))then
                        Xparm_nindex = Xparm_nindex+1
                        Xparm_index(Xparm_nindex) = ii
                        Xparm_used(ii) = 1
                        goto 3211
                     endif
                  endif
3210              continue
3211              left = right + 1
                  if( left.lt.len ) goto 3200

c --------------- set P0_flag to indicate that the request is type P0           
                  P0_flag = 1

            else
               goto 9000

            endif

c ------ Non-P0 requests
c        All requests which are not type P0, are requests for parameters 
c        which are necessary to perform a derivation. These parameters 
c        are sent to the server parameter-by-parameter until the request 
c        spool is emptied. each of these requests includes the parameter
c        plus LAT and LON keys. The LAT and LON keys act to identify the 
c        matching P0 record in memory. Only the value for the parameter 
c        is written into memory (LAT and LON are discarded as soon as a 
c        record is matched).  
         else
            status = pt_parms( sort(request(req)),          
     &                             asknparm, iaskparms, askunits )
            ii=index( sort(request(req)), '_' ) + 1
            len = len_trim( sort(request(req)) )
            parm_string = sort(request(req))(ii:len)
            len = len_trim( sort(select(req)) ) + 1
            select_string = sort(select(req))(ii:len)

c --------- identify the parameters in the Xparm list
            Xparm_nindex = 0
            right = index( sort(request(req)), '_' ) - 1
            do 3310 ii = 1, Xparm_num
            if( Xparm_used(ii).eq.0 ) then
               if( Xparm_list(ii).eq.sort(request(req))(1:right) ) then
                  Xparm_nindex = Xparm_nindex+1
                  Xparm_index(Xparm_nindex) = ii
                  Xparm_used(ii) = 1
                  goto 3311
               endif
            endif
3310        continue
3311        Xparm_nindex = Xparm_nindex+1
            Xparm_index(Xparm_nindex) = Xparm_lat
            Xparm_nindex = Xparm_nindex+1
            Xparm_index(Xparm_nindex) = Xparm_lon
 
c --------- set P0_flag to indicate that the request is NOT type P0           
            P0_flag = 0

         endif

c --- Handle single request
c     This is the code segment for the standard single request transaction.
c     It is only necessary to populate the parameter arrays prior to sending
c     the request to the server. In this case, once the request is validated
c     control passes back to the application. Calls to M0PTRD bail the pipe 
c     one record at a time. No dynamic memory allocation is necessary. 
      else
c ------ transform the requested parms (askparms) from character
c        to integer (iaskparms) to pass along to server
c
c ------ !! NOTE: There is a 4 character limit on the parm name !!
c
         do 10 ii=1, asknparm
         ctemp = askparms(ii)
         call movcw(ctemp, iaskparms(ii))
  10     continue

      endif

c
c************** BUILD REQUEST ***************
c


c--- the dataset name is the first thing on the request string
c
      istat = m0split(name, splitname)
	
      call ddest('m0split returns ',istat)

      if (istat .ne. 0) then

	 if (istat .eq. -2) then
	    tempname = name
	    call edest(tempname(1:len_trim(tempname))//
     &		' is an invalid group/descriptor or alias name',0)
	 endif

	 rc = -32001
	 goto 1000


      endif

      istat = m0catstr(serverreq, splitname)

      if (istat .ne. 0) then

	 rc = -32002
	 goto 1000

      endif


c --- build request string from input sort conditions

c --- handle multi-request 
      if( nrequest.gt.0 ) then
         istat = m0catstr(serverreq, parm_string ) 
         if (istat .ne. 0) then
            rc = -32002
            goto 1000
         endif
         istat = m0catstr(serverreq, select_string ) 
         if (istat .ne. 0) then
            rc = -32002
            goto 1000
         endif
         do 3020 ii=1,nother 
         istat = m0catstr(serverreq, sort(other(ii)) )    
         if (istat .ne. 0) then
            rc = -32002
            goto 1000
         endif
3020     continue

c ------ remove units
3021     continue
         len = len_trim( serverreq )
         left = index( serverreq, '[' )
         right = index( serverreq, ']' )
         if( left.ne.0 .and. right.ne.0 ) then
            serverreq = serverreq(1:left-1)//serverreq(right+1:len)
            goto 3021
         endif

c --- handle single request
      else
         do 20 ii=1, nsort
         istat = m0catstr(serverreq, sort(ii))
         if (istat .ne. 0) then
            rc = -32002
            goto 1000
         endif
20       continue

      endif

c
c--- add version number onto server request string
c

      write(verstr, FMT='(a8,i4)') 'VERSION=', VERSION

      istat = m0catstr(serverreq, verstr)

      if (istat .ne. 0) then

	 rc = -32002
	 goto 1000

      endif

c
c--- just to be safe, squeeze the blanks from
c--- the server reqquest string
c

      call bsquez(serverreq)

      call ddest(serverreq(1:72), 0)
      call ddest(serverreq(73:144), 0)

c
c************** SERVER CALL ***************
c

      istat = m0cxreq
     & ('MDKS', serverreq, BYTESPERPARM*asknparm, iaskparms, gotbytes)

      if (istat .ne. 0) then

	  rc = istat
          if (printerr .ne. 0) call m0cxerms

          goto 1000

      endif

c
c--- check to see if the server returned more data
c--- than the specified maximum (we bit off more
c--- than we could chew)
c

      if (gotbytes .gt. maxbytes) then

          rc = -32004

          if (printerr .ne. 0) then

	     call edest('Request exceeds maximum number of bytes', 0)
	     call edest('Maximum bytes allowed is: ', maxbytes)
	     call edest('Actual bytes returned is: ', gotbytes)

          endif

          goto 1000

      endif

c
c--- calculate the number of parameters returned
c--- based on the number of bytes returned
c--- and the number of bytes per parameter
c

      gotnparm = gotbytes / BYTESPERPARM

c
c************** PARAMETERS ***************
c

c
c--- read the parameters from the server
c

      istat = m0cxread(gotbytes, gotparm)
      totbytsent = totbytsent + gotbytes

      if (istat .ne. 0) then

	  rc = istat

          if (printerr .ne. 0) then

	     call edest('Unable to read parameter labels from server',0)

          endif

          goto 1000

      endif

c
c--- if asknparm = 0, all of the parameters present
c--- in the file were requested. adjust the number
c--- of parameters (asknparm) to the total number of
c--- parameters returned
c

      if (asknparm .eq. 0) then

         asknparm = gotnparm

         do 50 ii=1,gotnparm

            askparms(ii) = clit(gotparm(ii))

 50      continue

      endif

c
c************** UNITS ***************
c

c
c--- read units from server with
c--- four bytes of dummy of the front
c

      istat = m0cxread(4, morebytes)
C---do not add in these overhead values!
C      totbytsent = totbytsent + 4

      call swbyt4(morebytes, 1)

      istat = m0cxread(morebytes, gotunits)
      totbytsent = totbytsent + morebytes

      if (istat .ne. 0) then

	  rc = istat

          if (printerr .ne. 0) then

	     call edest('Unable to read unit labels from server', 0)

          endif

          goto 1000

      endif

c
c--- determine intended units to be returned
c--- and store an integer representation for
c--- comparison later. also save form of the
c--- data (either floating point or character)
c

      do 60 ii=1,gotnparm

c
c--- if units were not specified for this parameter,
c--- store the native units. if the units were specified,
c--- then store the requested units.
c

         
         if (askunits(ii)(1:1) .eq. ' ') then

            askunits(ii) = clit(gotunits(ii))
	    if( askunits(ii)(1:1).eq.'"' ) askunits(ii) = '    '
            iaskunits(ii) = gotunits(ii)
c           if(askunits(ii).eq.'SYD'.or.askunits(ii).eq.'YYDD')then
c              askunits(ii)='CYD'
c              iaskunits(ii)=lit('CYD ')
c           endif

	 else

            ctemp = askunits(ii)
            iaskunits(ii) = lit(ctemp)

         endif

c
c--- output form will default to floating
c--- point, but can be character
c

         form(ii) = 'F4'
         if (gotunits(ii) .eq. litchar) form(ii) = 'C4'

 60   continue

c
c************** SCALES ***************
c

c
c--- read scales from server with
c--- four bytes of dummy of the front
c

      istat = m0cxread(4, morebytes)
C---do not add in the overhead values

      call swbyt4(morebytes, 1)

      istat = m0cxread(morebytes, gotscales)
      totbytsent = totbytsent + morebytes

      if (istat .ne. 0) then

	  rc = istat

          if (printerr .ne. 0) then

	     call edest('Unable to read scale factors from server', 0)

          endif

          goto 1000

      endif

c
c--- flip scaling factors
c

      call swbyt4(gotscales, asknparm)

c
c--- if there is no scaling, and the
c--- parm is not a character, then adjust
c--- the form to integer
c

      do 65 ii=1,gotnparm

	 scales(ii) = gotscales(ii)

	 if (gotscales(ii) .eq. 0 .and. form(ii)(1:1) .ne. 'C') then

	    form(ii) = 'I4'

	 endif

	 gotform(ii) = form(ii)

 65   continue

c --- Handle multiple requests
c     At this point in a multi-request transaction, the code 
c     again diverges. We have validated a request for data. 
c     Single request data transactions return to the application
c     at this point. Multi-request transactions must bleed the 
c     pipe and then spool the record to memory. During the first 
c     request (P0_ request) dynamic memory is allocated and re-allocated 
c     until the pipe is drained. The record count at this point is 
c     the maximum number of records for this transaction. All other 
c     requests will have their data matched to existing records 
c     gathered during the initial request. 
      if( nrequest.gt.0 ) then

c ------ make a list of the scales for each Xparm
         if( P0_flag.eq.1 ) then
            end = gotnparm
         else
            end = gotnparm-2
         endif
         do 3800 ii= 1, end
         Xparm_units(Xparm_index(ii)) = clit( askunits(ii))
         Xparm_forms(Xparm_index(ii)) = form(ii)
         Xparm_scales(Xparm_index(ii)) = scales(ii)
3800     continue

c ------ read a record from the server pipe
         count = 0
3900     status = pt_read (count, gotnparm, gotunits, gotform, 
     &                      iaskparms, iaskunits, scales, 
     &                      printerr, jbuf)
         if( status.lt.0 ) then
            rc = -1
            goto 1000

         elseif (status.eq.0 ) then

c --------- write record to memory
            status = m0ptmwt( usage, 0, Xparm_nindex, Xparm_index, 
     &                        Xparm_lat, Xparm_lon, jbuf )
            if( status.lt.0 ) then
               if( usage.eq.0 ) then
                  call edest('Failed to write record to memory',0)
                  rc = -32002
                  return
               endif

c --------- increment the record counter
            else
               count = count+1

            endif
 
            goto 3900
         endif
         if( usage.eq.0 ) size = count

      endif
      call ddest('Number of records filed =', count)
      
c --- reset the usage flag to type 1 write (match lat/lon index) 
      usage = 1

c --- bottom of main loop
9000  continue



c --- Evaluate any derived values
c     We have now exhausted the request phase of a multi-request 
c     transaction. Hopefully (just kidding), we now have all the 
c     parameters necessary to evaluate and compute the derived 
c     parameter(s). Here we play a little game with the data.
c     The equation analyzer was originaly written to handle GRID 
c     point data only. Instead of re-writting this beast for 
c     POINT data, we instead make the POINT data look like 1
c     dimensional GRID point fields. We then send the data into 
c     the equation analyzer, A MIRACLE HAPPENS and the derived 
c     parameter is returned. The derived values are written into 
c     the dynamic memory records in their reserved locations.
c     PRETTY SLICK - HUH!  
      if( nderive.gt.0 ) then

         do 4100 ii = 1, nderive

c ------ define the parameter name and index 
         right = index( sort( derive(ii) ), '=' ) 
         do 4110 jj = 1, Xparm_num
         if( sort(derive(ii))(1:right-1).eq.Xparm_list(jj) ) then
            Parm = Xparm_list(jj)
            IParm = jj
            SParm = 0
            goto 4111
         endif
4110     continue
         goto 4100

c ------ define the math expression
4111     continue
         left = right+1
         right = len_trim( sort(derive(ii)) )
         math = sort(derive(ii))(left+1:right-1)

c ------ define the variable names, indicies and scales
         beg = left
         len = right+1
         left = 0
         NVars = 0
         do 4120 jj = beg,len
         if( sort(derive(ii))(jj:jj).eq.'P' ) then
            left = jj
            if( 
     &           sort(derive(ii))(jj+1:jj+1).lt.'0' .or.
     &           sort(derive(ii))(jj+1:jj+1).gt.'9' 
     &         ) left = 0
         elseif( sort(derive(ii))(jj:jj).ge.'0' .and.
     &           sort(derive(ii))(jj:jj).le.'9'       ) then
            if( left.ne.0 ) right = jj
         else
            if( left.ne.0 ) then
               ctemp2 = sort(derive(ii))(left:right)
               do 4115 kk = 1, Xparm_num
               if( ctemp2.eq.Xparm_list(kk) ) then
                  NVars = NVars+1
                  IVars(Nvars) = kk
                  Vars(NVars) = Xparm_list(kk)
                  SVars(NVars) = Xparm_scales(kk)
                  goto 4116
               endif
4115           continue
               goto 4100
4116           left = 0
            endif
         endif
4120     continue

         call ddest(' ',0)
         call ddest('*** DERIVED PARAMETER ***',0)
         len = len_trim( Parm )
         call ddest('   Parameter = '//Parm(1:len)//
     &              ' at index = ',IParm)
         len = len_trim( math )
         call ddest('   Equation = '//math(1:len)//           
     &              ' for total #points =', size)
         do 4121 kk = 1,NVars
         len = len_trim( Vars(kk) )
         ctemp2 = cfu( IVars(kk) )
         right = len_trim( ctemp2 )
         call ddest('   Variable ='//Vars(kk)(1:len)//
     &              ' at index = '//ctemp2(1:right)//
     &              ' scale = ',SVars(kk) )
4121     continue
        

c ------ derive the parameter
         status = pt_derive(math, size,
     &                       NVars, Vars, IVars, SVars,
     &                              Parm, IParm, SParm )
         if(status.lt.0 ) then
            m0ptget = -32009
            return 
         endif

c ------ create scale, unit and form entries for the derived Parm
         Xparm_scales(IParm) = SParm
         Xparm_units(Iparm) = ' '
         Xparm_forms(IParm) = 'F4'

4100     continue


c ------ fill return arrays
         asknparm = Xparm_lat - 1
         NVars = asknparm
         do 4200 ii = 1, asknparm

         pt_name = Xparm_list(ii) 
         len_pt_name = len_trim( pt_name )
         left = index( pt_name, '[')
         right = index( pt_name, ']') 
         if( left.ne.0 .and. right.ne.0 ) len_pt_name = left-1
         if( pt_name(1:1).eq.'*' ) then
            askparms(ii) = pt_name(2:len_pt_name)
            if( left.ne.0 .and. right.ne.0 ) 
     &         Xparm_units(ii) = pt_name(left+1:right-1)
         else
            askparms(ii) = pt_name(1:len_pt_name)
         endif

         askunits(ii) = Xparm_units(ii) 
         gotscales(ii) = Xparm_scales(ii) 
         form(ii) = Xparm_forms(ii) 
         IVars(ii) = ii
4200     continue 

 
      endif


c
c--- set return value and exit
c

 1000 m0ptget = rc

      return

c
c----------------------------------------------------------------------
c

*$ Name:
*$      m0ptrd - entry point to read point source data from server
*$
*$ Interface:
*$      integer function
*$      m0ptrd(integer ibuf)
*$
*$ Input:
*$      none
*$
*$ Input and Output:
*$      none
*$
*$ Output:
*$      ibuf - array containing one record of point source data
*$
*$ Return values:
*$      1 - end of file
*$      0 - success
*$     <0 - failure
*$
*$ Remarks:
*$      The function m0ptget must be called prior to this function.
*$
*$ Categories:
*$      point

      entry m0ptrd(ibuf)

c
c--- assume success
c

      rc = 0

c --- Check the request type. 
c     If the original request contained derived parameters,
c     the records are already in memory, scaled and converted 
c     to the requested units. All we have to do is spool the 
c     records from memory as though they we being flushed from 
c     the server pipe. The I/O pattern between the client and the
c     application (ie. call MOPTRD until status=1) remains in tact.
      if( nderive.gt.0 ) then

c ------ read the records out of shared memory sequentially
         rc = m0ptmrd( 1, 0, NVars, IVars, ibuf)

c ------ if the return code is 1 -> we have exhauted the record list
c        sequentially. Free the memory
         if( rc.eq. 1 ) status = m0ptmfre()

         m0ptrd = rc 
         return

      endif  



c     ********************* WARNING *************************
c     All the code below this segment is duplicated in the 
c     internal function M0PTREAD! If you modify any portion of 
c     code here, it MUST be replicated in M0PTREAD also!
c     ********************* WARNING *************************



c
c--- read record length
c--- if length is zero, we are at end of file
c

      istat = m0cxread(4, morebytes)
C---do not add in overhead values!
C     totbytsent = totbytsent + 4

      call swbyt4(morebytes, 1)

      if (istat .ne. 0) then

          rc = istat

          if (printerr .ne. 0) then

	     call edest('Unable to read data record from server', 0)

          endif

          goto 2000

      endif


c
c--- check for end of file
c
      if (morebytes .eq. 0) then

          rc = 1

          call m0cxfin

	  if (totrecords .eq. 0 .and. printerr .ne. 0) then

		call m0cxerms
	  endif

          goto 2000

      endif

c
c************** DATA RECORD ***************
c

c
c--- read data record from server
c

      istat = m0cxread(morebytes, datarec)
      totbytsent = totbytsent + morebytes
      call ddest('data record totbytsent: ',totbytsent)

      totrecords = totrecords + 1

      if (istat .ne. 0) then

          rc = istat

          if (printerr .ne. 0) then

	     call edest('Unable to read data record from server', 0)

          endif

          goto 2000

      endif

c
c--- loop through each cell in the data record
c
c--- !! NOTE: datarec (integer) and floatdat (real) are equivalenced !!
c

      do 70 ii=1,gotnparm

c
c--- don't convert missing codes
c

         if (datarec(ii) .eq. miss) goto 70

c
c--- don't convert characters
c

         if (gotform(ii)(1:1) .eq. 'C') goto 70

c
c--- switch cells which are not characters
c

         if (gotunits(ii) .ne. litchar) call swbyt4(datarec(ii), 1)

c
c--- don't convert cells already in requested units and scale
c

         if (iaskunits(ii) .eq. gotunits(ii) .and.
     &       scales(ii) .eq. 0)  go to 70 

c
c--- store this cell as a real value
c

         scaledval = datarec(ii)

c
c--- scale each cell
c

	 if (scales(ii) .ne. 0) then

            scaledval = scaledval / (10.0 ** float(scales(ii)))

	 endif

c
c--- special case of converting 'HMS' to 'H'
c

         if (gotunits(ii) .eq. lit('HMS ') .and.
     &       iaskunits(ii) .eq. lit('H   ')) then

             floatdat(ii) = ftime(datarec(ii))

             goto 70

         endif

c
c--- special case - converting date formats
c
c    all dates go to ccyyddd
c    SYD, YYDD go thru mciydtocyd
c    CYD is not changed

         ctemp2=clit(iaskunits(ii))
         ctemp1=clit(gotunits(ii))
         cblank=' '
c        call ddest('gotunits is '//ctemp1//cblank//ctemp2,0)
 
c        if ((gotunits(ii).eq. lit('SYD ')) .or.
c    &       (gotunits(ii).eq. lit('YYDD')))  then
c            istat = mciydtocyd(datarec(ii),ival)
c            if(istat.lt.0)  then
c               call edest('Cannot convert date to ccyyddd '//
c    &               cfi(datarec(ii)),0)
c            endif
c
c            datarec(ii) = ival
c
c--- all date conversions possible
c--- except SYD-> CYD, and -> YYDD
c--- -1 return means that units were dates, but not consistent
c--- -2 return means that units were not dates, and other
c---    conversions should apply.
c
        istat=mddates(datarec(ii),ival,ctemp1,ctemp2)
c       call ddest('date conversions'//cfi(datarec(ii))//
c    *                                 cfi(ival),0)

        if(istat.eq.0 )  then
           datarec(ii)=ival
           go to 70
        endif

c--- check to see if units were inconsistent.
        if(istat.eq.-1)  then


                rc = -32005

                if (printerr .ne. 0) then

		   cparm = clit(iaskparms(ii))
		   cunit = clit(iaskunits(ii))

		   err = 'Unable to offer ' // cparm
     &					    // ' in units of '
     &					    // cunit

		   call bsquez(err)
      	           call edest(err, 0)

                endif
                goto 70

        endif

c
c--- general unit conversions in floating point
c

         if (iaskunits(ii) .ne. gotunits(ii)) then

            istat = mcucvtr(1, clit(gotunits(ii)), scaledval,
     &                        clit(iaskunits(ii)), floatdat(ii), 0)

            if (istat .ne. 0) then

                rc = -32005

                if (printerr .ne. 0) then

		   cparm = clit(iaskparms(ii))
		   cunit = clit(iaskunits(ii))

		   err = 'Unable to offer ' // cparm
     &					    // ' in units of '
     &					    // cunit

		   call bsquez(err)
      	           call edest(err, 0)

                endif

            endif

c
c--- if this cell is in integer form, convert back from float
c

	    if (gotform(ii)(1:1) .eq. 'I') then
	       datarec(ii) = nint(floatdat(ii))
	    endif

         else

c
c--- requested units match what came back from the server
c

            floatdat(ii) = scaledval

         endif

  70  continue

c
c--- set return code
c

 2000 m0ptrd = rc

c
c--- move the data record into ibuf to
c--- be returned
c

      call movw(gotnparm, datarec, ibuf)

      return

*$ Name:
*$      m0pttot - entry point to give number of bytes transferred
*$
*$ Interface:
*$      integer function
*$      m0pttot
*$
*$ Input:
*$      none
*$
*$ Input and Output:
*$      none
*$
*$ Output:
*$      none
*$
*$ Return values:
*$      0 - success, number of bytes returned
*$     -1 - no bytes returned
*$
*$ Remarks:
*$      The function m0ptget must be called prior to this function.
*$
*$ Categories:
*$      point

      entry m0pttot(total)

      total = totbytsent
      if (total .gt. 0)  then
	 rc = 0
      else
	 rc = -1
      endif
      call ddest('m0pttot totbytsent: ',totbytsent)
      m0pttot = rc
      end


*$ Name:
*$      pt_parms - read data from server to memory
*$
*$ Interface:
*$      integer function
*$		pt_read( character* cparm,
*$			 integer* nparm,
*$			 integer parms(*),
*$			 character* units(*) )
*$
*$ Input:
*$	cparm - parameter string
*$
*$ Input and Output:
*$	none
*$
*$ Output:
*$	nparm - number of parameters
*$	parms - array of parameter names 
*$	units - array of parameter units
*$
*$ Return values:
*$      0 - success
*$     -1 - failed: invalid parms string
*$
*$ Remarks:
*$
*$ Categories:
*$      point
*$	utility

      integer function pt_parms( cparm, nparm, parms, units )
      implicit none
 
c --- parameters
      character*(*)	cparm
      integer		nparm
      integer		parms(*)
      character*(*)	units(*)

c --- external functions
      integer		len_trim
  
c --- internal variables 
      character*12	cvalue
      integer		len
      integer		i
      integer		beg
      integer		start
      integer		left
      integer		right

      nparm = 0
     
c --- get length of the parameter string
      len = len_trim( cparm )
      if( len.le.0 ) then
         pt_parms = -1
         return
      endif

c --- find the = sign
      start = index( cparm, '=' ) + 1
      if( start.le.0 .or. start.gt.len ) then
         pt_parms = -1
         return
      endif

c --- parse the string into components
      beg = 0
      do 100 i = start, len

      if( cparm(i:i).eq.' ' ) then
         if( beg.ne.0 ) then
            cvalue = ' '
            nparm = nparm+1
            cvalue  = cparm(beg:i-1)

c --------- look for embedded units
            left = index( cvalue, '[' ) 
            right = index( cvalue, ']' )
            if( left.ne.0 .and. right.ne.0 ) then
               units(nparm) = cvalue(left+1:right-1)
               cvalue = cvalue(1:left-1)
            else
               units(nparm) = ' '
            endif

            call movcw( cvalue(1:4), parms(nparm) ) 
            beg = 0
         endif

      else
         if( beg.eq.0 ) then
            beg = i
         endif

      endif

100   continue

      if( beg.ne.0 ) then
         cvalue = ' '
         nparm = nparm+1
         cvalue = cparm(beg:len)

c ------ look for embedded units
         left = index( cvalue, '[' ) 
         right = index( cvalue, ']' )
         if( left.ne.0 .and. right.ne.0 ) then
            units(nparm) = cvalue(left+1:right-1)
            cvalue = cvalue(1:left-1)
         else
            units(nparm) = ' '
         endif

         call movcw( cvalue(1:4), parms(nparm) )
      endif

      pt_parms = 0
      return
      end       



*$ Name:
*$      pt_read - read data from server to memory
*$
*$ Interface:
*$      integer function
*$		pt_read( integer init,
*$			 integer gotnparm,
*$			 integer gotunits(*),
*$			 character* gotform(*),
*$			 integer iaskunits(*),
*$			 integer scales(*),
*$			 integer printerr,
*$			 integer ibuff(*) )
*$
*$ Input:
*$	init	- initialization flag
*$      gotnparm - number of parameters per record
*$	gotunits - array of units for each parameter
*$	gotform - array of formats for each parameter
*$	iaskunits - array of requested units
*$	scales - array of scale factors for each parameter
*$	printerr - error message print flag
*$
*$ Input and Output:
*$	none
*$
*$ Output:
*$      ibuff - array to hold a record
*$
*$ Return values:
*$      1 - finished
*$      0 - success
*$     <0 - failed: server error
*$
*$ Remarks:
*$      Reads records from the server/client pipe and places 
*$      records into memory.
*$
*$ Categories:
*$      point
*$	utility

      integer function pt_read (init, gotnparm, gotunits, gotform, 
     &                           iaskparms, iaskunits, scales, 
     &                           printerr, ibuf)
      implicit none

c --- symbolic constants & shared data
      include 'hex80.inc'		! missing value variable
      include 'ptparm.inc'		! general point source parameters

      integer	miss			! missing value code
      parameter	(miss = hex80)

c --- parameters 
      integer		init
      integer		gotnparm
      integer		gotunits(*)
      character*(*)	gotform(*)
      integer		iaskparms(*)
      integer		iaskunits(*)
      integer		scales(*)
      integer		printerr
      integer		ibuf(*)

c --- external functions
      character*4	clit
      integer		lit
      integer		m0cxread
      integer		mddates
      integer           mcucvtr
      real		ftime

c --- internal variables  
      character*1       cblank			! blank character
      character*4	cparm			! parameter name
      character*4       ctemp1			! generic char value	
      character*4	cunit			! unit name
      character*12      ctemp2			! generic char value
      character*80	err 			! error message
      integer		litchar			! literal of 'CHAR'
      integer		istat			! function status
      integer		morebytes		! request byte count
      integer		totbytsent		! byte counter
      integer		totrecords		! record counter
      integer   	datarec(MAXNUMPARM) 	! ordered data record
      integer		ival			! generic init value
      integer		ii			! loop index
      real		floatdat(MAXNUMPARM)	! ordered data record (real)
      real		scaledval		! scaled value

      equivalence(floatdat, datarec)

      litchar = lit('CHAR')

c --- assume success
      pt_read = 0

c --- if( init.eq.0 ) totrecords = 0

c --- if length is zero, we are at end of file
      istat = m0cxread(4, morebytes)
      call swbyt4(morebytes, 1)
      if (istat .ne. 0) then
          if (printerr .ne. 0) then
	     call edest('Unable to read data record from server', 0)
          endif
          pt_read = istat
          goto 2000
      endif

c --- check for end of file
      if (morebytes .eq. 0) then
          pt_read = 1
          call m0cxfin
	  if (totrecords.eq.0 .and. printerr.ne.0) then
		call m0cxerms
	  endif
          goto 2000
      endif

c--- read data record from server
      istat = m0cxread(morebytes, datarec)
      totbytsent = totbytsent + morebytes
      totrecords = totrecords + 1
      if (istat .ne. 0) then
          pt_read = istat
          if (printerr .ne. 0) then
	     call edest('Unable to read data record from server', 0)
          endif
          goto 2000
      endif

c --- loop through each cell in the data record
      do 70 ii=1,gotnparm

c ------ don't convert missing codes
         if (datarec(ii) .eq. miss) goto 70

c ------ don't convert characters
         if (gotform(ii)(1:1) .eq. 'C') goto 70

c ------ switch cells which are not characters
         if( gotunits(ii).ne.litchar ) then
            call swbyt4(datarec(ii), 1)
         endif

c ------ don't convert cells already in requested units and scale
         if (iaskunits(ii).eq.gotunits(ii) .and.
     &      scales(ii) .eq. 0)  go to 70 

c ------ store this cell as a real value
         scaledval = datarec(ii)

c ------ scale each cell
         if (scales(ii) .ne. 0) then
            scaledval=scaledval/(10.0 ** float(scales(ii)))
	 endif

c ------ special case of converting 'HMS' to 'H'
         if (gotunits(ii) .eq. lit('HMS ') .and.
     &      iaskunits(ii) .eq. lit('H   ')       ) then
            floatdat(ii) = ftime(datarec(ii))
            goto 70
         endif

c ------ special case - converting date formats
         ctemp2 = clit(iaskunits(ii))
         ctemp1 = clit(gotunits(ii))
         cblank=' '
         istat=mddates(datarec(ii),ival,ctemp1,ctemp2)
         if(istat.eq.0 )  then
            datarec(ii)=ival
            go to 70
         endif

c ------ check to see if units were inconsistent.
         if(istat.eq.-1)  then
            pt_read = -32005
            if (printerr .ne. 0) then
               cparm = clit(iaskparms(ii))
               cunit = clit(iaskunits(ii))
               err = 'Unable to offer ' // cparm
     &               // ' in units of '
     &               // cunit
	       call bsquez(err)
      	       call edest(err, 0)
            endif
            goto 70
         endif

c ------ general unit conversions in floating point
         if (iaskunits(ii) .ne. gotunits(ii)) then
            istat = mcucvtr(1, clit(gotunits(ii)), scaledval,
     &                      clit(iaskunits(ii)), floatdat(ii), 0)
            if (istat .ne. 0) then
                pt_read = -32005
                if (printerr .ne. 0) then
		   cparm = clit(iaskparms(ii))
		   cunit = clit(iaskunits(ii))
		   err = 'Unable to offer ' // cparm
     &                   // ' in units of '
     &		         // cunit
		   call bsquez(err)
      	           call edest(err, 0)
                endif
            endif


c --------- if this cell is in integer form, convert back from float
	    if (gotform(ii)(1:1) .eq. 'I') then
	       datarec(ii) = nint(floatdat(ii))
	    endif

         else

c --------- requested units match what came back from the server
            floatdat(ii) = scaledval
         endif

  70  continue

c --- set return code
2000  continue

c --- move the data record into ibuf to be returned
      call movw(gotnparm, datarec, ibuf)

      return
      end   


*$ Name:
*$      pt_derive - derive a point source parameter
*$
*$ Interface:
*$      integer function
*$		pt_derive( character* math,
*$                         integer Size,
*$			   Integer NVar,
*$                         character* Var_name(*),
*$			   integer Var_index(*),
*$			   integer Var_scale(*),
*$			   character* Parm_name,
*$			   integer Parm_index,
*$			   integer Parm_scale )
*$
*$ Input:
*$	math	- math string
*$	Size	- number of points to compute
*$	NVar	- number of variables for the equation
*$	Var_name - array of variable names
*$	Var_index - array of variable record indicies
*$	Var_scale - array of variable scale factors
*$	Parm_name - name of the parameter to derive
*$	Parm_index - parameter record index
*$	Parm_scale - parameter scale factor      
*$
*$ Input and Output:
*$	none
*$
*$ Output:
*$	none
*$
*$ Return values:
*$      0 - success
*$     -1 - failed: size is <= 0
*$     -2 - failed: too many variables
*$     -3 - failed: could not read variable from memory
*$     -4 - failed: could not write variable into math struct
*$     -5 - failed: derivation error
*$     -6 - failed: could not write derived parameter to memory
*$     -7 - failed: buffer overflow
*$
*$ Remarks:
*$      Routine reads variable records from memory and places the 
*$      values into the equation analyzers math structure. The 
*$      variables are aligned as though they were 1 dimensional
*$      grids. The "grids" and the math equation are passed to 
*$      to the analyzer (computevar) to generate the derived 
*$      parameter. The derived parameters are written into the 
*$      their reserved record locations.   
*$      
*$
*$ Categories:
*$      point
*$	utility

      integer function pt_derive( math, Size, NVar, Var_name, 
     &   Var_index, Var_scale, Parm_name, Parm_index, Parm_scale)

      implicit none

c --- symbolic constants & shared data
      include 'hex80.inc'
      include 'ptparm.inc'		! general point source parameters

      integer		MISSN
      parameter		(MISSN = hex80) ! missing value code

      integer           MAXVAR
      parameter		(MAXVAR = 99) 

      integer		MAXSIZE
      parameter		(MAXSIZE = 50000)
      

c --- parameters
      character*(*) 	math
      integer		Size
      integer		NVar
      character*(*)	Var_name(*)
      integer		Var_index(*)
      integer		Var_scale(*)
      character*(*)	Parm_name
      integer		Parm_index
      integer		Parm_scale

c --- external functions
      integer		computevar
      integer		len_trim
      integer		lit
      integer		m0ptmwt
      integer		m0ptmrd
      integer		m0gsave
      integer		m0gfree
      integer		mccmdstr
      

c --- internal variables
      character*12	planet		! planet name
      character*12	add		! meridional comp flag
      integer		status		! function status
      integer		len		! string length
      integer		pthead(64)	! grid directory
      integer		pt(MAXSIZE)	! point array
      integer		ival		! generic int value
      integer		handle(100)	! array of varaiable handles
      integer		Nparm		! number of parameters
      integer		i		! loop index
      integer		j		! loop index
      integer		usage		! memory read/write flag
      real		rval		! generic real value

      equivalence (ival, rval)

c --- check the size
      if( size.le.0 ) then
         pt_derive = -1
         return
      endif

c --- make the point header
      call zerow(64, pthead)
      pthead(1) = Size
      pthead(2) = Size
      pthead(3) = 1

c --- make sure there are enough handles
      if( NVar.gt.MAXVAR ) then
         pt_derive = -2
         return
      endif

c --- make sure the buffer limit is not exceeded
      if( size.gt.MAXSIZE ) then
         call edest('Primary request is too large ...',0)
         call edest('Please reconsider your SELECT criteria',0)
         pt_derive = -7
         return
      endif

c --- loop through the variables
      do 1000 i = 1, NVar

c --- add the variable dependent values to the header
      pthead(7) = lit( Var_name(i)(1:4) )
      pthead(8) = Var_scale(i)

c --- read the variable into the local array
      usage = 0
      do 500 j = 1, Size
      status = m0ptmrd( usage, j, 1, Var_index(i), ival)
      if( status.lt.0 ) then
         pt_derive = -3
         return
      endif

c --- while you have the value, scale it 
      if( ival.ne.MISSN ) then
         if( Var_scale(i).eq.0 ) then
            pt(j) = ival
         else
            pt(j) = NINT( rval * (10 ** Var_scale(i) ) )
         endif
      else
         pt(j) = ival 
      endif

500   continue

c --- save the point array into the math structure
      len = len_trim( Var_name(i) )
      status = m0gsave( pthead, pt, Var_name(i), len, handle(i) )
      if( status.lt.0 ) then
         pt_derive = -4
         return
      endif

1000  continue

c --- get the planet name from the command line
      status = mccmdstr('PLA.NET', 1, 'EARTH', planet )

c --- get the meridional component flag
      status = mccmdstr('MER.IDIONAL', 1, 'NO', add)

c --- derive the parameter
      status = computevar( math, 
     &                    pt,
     &                    pthead,
     &                    handle,
     &                    NVar,
     &                    planet,
     &                    add )      
      if( status.lt.0 ) then
         pt_derive = -5
         return
      endif

c --- Save the scale factor for the parameter
      Parm_scale = pthead(8)

c --- write the parameter into the pt memory structure
      Nparm = 1
      usage = 2
      do 2000 i = 1, Size

c --- apply the scale to the Parameter
      if( pt(i).ne.MISSN ) then
         rval = real( pt(i) ) / (10**Parm_scale)
      else
         ival = pt(i)
      endif

c --- write the Parameter
      status = m0ptmwt( usage, i, Nparm, Parm_index, 0, 0, ival ) 
      if( status.lt.0 ) then
         pt_derive = -6
         return
      endif

2000  continue

c --- free the handles
      do 3000 i = 1, NVar
      status = m0gfree( handle(i) ) 
      if( status.lt.0 ) then
         pt_derive = -5
         return
      endif
3000  continue

      pt_derive = 0
      return
      end
