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: gdirserv.f,v 1.43 1999/04/07 14:15:33 chadj Rel $ ***

C-----GDIRSERV  Local  version of grid server

      IMPLICIT NONE

      ! symbolic constants and shared data

      INTEGER JTRACE			! flag to turn on debug trace file
      COMMON/TRACE/JTRACE

      ! external functions

      INTEGER INDEX			! index function
      INTEGER M0CMDPARSE		! command parse function
      INTEGER M0SPLICE
      integer m0istraceset
      integer m0isrtdataset
      integer m0sxdatasetinfo
      integer m0sxgetclientrequest
      integer mcargint			! int argument fetcher

      ! local variables

      CHARACTER*12  KIND		! type of data requested
      CHARACTER*120 A
      character*24 program		! alternate server program to start
      character*256 argdum		! dummy string for arg fetchers
      CHARACTER*32  NAME		! name of dataset
      CHARACTER*72  B			! error message string
      character*4   realtime            ! indicates if it is real time
                                        ! dataset
      integer       realflag            ! indicates if it is a real time
                                        ! dataset
      INTEGER I
      integer iret			! return status
      INTEGER ISTAT
      INTEGER J(64)			! command block
      INTEGER LENREQ
      integer max_gr			! max grid number in dataset
      integer min_gr			! min grid number in dataset
      INTEGER RC

      INTEGER KREQ(125)
      CHARACTER*500 REQST		! request to server
      CHARACTER*500 group		! dataset group name
      CHARACTER*500 dataset		! dataset name
      CHARACTER*500 type 		! dataset type
      CHARACTER*500 info 		! dataset info
      CHARACTER*500 comment		! comment attached to dataset

      EQUIVALENCE(KREQ,REQST)

C --- initialized variables

      integer ddeversion		! version number

      data ddeversion/0/

C - - SET TRACE ENABLE/DISABLE FLAG

      JTRACE=0

C - - ZERO UNUSED FIELDS IN CONTROL BLOCK

      CALL ZEROW(64,J)

C - - GET McIDAS ENVIRONMENT

      CALL INITBLOK(I)

      IF(I.NE.0) then

	 b =
     &  'Grid directory server unable to initialize McIDAS environment'
         call movcw(b,j(44))
	 j(43) = -117
	 goto 999

      endif

      i = m0sxgetclientrequest(j,reqst)
      if (i .ne. 0) then

	  b = 'Unable to get client request'
	  call movcw(b,j(44))
	  j(43) = -111
	  goto 999
      endif

      i = m0istraceset(reqst)


C - - - ALWAYS PUT BEGINNING OF REQUEST IN J, EVEN IF IT ALREADY WAS THERE

      A=REQST
      CALL MOVCW(A,J(11))
      CALL M0SXTRCE(A)

C-------initialize server logging and account validation

      CALL M0VSERV(J)
      CALL M0SXLOGI(J)

C - - Parse request into standard McIDAS command structure

      KIND='GRID'

cjsp  check if this is a realtime dataset

      realflag = m0isrtdataset(reqst)
      realtime = 'NO'
      if (realflag .eq. 1)then
         realtime = 'YES'
      endif
      write(b,FMT='(a27,1x,a4)')
     &   'GDIRSERV: Realtime dataset?',realtime
      call m0sxtrce (b)
cjsp

      istat = m0sxdatasetinfo(reqst,group,dataset,type,kind,info,
     &		comment,min_gr,max_gr,realflag)

c--- fail if the name could not be resolved

      IF (ISTAT .LT. 0) THEN

	 write(b,FMT='(a27,1x,i6)')
     &      'm0sxdatasetinfo returns: ',istat
	 call m0sxtrce(b)

c --- m0splice combines the group and dataset in reqst into name;  for
c      example, if reqst starts off as 'LOCAL Q 65000 POS=12...' then
c      name will return as 'LOCAL/Q'

	 rc=m0splice(reqst, name)
         if (rc .lt. 0) then
           b='Invalid dataset name'//reqst
           call movcw(b,j(44))
	   j(43) = -501
           goto 999
         endif
	 b =
     &  'Grid data server unable to resolve this dataset: '//name
         call movcw(b,j(44))
	 j(43) = -118
	 goto 999

      ENDIF


C==========   Call actual server   ==========
C***  Make sure the requested type is GRID

      IF(KIND.EQ.'GRID') THEN

C***	  Put the string into the McIDAS command structure for argument
C***	  retrieval later

          CALL M0CMDPUT(M0CMDPARSE(REQST,LENREQ))

C***	  Pick up a VERSION keyword if there is one
          iret=mcargint(0,'VER.SION',1,0,0,1,ddeversion,argdum)
C***	  If no version was specified, must be calling the DDE server

          if (ddeversion .eq. 0) then
             CALL   Gdir(J)

C***	  Specified version 1, use the ADDE server

          else if (ddeversion .eq. 1) then
             call addegdir(j, realtime, min_gr, max_gr)
	  else
C***	   Invalid version specified
           b='Invalid server version specified'
           call movcw(b,j(44))
	   j(43) = -22003
           goto 999
          endif
	  call m0sxtrce(reqst)
      ELSE
C---------call a server by exec() of a sub_server
	  i=index(kind,' ')-1
	  program=kind(1:i)//'GDIR'
	  call mclocase(program)
	  call m0sxtrce('GDIRSERV:  call server named '//program//
     &			' from gdirserv')
	  call m0subserv(j,program,reqst)

          J(43)=-114
          B='GDIRSERV failed on on exec of ' //program
          CALL MOVCW(B,J(44))
      ENDIF

C============================================

 999  CALL M0SXDONE(J)
      END

	subroutine addegdir(comblock, realtime, bgrid, egrid)
	implicit none

	integer comblock(*)		! command block structure
	integer bgrid			! 1st grid in dataset
	integer egrid			! last grid in dataset
        character*(*) realtime          ! flag indicating if dataset
                                        ! is a realtime dataset

C --- symbolic constants & shared data
	include 'gridparm.inc'
	include 'm0gadde.inc'

        integer maxfiles                ! maximum number of realtime
                                        ! files to search
        parameter (maxfiles = 1000)
	integer numuv
	parameter (numuv=3)		! number of params that need u,v sent
					!  back to the application
	integer numpstr			! maximum number of grids to be used
	parameter (numpstr=99)		!  by parser
	integer NO			! pseudo boolean
	parameter(NO=0)
	integer YES			! pseudo boolean
	parameter(YES=1)
	integer igdat(maxgridpt)		! grid data array
	common/m0gadde_stack/igdat

C --- external functions

	character*4 clit		! convert integer to character
	integer     igget		! get a grid
	integer     ischar		! is it a printable char
	integer     isgfmt		! is it a grid format
	integer     lit			! take the literal of a char
	integer     lwfile		! test existance of lwfile
	integer     m0cntbyt		! count number of bytes to send
	integer     m0errorout		! process error messages
	integer     m0fhrnge		! validate fday/ftime for grid
	integer     m0grdpro		! validate the grid projection
	integer     m0levuni		! validate the level unit
	integer     m0liststck		! list contents of stack
	integer     m0parstr		! parse the string
	integer     m0popderv		! pop a derived grid off the stack
	integer     m0pushgrid		! push grid onto stack
	integer     m0readpars		! read parsing stuff
	integer     m0readsort		! read sort clauses in server string
	integer     m0srchstck		! search stack for grid
	integer     mcargint		! integer arg fetcher
	integer     mcargnum		! argument counter
	integer     mcargstr		! string arg fetcher
	integer     mcfndgrd		! find a grid according to search
	integer     mcglast		! get # of last grid in grid file
        integer     m0rtgfil

C --- local variables

        character*4   realdata          ! is the dataset a realtime one
	character*12  cpro		! projection to be searched for
	character*12  filename		! grid file name
	character*12  out_type		! listing type
	character*12  parms(maxsort)	! array of parms to search
	character*12  src(maxsort)	! array of sources for search
	character*12  thisderv		! derived parm picked off argument list
	character*120 errstring		! temporary string to hold errors
        character*48  blanktitle        ! blank title for derived grids
	character*256 argdum		! dummy string for arg fetchers
	character*500 cparstr(numpstr)  ! string(s) to parse
        integer       bloop             ! beginning of grid file loop
	integer       bpos		! begin position for FILE list
        integer       eloop             ! ending of grid file loop
	integer       epos		! end position for FILE list
        integer       filelist(MAXFILES)! list of rt grid files to search
        integer       n_gridfiles       ! number of rt grid files to search
	integer       days(maxday)	! array of days to search for
	integer       dummy(3)		! dummy var for call to igname
	integer       fday		! forecast day
	integer       file_header(64)	! grid file header directory
	integer       firsttime		! first time flag
	integer       flip		! flag if need flipping
	integer       ftime		! forecast time
	integer       grid		! grid number
	integer       gridcount		! grid counter
	integer       gridf		! include gridfiles in byte counts?
	integer       gridfile		! grid file number
	integer       gridhead(64)	! grid directory
	integer       gridheadp(64,numpstr) !grid directory for parsed grids
	integer       gridstat		! return status from igget
	integer       holdnum		! num_requested
	integer       i			! counter
	integer       iret		! return status
	integer       istart		! where to start stack search
	integer       j			! counter
	integer       lastgrid		! last grid
	integer       lastgridfile	! last grid file
	integer       lev(maxsort)	! array of levels to search for
	integer       levorig(maxsort)	! array of levels to search for
	integer       levunit(maxsort)	! array of level units to search for
	integer       match		! is there a match?
	integer       nc		! number of columns in grid
	integer       nr		! number of rows in grid
	integer       num_requested	! number of entries requested
	integer       numdays		! number of elements in day array
	integer       numderv		! number of elements in derive array
	integer       numfday		! number of FDAYs
	integer       numftime		! number of FTIMEs
	integer       numgproj		! number of GPROs
	integer       numlev		! number of elements in lev array
	integer       numlevorig	! number of elements in lev array
	integer       numlevunit	! number of elements in lev array
	integer       numparm_h		! number of elements in parm array
	integer       numparm		! number of elements in parm array
	integer       numpos		! flag to indicate if position specified
	integer       numsrc		! number of elements in source array
	integer       numtime		! number of elements in time array
	integer       numvt		! number of elements in vt array
	integer       pars_day		! day of grid to be parsed
	integer       pars_lev		! level of grid to be parsed
	integer       pars_name		! parameter of grid to be parsed
	integer       pars_pro		! projection of grid to be parsed
	integer       pars_src		! source of grid to be parsed
	integer       pars_time		! time of grid to be parsed
	integer       pars_vt		! valid time (FHOUR)of grid to be parsed
	integer       pnum		! number of to-be-parsed grids
	integer       pos		! position of file in dataset
	integer       rc		! return code
	integer       startat		! grid to begin mcfndgrd search at
	integer       startgrid		! starting grid for GRID keyword
	integer       stopgrid		! stopping grid for GRID keyword
	integer       temp		! temporary holder for switching
	integer       times(maxtime)	! array to hold times for search
	integer       totbytes		! total number of bytes being returned
	integer       totfiles		! total number of files being returned
	integer       totgrids		! total number of grids being returned
	integer       uvflag		! flag=1 if STREAML, WINDB, or WINDV
					!   have been requested,0 otherwise
	integer       vgrid		! grid number of vgrid
	integer       vgridhead(64)	! gridheader of v grid
	integer       vt(maxvt)		! array containing valid times

C --- initialized variables

	integer getbygrid		! flag to indicate specific grid request
	character*8 uvchar(numuv)	! vrbls needing (u,v) sent to app.

	equivalence (filename, dummy)
	data getbygrid/0/
        data blanktitle/' '/
	data uvchar/'STREAML ','WINDB   ','WINDV   '/


cjsp
        realdata = realtime

C****   Pick up the sort conditions

        iret = m0readsort(parms,numparm,numparm_h,numderv,thisderv,
     &          levorig,numlevorig,levunit,numlevunit,vt,numvt,
     &		numdays,days,numtime,times,
     &          numsrc,src,fday,ftime,numgproj,cpro,startgrid,
     &          stopgrid,uvflag,getbygrid,holdnum,num_requested)

        write(errstring,*) 'numparm is ',numparm,numderv,numparm_h
        call m0sxtrce(errstring)
        do 111 i = 1,numparm
           call m0sxtrce(parms(i) )
 111    continue
        if (iret .lt. 0) then
           rc = m0errorout('m0readsort',iret,errstring)
           goto 2001
        endif


C****	POSITION - if this is specified, only the specified file will be
C****		   searched, otherwise, the most recent file will be searched.
	numpos=mcargnum(0,'POS')
	pos=1
	if (numpos .gt. 0) then
C****		Set the beginning and ending grid to search to the specified
C****		grid
		iret=mcargint(0,'POS',1,1, 1, egrid-bgrid+1,pos,argdum)
		if (iret .lt. 0) then
			iret = -22005
			errstring='Invalid keyword value for POS'
			goto 2001
		endif
		bgrid=bgrid + pos - 1
		egrid=bgrid
		realdata='NO'
	endif

C****   change num_requested if DERIVE is specified

	if (numderv .gt. 0)  num_requested = 99999

	write(errstring,9400) num_requested,holdnum
 9400   format(' Number requested: ',i10,' number originally: ',i10)

        iret = m0readpars(parms,numparm,levorig,numlevorig,
     &          levunit,numlevunit,vt,numvt,
     &          numdays,days,numtime,times,numsrc,src,
     &          fday,ftime,numgproj,cpro,bgrid,egrid,
     &          num_requested,pnum,cparstr,getbygrid,
     &		startgrid,stopgrid)

        write(errstring,*) ' pnum is ',pnum,numlevorig,numlevunit
        call m0sxtrce(errstring)

        if (iret .lt. 0) then
           rc = m0errorout('m0readpars',iret,errstring)
           goto 2001
        endif

C****  If numlevorig is not equal to numlevunit, then error out,
C	unless numlevunit is zero, which may be the case if an
C	old client calls this server.  If numlevunit is zero, and
C	numlevorig is nonzero, make an array of level units that
C	match the levorig data, asking for the default in each case

	if (numlevorig .ne. 0) then

	  if (numlevunit .ne. 0) then

	    if (numlevorig. ne. numlevunit) then

	       errstring = '# level units unequal to # levels'
	       call m0sxtrce(errstring)
	       iret = -21050
	       goto 2001
	    endif

	  else			! numlevunit .eq. 0 make an array

	    numlevunit = numlevorig
	    j = lit('X')
	    do 104 i = 1,numlevorig
	       levunit(i) = j
 104        continue
	  endif
	endif

C****  check the level array to remove any duplication...

	numlev = 0
	match = NO
        do 110 i = 1,numlevorig

	  match = NO
	  if (numlev .gt. 0) then
	      do 105 j = 1,numlev
		if (levorig(i) .eq. lev(j)) match = YES
 105	      continue
	  endif
	  if (match .eq. NO) then
	     numlev = numlev + 1
	     lev(numlev) = levorig(i)
	     write(errstring,*) 'numlev now ',numlev
	     call m0sxtrce('adding '//errstring)
	  endif
 110    continue

C****	If the user just wants the file listings (not the grid listings)
C****   the server will get a OUT=FILE.

	iret=mcargstr(0,'OUT',1,'ALL',out_type)
	if (iret .lt. 0) then
		iret = -22005
		errstring='Invalid keyword value for ALL'
		goto 2001
	endif
        if (out_type .eq. 'FILE') goto 1000

C****	If only one grid is being listed, skip ahead, no need to use
C****	mcfndgrd.

	if (getbygrid .gt.0 ) goto 500

C***	Remember word 41 contains the billing information, it should
C***	get updated with the number of bytes that are sent.

	totgrids=0
	totfiles=0
	lastgridfile=0

cjsp
c---    assume at first that this is not a rt dataset

        bloop = bgrid
        eloop = egrid

c---    now we will figure out what the actual range of grid files
c---    it is we are going to search if the dataset is flagged as
c---    realtime

        if (realdata(1:1) .eq. 'Y')then
           iret = m0rtgfil(numdays, days, numtime, times,
     &                     numvt, vt, numsrc, src,
     &                     MAXFILES, n_gridfiles, filelist)

c---       if the realtime grid file list was successfully retrieved

           if (iret .eq. 0)then
              bloop = 1

c---          now we have to do a special check to remove grid files
c---          that may occur outside the range of the dataset

              do 150 i = 1 , n_gridfiles
                 if (filelist(i) .lt. bgrid .or.
     &               filelist(i) .gt. egrid)then
                    filelist(i) = -1
                 endif
150           continue
              temp = 0
              do 155 i = 1 , n_gridfiles
                 if (filelist(i) .ne. -1)then
                    temp = temp + 1
                    filelist(temp) = filelist(i)
                 endif
155           continue
              n_gridfiles = temp
              eloop = n_gridfiles

              do 190 i = 1 , n_gridfiles
                 write(errstring,FMT='(a23,i6,1x,i6)')
     &            'GDIRSERV: RT grid file ',filelist(i),i
                 call m0sxtrce (errstring)
190           continue

c---       otherwise, treat it as a non-realtime dataset

           else
              realdata = 'NO'
           endif
        endif
        if (realdata(1:1) .eq. 'N')then
           write(errstring,FMT='(a30,1x,i6,1x,a7,1x,i6)')
     &     'GDIRSERV: searching grid files',bloop,'through',eloop
           call m0sxtrce(errstring)
        endif

C***	Run through all of the grid files in the dataset (or if only
C***	one position was specified, that file will be searched.
	do 200 i=bloop, eloop

           if (realdata(1:1) .eq. 'N')then
              gridfile = i
           else
              gridfile = filelist(i)
           endif

          write(errstring,FMT='(a21,i6)')'Searching grid file ',gridfile
          call m0sxtrce(errstring)

		startat=1
100		continue

C****			find a match
			gridstat=mcfndgrd(gridfile, days, numdays, times,
     &				numtime,vt, numvt, lev, numlev, parms,
     &				numparm, src, numsrc, gridhead, startat)
                        gridhead(18) = gridfile

C****			Send a heartbeat signal to keep the pipe from
C****			closing due to timeout

			temp=4
			call swbyt4(temp,1)
			call m0sxsend(4,temp)
			temp=heartbeat
			call swbyt4(temp,1)
			call m0sxsend(4,temp)

C****		Positive return indicates a match was found.

		if (gridstat .gt. 0 ) then

C****		Verify that the grid matches FDAY and FTIME specifications
			if (fday .ne. -1 .or. ftime .ne. -1) then
			        iret= 1
				iret = m0fhrnge(gridhead, fday, ftime)
				if (iret .eq. 0)goto 100
			endif

C****		Verify that the grid matches Projection specifications
			if (cpro .ne. '-1') then
			        iret= 1
				iret = m0grdpro(gridhead, cpro)
				if (iret .eq. 0)goto 100
			endif

C****		Verify that the grid matches lev unit specifications
			if (numlevunit .gt. 0) then
				iret = m0levuni(gridhead, levunit,
     &						levorig, numlevunit)
				if (iret .eq. 0)goto 100
			endif

C****			If this is the first grid of the grid file,
C****			increment the totfiles counter

			if (lastgridfile .ne. gridfile) then
				totfiles=totfiles+1
				lastgridfile = gridfile
			endif

			vgrid = 0

C---pick up the v grid if (u,v) are asked for and u has been found

			if (uvflag .eq. 1  .and.
     &				clit(gridhead(7)).eq.'U   ') then
			   call m0fndv(gridfile,gridhead,vgrid,
     &					vgridhead)

			   if (vgrid .lt. 0)  goto 100

C**** Increment num_requested if a (u,v) pair is to be sent

			   num_requested = num_requested + 1

			   if (vgrid  .gt.  0) then

			     if (fday.ne.-1 .or. ftime .ne. -1) then
			        iret = 1
				iret = m0fhrnge(vgridhead,fday,ftime)
			        if (iret  .eq. 0) goto 100
			     endif

			     if (cpro .ne. '-1') then
			        iret= 1
				iret = m0grdpro(gridhead, cpro)
				if (iret .eq. 0)goto 100
			     endif

			     if (numlevunit .gt. 0) then
				iret = m0levuni(gridhead, levunit,
     &					   levorig, numlevunit)
				if (iret .eq. 0)goto 100
			     endif

			   endif
			 endif

C****                   store the grid information for later

C---if the program has reached here, then there is a grid to push
C	in gridstat;  further, if uvflag = 1, there is a v-grid to
C	push as well...do it.

                        iret=m0pushgrid(gridstat, gridhead, totgrids,
     &                                gridfile)
			if (uvflag .eq. 1 .and. vgrid .gt. 0)
     &                     iret=m0pushgrid(vgrid, vgridhead, totgrids,
     &                                gridfile)
			if (totgrids .ge. num_requested)goto 220
			goto 100
		endif

C***    end of grid file loop

200	continue

	write(errstring,9910) totgrids, num_requested,thisderv
 9910   format('Total number of grids: ',i10,' number requested: ',
     &		i10,a12)
	call m0sxtrce(errstring)
	   iret = m0liststck()
C****   send the total # of bytes being sent as the first word
C****   across the comm.  If no grids were found, set the error
C****   condition

220	continue
	temp=0
	gridf = 1
	if (totgrids .gt. 0) then

C****		Calculate the # of bytes to send - don't forget flags

	    if (numderv .eq. 0) then

		temp=(totgrids*256)+(totfiles*256)
     &			+(totgrids*4)+(2*totfiles*4)+4

		write(errstring,*) 'no derv #bytes is ',temp
		call m0sxtrce(errstring)
	    else

		temp = m0cntbyt(holdnum,thisderv,gridf) + 4
		write(errstring,*) 'derv  # bytes is ',temp
		call m0sxtrce(errstring)

	        if (temp .le. 4) then
		   comblock(41) = 0
		   errstring=
     &			'Unable to locate some component grids for'//
     &			' derived parameter'
		   iret = -22001
		   goto 2001
		endif

	    endif

	    comblock(41)=temp

	else
		comblock(41)=0
		errstring='No grid found matching search conditions'
		iret=-22001
		goto 2001
	endif

c---send the number of bytes here if not doing parsing...the number
c    of bytes for parsing is done after the stack is searched to make
c    sure all the grids to be sent to the client exist

	if (pnum .eq. 0) then
	    write(errstring,9912) temp
	    call m0sxtrce(errstring)
	    call swbyt4(temp,1)
	    call m0sxsend(4,temp)
        endif

 9912   format('Number of bytes to send: ',i8)

C****  Initialize some stuff for parsed grids....we want to go through
C       the stack and make sure the grids to do the parsing are there...

	startat = 0
	totfiles=0

 221    continue

	errstring = '********************start through stack ***'
	call m0sxtrce(errstring)

	pars_lev = -1
	pars_name= -1
	pars_src = -1
	pars_day = -1
	pars_time= -1
	pars_vt  = -1
	pars_pro = -1

	if (pnum .gt. 0) then

	  lastgridfile = -1
	  totfiles = 0

          do 225 i = 1,pnum

            iret = m0parstr(cparstr(i),numlev,lev,numlevunit,
     &		   levunit,
     &  	   numparm,parms,numtime,times,numdays,days,
     &  	   numvt,vt,numsrc,src,numfday,fday,numftime,
     &  	   ftime,numgproj,cpro,grid,1)

            if (numlev .eq. 1) pars_lev = lev(1)
	    if (numparm.eq. 1) pars_name = lit(parms(1))
	    if (numdays.eq. 1) pars_day = days(1)
	    if (numtime.eq. 1) pars_time = times(1)
	    if (numsrc .eq. 1) pars_src = lit(src(1))
	    if (numgproj.eq.1) then
		if (cpro(1:4) .eq. 'MERC') pars_pro = 1
		if (cpro(1:2) .eq. 'PS') pars_pro = 2
		if (cpro(1:4) .eq. 'EQUI') pars_pro = 3
		if (cpro(1:4) .eq. 'NONE') pars_pro = 5
		if (cpro(1:4) .eq. 'LAMB') pars_pro = 6
	    endif
	    if (numvt  .eq. 1) pars_vt = vt(1)/10000

            if (grid  .gt. 0) then

		gridstat = igget(bgrid,grid,1,igdat,nr,nc,gridhead)
		do 222 j = 1,64
		   gridheadp(j,i) = gridhead(j)
 222    	continue
		gridheadp(17,i) = grid
		gridheadp(18,i) = bgrid

	    else

		if (i .eq. 1) then

C***  Look for the first grid that is to be used to parse

		    iret = m0srchstck(pars_lev,pars_name,
     &  	      pars_src,pars_day,pars_time,pars_vt,
     &  	      pars_pro,gridheadp(1,i),gridfile,grid,
     &  	      startat,0)
		    if (iret .eq. 0)   startat = 1
                    if (iret .lt. 0) then
		      iret = -22001
		      errstring = 'Can''t find matching grids '//
     &  		  'for parsed string'
		      goto 2001
		    endif

		else

		    iret = m0srchstck(pars_lev,pars_name,
     &  	      pars_src,pars_day,pars_time,pars_vt,
     &  	      pars_pro,gridheadp(1,i),gridfile,grid,
     &  	      0,-1)


C***  If iret is not zero, then this particular grid was not found
C     so go back and start again, starting the search later in the
C     stack for the first grid...
C

		    if (iret .lt. 0) goto 221

		endif

            endif

	    if (gridfile .ne. lastgridfile) then
		   lastgridfile = gridfile
		   totfiles = totfiles + 1
            endif
	    gridheadp(17,i) = grid
	    gridheadp(18,i) = gridfile

C***  Now fill in the pars_ variables with the values from the retrieved
C	grid...thus, the value from the grid retrieved will serve as the
C	default for the next grid searched for...  These values can be
C       changed given the results of m0parstr above

	    pars_lev = gridheadp(10,i)
	    pars_name= gridheadp(7,i)
	    pars_day = gridheadp(4,i)
	    pars_time= gridheadp(5,i)
	    pars_vt  = gridheadp(6,i)
	    pars_src = gridheadp(33,i)
	    pars_pro = gridheadp(34,i)

225	  continue

C****  If program control gets to here, then a set of grids that matches
C	the conditions in the sort clause exists, and the gridheaders
C	are in gridheadp(n,i), i = 1,pnum.  Compute now the number of
C	bytes that are to be sent back to the client, which is equal to
C	the number of gridheaders*64 + 4

	   temp=(pnum*256)+(totfiles*256)
     &			+(pnum*4)+(2*totfiles*4)+4
	   write(errstring,9912) temp
	   call m0sxtrce(errstring)
   	   call swbyt4(temp,1)
	   call m0sxsend(4,temp)
        endif

C****   Now we loop through all of the grids stored, and send back the
C****   grid file headers, and grid directories.

	lastgridfile=0
	gridcount=0
	istart = 0

250	continue

C****		If all the grids were popped, we can exit

		if (pnum .eq. 0) then
	  	    if (numderv .eq. 0) then
		        if (gridcount .ge. totgrids) goto 450
		        call m0popgrid(gridfile, grid)
		    else
		       if (gridcount .ge. holdnum) goto 450
		       iret =  m0popderv(gridfile,gridhead,thisderv,
     &  					 istart)
		       if (iret .lt. 0)  goto 450
		       grid = gridhead(17)
		       istart = -1
		    endif

		else

C---put the stored parsed gridheader into the gridhead to send, and
C    retrieve the gridfile/grid numbers

		   do 255 i = 1,64
		      gridhead(i) = gridheadp(i,gridcount+1)
 255    	   continue
		   gridfile = gridhead(18)
		   grid = gridhead(17)
		endif

		if (gridfile .ne. lastgridfile) then

C****			If this is not the first gridfile, send a
C****			1 down the comm to bind off the grid directory
C****			packets

			if (lastgridfile .ne. 0) then
				temp=1
				call swbyt4(temp,1)
				call m0sxsend(4,temp)
			endif

C****			Get the grid file header, add position to
C****			word 15 (arbitrary), and send it.

			temp=0
			call swbyt4(temp,1)
			call m0sxsend(4,temp)
			totfiles=totfiles+1
			call igname(gridfile, dummy)
			flip=isgfmt(gridfile)

C***			Read 64 words from grid file

			call lwi(filename,0,64,file_header)
			if (flip .ne. 0) then
				call fbyte4(file_header(11),1)
				call fbyte4(file_header(9),1)
				call fbyte4(file_header(10),1)
			endif
			if (file_header(11) .ge.-1) file_header(11)=159

C***			If the user specified a position, we return
C***			that position, and don't calculate it.

			if (bgrid .ne. egrid) pos=gridfile - bgrid + 1

C***		negative position number means that grdlist will
C***		not print out the gridfile header info (for derived
C***		quantities and parsed grids

			if (numderv .eq. 0) then
			    file_header( 15)=pos
			else
			    file_header( 15)= -pos
			endif

			call m0sxtrce('sending header for '//filename)

C***			Send all the words, checking that they
C***		  	should be switched.

			do 350 i=1,64
		 	    if (ischar(file_header(i)).eq.0) then
			        call swbyt4(file_header(i),1)
			    endif
			    call m0sxsend(4, file_header(i))
350			continue
			lastgridfile=gridfile
		endif

C****		pop the directory to send...if a derived grid, note that
C			the directory was already returned by m0popderv

		if (numderv .eq. 0 .and. pnum .eq. 0) then
		    call m0popdir(gridhead)
		endif

		gridcount=gridcount+1

C****		IF we are sending the grid directories also
C****		send a status word

		temp=0
		call swbyt4(temp,1)
		call m0sxsend(4,temp)

C****		set word 17 of header to the grid number
C****			make it negative if a derived grid...this will tell
C****			grdlist that the grid was derived
C****			also blank out the extra info in words 53-64

		if (numderv.gt.0)then
                   grid = -grid
                   gridhead(8) = 0
                   gridhead(9) = lit('    ')
                   call movcw(blanktitle, gridhead(53))
                endif

		gridhead(17)=grid

C****		Send the grid header, switch bytes first

		call m0flpgdr(gridhead)
		call m0sxsend (256, gridhead)

		if (pnum .ne. 0 .and. gridcount .eq. pnum)  goto 450

	goto 250

450 	continue

C****	Send flag(s) indicating all file directories & grid directories
C**** 	have been sent
	temp=1
	call swbyt4(temp,1)
	call m0sxsend(4,temp)
	temp=2
	call swbyt4(temp,1)
	call m0sxsend(4,temp)

	iret=0
	errstring=' '
	goto 2001

C*****  Sending specific grid(s)
500 	continue
        totbytes=0
        totgrids=0
        call igname(bgrid, dummy)
	if (lwfile(filename) .eq. 0) then
		errstring='Grid file does not exist'
		iret=-22009
		comblock(41)=0
		goto 2001
	endif

	lastgrid=mcglast(filename)
        if (startgrid .eq. -1  .or. stopgrid .eq. -1) then
                if (startgrid .eq. -1) startgrid= lastgrid
                if (stopgrid .eq. -1) stopgrid= lastgrid
	endif
        if (lastgrid .lt. 0) then
                        errstring='Invalid grid file specified'
                        iret=-22010
                        comblock(41)=0
                        goto 2001
        endif
	if (stopgrid .gt. lastgrid) stopgrid=lastgrid

C       if (lastgrid .eq. 0)  goto 551  ! existing gridfile with no grids

        do 550 i=startgrid, stopgrid
C****		Call igget,but maxwords is 1, so the status will always
C****		be bad, because it will be oversized, but by checking
C****		the first word of gridhead (which is still filled),
C****		we can tell if the grid existed or not.
		gridhead(1)=-1
		gridstat=igget(bgrid, i, 1, igdat,
     &				nr, nc, gridhead)
                if(gridhead(1).gt.0) then
                        totbytes=totbytes+256+4
                        totgrids=totgrids+1
                endif
550     continue

551     continue

C****   Get the grid file header, add position to
C****   word 15 (arbitrary), and send it.
C***    Read 64 words from grid file

	flip=isgfmt(bgrid)

C***	Read 64 words from grid file

	call lwi(filename,0,64,file_header)
	if (flip .ne. 0) then
		call fbyte4(file_header(11),1)
		call fbyte4(file_header(9),1)
		call fbyte4(file_header(10),1)
	endif
	if (file_header(11) .ge.-1) file_header(11)=159
        file_header( 15)=pos

C***  	If the startgrid & stopgrid are both zero, then the gridfile
C***    exists, but has no grids in it.  In that case we'll just
C***	send the grid file header.

	if (totbytes .eq.  0 .and.startgrid.ne. 0) then
                comblock(41)=0
                errstring='Invalid grid number specified'
                iret=-22011
                goto 2001
	endif

C****   add the size of the grid file header to totbytes

	totbytes=totbytes+256+12
	temp=totbytes
	call swbyt4(temp,1)

C****   start the comm stream send the total # bytes

	call m0sxsend(4,temp)
	temp=0
	call swbyt4(temp,1)
        call m0sxsend(4,temp)

C***    Send all the words of the grid file header, checking that they
C***    should be switched.

        do 580 i=1,64
            if (ischar(file_header(i)).eq.0) then
                call swbyt4(file_header(i),1)
            endif
            call m0sxsend(4, file_header(i))
580     continue

        comblock(41)=totbytes

C***    If there were no grids in the gridfile, skip over the grid
C***	grid directory sender

	if (startgrid .eq. 0) goto 750
	do 700 grid=startgrid,stopgrid
		gridhead(1) =-1
		gridstat=igget(bgrid, grid,0, igdat,
     &				nr, nc, gridhead)
		if (gridhead(1) .gt. 0) then
C*****	Get the requested grid, from the specified file
			temp=0
			call swbyt4(temp,1)
        		call m0sxsend(4,temp)
        		comblock(41)=comblock(41)+4
C****	set word 17 of header to the grid number
			gridhead(17)=grid
			call m0flpgdr(gridhead)
			call m0sxsend (256, gridhead)
		endif
700	continue

750	continue

C****	send a flag indicating no more grid directories for this file

	temp=1
	call swbyt4(temp,1)
        call m0sxsend(4,temp)
        comblock(41)=comblock(41)+4

C****	send a flag indicating no more grid files being listed

	temp=2
	call swbyt4(temp,1)
        call m0sxsend(4,temp)
        comblock(41)=comblock(41)+4

	iret=0
	errstring=' '
	goto 2001

C****   Sending file headers only

1000    continue
	totfiles=0

C***   get the bpos and epos sent down from the client
	iret=mcargint(0,'OUT',2,1,1,(egrid-bgrid+1),bpos,argdum)
	iret=mcargint(0,'OUT',3,1,bpos,(egrid-bgrid+1),epos,argdum)

C****   determine how many files are being sent

	do 1100 gridfile=bgrid+bpos-1,bgrid+epos-1
		call igname(gridfile,dummy)
		if (lwfile(filename) .ne. 0) totfiles=totfiles+1
1100	continue

C**** 	If we never found any files - we should set an error code
C****   and get outta here

	if (totfiles .eq. 0) then
                comblock(41)=0
                errstring='No Data Found'
                iret=-22013
                goto 2001
	endif

C****	calculate the number of bytes and send it to the client

	temp=totfiles*256+totfiles*8+4
	comblock(41)=totfiles*256
	call swbyt4(temp,1)
	call m0sxsend(4,temp)

C****   now loop through files, and send the headers and stat flags

	firsttime=1
	do 1200 gridfile=bgrid+bpos-1,bgrid+epos-1
		call igname(gridfile,dummy)
		if (lwfile (filename) .ne. 0) then
			if (firsttime.ne.1) then
				temp=1
				call swbyt4(temp,1)
				call m0sxsend(4,temp)
			endif
			temp=0
			call swbyt4(temp,1)
			call m0sxsend(4,temp)
			flip=isgfmt(gridfile)
C***			Read 64 words from grid file
			call lwi(filename,0,64,file_header)
			if (flip .ne. 0) then
				call fbyte4(file_header(11),1)
				call fbyte4(file_header(9),1)
				call fbyte4(file_header(10),1)
			endif
			if (file_header(11) .ge.-1) file_header(11)=159
			if (bgrid .ne. egrid) pos=gridfile-bgrid+1
			file_header(15)=pos
			do 1250 i=1,64
				if (ischar(file_header(i)).eq.0)then
					call swbyt4(file_header(i),1)
				endif
1250			continue
			call m0sxsend(256, file_header)
			firsttime=0
		endif
1200	continue

C****	Send flag(s) indicating all file directories & grid directories
C**** 	have been sent

	temp=1
	call swbyt4(temp,1)
	call m0sxsend(4,temp)
	temp=2
	call swbyt4(temp,1)
	call m0sxsend(4,temp)
	iret=0
	errstring=' '

C****	error conditions

2001	continue
	comblock(43)=iret
	call movcw(errstring,comblock(44))
	call lwmop
	return
	end

C     SEND ENTIRE GRID HEADER, this is the old (DDE) server.

      SUBROUTINE   GDIR(J)
      IMPLICIT NONE
      INTEGER J(64)

C --- external functions

      INTEGER IKWP
      INTEGER IPP
      INTEGER ISCHAR
      INTEGER LWFILE

C --- local variables

      CHARACTER*72 B
      CHARACTER*8 CNAME
      INTEGER DUMMY(2)
      INTEGER IDA
      INTEGER IG1
      INTEGER IG2
      INTEGER IGF
      INTEGER ISAVE
      INTEGER JA
      INTEGER JB
      INTEGER JJ
      INTEGER K(5000)
      INTEGER L(64)
      INTEGER MIS
      INTEGER NB
      INTEGER NBYTE
      INTEGER NFILE
      INTEGER NGRID

      EQUIVALENCE(DUMMY, CNAME)

      CALL STC(128,MIS,0)
      CALL STC(128,MIS,1)
      CALL STC(128,MIS,2)
      CALL STC(128,MIS,3)

C-----GRID FILE NUMBER

      IG1=IPP(0,0)
      IG2=IPP(1,IG1)

      IF(IG1.GE.IG2) THEN
          IGF=IG1
      ELSE
          CALL GETDAY(IDA)
          IDA=IKWP('DAY',1,IDA)
          NFILE=IG2-IG1+1
          IGF=IG1+MOD(IDA-1,NFILE)
      ENDIF

      CALL IGNAME(IGF,DUMMY)
      CALL M0SXTRCE('GRID FILE:'//CNAME)

C-    GOOD STATUS RETURN BUT NO RETBYTES=NO FILE

      IF(LWFILE(CNAME).EQ.0) THEN
          CALL M0SXSEND(4,0)
          RETURN
      ENDIF

      CALL LWI(CNAME,0,5000,K)
      NGRID=-K(11)
      NBYTE=48+256*NGRID
      WRITE(B,99) NGRID,NBYTE
 99   FORMAT('GRIDS=',I8,'   BYTES=',I8)
      CALL M0SXTRCE(B)
      J(41)=NBYTE
      NB=NBYTE
      CALL SWBYT4(NB,1)
      CALL M0SXSEND(4,NB)
      K(11)=NGRID
      ISAVE=K(12)
      K(12)=0
      CALL SWBYT4(K(9),4)
      CALL M0SXSEND(48,K)
      K(12)=ISAVE

      DO 1 JA=1,NGRID
         JJ=K(JA+11)

         IF(JJ.GT.0) THEN
            CALL LWI(CNAME,JJ,64,L)
         ELSE
            DO 3 JB=1,64
               L(JB)=MIS
3           CONTINUE
         ENDIF

         DO 2 JB=1,64
            IF(ISCHAR(L(JB)).EQ.0) CALL SWBYT4(L(JB),1)
 2       CONTINUE

        CALL M0SXSEND(256,L)
1     CONTINUE
      RETURN
      END
