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: mcfndgrd.f,v 1.23 2012/12/28 22:23:21 scottl Tst $ *** *$ Name: *$ mcfndgrd - Returns the first grid number that matches the *$ sorting conditions. *$ *$ Interface: *$ integer function *$ mcfndgrd(integer gridf, integer day(*), integer numday, *$ integer time(*), integer numtim, integer vt(*), *$ integer numvt, integer level(*), integer numlev, *$ character*(*) parm(*), integer numpar, *$ character*(*) origin(*), integer numorg, *$ integer head(*), integer flag) *$ *$ Input: *$ gridf - Grid file number to search. *$ day - Array containing list of days to search. *$ numday - Number of elements to search in 'day' array. *$ time - Array containing list of times to search. *$ The format is (hhmmss). *$ numtim - Number of elements to search in 'time' array. *$ vt - Array containing list of valid times to search. *$ the format is (hhmmss). *$ numvt - Number of elements to search in 'vt' array. *$ level - Array containing list of valid levels to search. *$ numlev - Number of elements to search in 'level' array. *$ parm - Parameter name(s) to search for. *$ numpar - Number of parameters used in parm. If you want *$ to ignore the parm argument set numpar to 0. *$ origin - Source(s) of the grid. *$ numorg - Number of sources used in origin. If you want *$ to ignore the origin argument set numorg to 0. *$ *$ Input and Output: *$ flag - The first grid in the grid file *$ that you want mcfndgrd() to search from. *$ On output it is set to the one past the grid *$ that matches the criteria. *$ If subsequent calls to mcfndgrd() are made, the *$ search begins at the first grid after the last *$ match was found. If you want the search to *$ begin at the top of the grid file again, reset *$ flag to 1. *$ *$ Output: *$ head - Array containing the McIDAS grid header. *$ *$ Return values: *$ n - The number of the grid that matched the search *$ conditions. *$ 0 - No grid was found that matched the search conditions. *$ -1 - Grid file does not exist. *$ -2 - Invalid gridfile number is specified. *$ *$ Remarks: *$ If you specify values for 'day', 'time', 'vt', 'level' in *$ ascending order mcfndgrd() assumes you want everything *$ within the range. If you specify them in descending order, *$ then it will only return those grids that match the condition *$ exactly. For example, if vt(1)=120000 and vt(2) = 480000 then *$ all forecast times between 12 and 48 hours inclusive will be *$ returned. If vt(1)=480000 vt(2) = 120000 then only the 12 and *$ 48 hour forecasts will be returned. *$ *$ There is a list of 3 values for the level parameter with *$ special meaning: *$ 1013 - Mean sea level (msl). *$ 1001 - Surface (sfc). *$ 0 - Tropopause (tro). *$ *$ Categories: *$ grid *$ file INTEGER FUNCTION mcfndgrd(gridf,day,numday,time, & numtim,vt,numvt,level,numlev,parm, & numpar,origin,numorg,head,flag) IMPLICIT INTEGER (a-z) include 'gridparm.inc' PARAMETER (hedsiz = 64 , altern = 4) PARAMETER (blocksiz=10000) integer mcsameiydcyd integer m0levequal INTEGER day(*) , time(*) , level(*) , vt(*) , head(*) INTEGER header(hedsiz) , alinam(altern) , & alilev(altern) , tmplev(100) integer wblock(blocksiz) real*4 tstlev CHARACTER*12 origin(*) , parm(*) CHARACTER*512 filnam CHARACTER*512 errstr DATA alilev/1013 , 1001 , 999 , 0/ DATA initcl/0/ DATA lasgdf/-1/ DATA blockind/1/ data maxgrd /0/ data flip /0/ data daylow /0/ data dayhi /0/ data vtlow /0/ data vthi /0/ data levlow /0/ data levhi /0/ if (initcl .eq. 0)then initcl = 1 call movcw('MSL SFC TRO ',alinam) endif mcfndgrd = -2 flag = max0(flag,1) c--- check to make sure that the grid file number c--- specified is valid for this system if (gridf.lt.MINGRIDFILE .or. gridf.gt.MAXGRIDFILE)goto 999 c--- check to make certain that the grid file exists mcfndgrd = -1 c--- if this gridfile is the same as the last c--- grid file, no need to get this information again if (gridf .ne. lasgdf) then call igfilename(gridf,filnam) exist = lwfile(filnam) if (exist .eq. 0)goto 999 flip = isgfmt(gridf) if(flip .eq. -2) go to 999 maxgrd = iggmax(gridf,start) lasgdf = gridf c--- buffer the read, to improve performance call lwi(filnam,start,blocksiz,wblock) if (flip .ne. 0)call fbyte4(wblock,blocksiz) blockind=1 endif mcfndgrd = 0 c--- set up flags for the search c--- set up conditions for the day array c--- set dayflg to 1 if you are specifying a range dayflg = 0 if (numday .gt. 0)then if (numday .eq. 2)then if (day(1) .le. day(2))then daylow = min0(day(1) , day(2)) dayhi = max0(day(1) , day(2)) dayflg = 1 endif endif endif c--- set up conditions for the time array c--- set timflg to 1 if you are specifying a range timflg = 0 if (numtim .gt. 0)then if (numtim .eq. 2)then if (time(1) .le. time(2))then timlow = min0(time(1) , time(2)) timhi = max0(time(1) , time(2)) timflg = 1 endif endif endif c--- set up conditions for the vt array c--- set vtflg to 1 if you are specifying a range vtflg = 0 if (numvt .gt. 0)then if (numvt .eq. 2)then if (vt(1) .le. vt(2))then vtlow = min0(vt(1) , vt(2)) vthi = max0(vt(1) , vt(2)) vtflg = 1 endif endif endif c--- set up conditions for the level array c--- set levflg to 1 if you are specifying a range levflg = 0 if (numlev .gt. 0)then c--- this is the special case if the user specifies c--- msl instead of 1013 c--- sfc instead of 1001 c--- ' ' instead of 999 c--- tro instead of 0 do 10 i = 1 , numlev tmplev(i) = level(i) do 20 j = 1 , altern if (tmplev(i) .eq. alinam(j))then tmplev(i) = alilev(j) endif 20 continue 10 continue if (numlev .eq. 2)then if (tmplev(1) .le. tmplev(2))then levlow = min0(tmplev(1) , tmplev(2)) levhi = max0(tmplev(1) , tmplev(2)) levflg = 1 endif endif endif c--- begin search for grid that matches search c--- conditions lasgrd = flag do 100 i = lasgrd , maxgrd c--- if i is larger than blocksiz, we need to read in a new block if (i .gt. (blocksiz*blockind)) then call lwi(filnam,start+(blocksiz*blockind),blocksiz,wblock) if (flip .ne. 0)call fbyte4(wblock,blocksiz) blockind=blockind+1 endif word=wblock(i-(blocksiz*(blockind-1))) if (word .le. 0)goto 100 call lwi(filnam,word,hedsiz,header) if (flip .ne. 0)call fghed(header) if (header(1) .gt. 0)then c--- if the day is specified, check to make certain c--- it is in the range if (numday .gt. 0)then c--- if the list option is specified if (dayflg .eq. 0)then do 110 j = 1 , numday if (mcsameiydcyd(header(4),day(j)) .eq. 1)goto 115 110 continue goto 100 115 continue c--- if the range option is specified else if (header(4) .lt. daylow .or. header(4) .gt. dayhi) & goto 100 endif endif c--- if the time is specified, check to make certain c--- it is in the range if (numtim .gt. 0)then c--- if the list option is specified if (timflg .eq. 0)then do 120 j = 1 , numtim if (header(5) .eq. time(j))goto 125 120 continue goto 100 125 continue c--- if the range option is specified else if (header(5) .lt. timlow .or. header(5) .gt. timhi) & goto 100 endif endif c--- if the v time is specified, check to make certain c--- it is in the range if (numvt .gt. 0)then c--- if the list option is specified if (vtflg .eq. 0)then do 130 j = 1 , numvt if (header(6) .eq. vt(j))goto 135 130 continue goto 100 135 continue c--- if the range option is specified else if (header(6) .lt. vtlow .or. & header(6) .gt. vthi) goto 100 endif endif c--- if the level is specified, check to make certain c--- it is in the range if (numlev .gt. 0)then C------- convert the levels in the header if necessary. C tstlev = (1.*header(10))*(10.**header(11)) if (nint(tstlev) .eq. lit('SFC ')) tstlev = 1001 if (nint(tstlev) .eq. lit('MSL ')) tstlev = 1013 if (nint(tstlev) .eq. lit('TRO ')) tstlev = 0 if (nint(tstlev) .eq. lit(' ')) tstlev = 999 c--- if the list option is specified if (levflg .eq. 0)then do 140 j = 1 , numlev rc = m0levequal(tstlev,tmplev(j)) if (rc .eq. 1) goto 145 140 continue goto 100 145 continue c--- if the range option is specified else if (tstlev .lt. levlow .or. tstlev .gt. levhi) & goto 100 endif endif c--- if a parameter is specified if (numpar .gt. 0)then do 150 par = 1 , numpar name = lit(parm(par)(1:4)) if (header(7) .eq. name)goto 155 150 continue goto 100 155 continue endif c--- if a grid origin is specified if (numorg .gt. 0)then do 160 org = 1 , numorg name = lit(origin(org)(1:4)) if (header(33) .eq. name)goto 165 160 continue goto 100 165 continue endif c--- if you have made it to here, the grid you are c--- currently looking at matches the search c--- conditions specified so set mcfndgrd accordingly, c--- update flag, and exit mcfndgrd = i flag = i + 1 call movw(hedsiz,header,head) call ddest('mcfndgrd - grid match found at grid ',mcfndgrd) goto 999 endif 100 continue 999 continue return end *$ Name: *$ m0levequal -- are the level representations the same? *$ *$ Interface: *$ integer function *$ m0levequal(integer gridlevel, integer testlevel) *$ *$ Input: *$ gridlevel - value inside grid header *$ testlevel - LEV= entry from command line *$ *$ Input and Output: *$ none *$ *$ Output: *$ none *$ *$ Return values: *$ 1 - equal *$ 0 - not equal *$ *$ Remarks: *$ One of these may be a clit or lit or special character *$ *$ Categories: *$ file INTEGER FUNCTION m0levequal(gridlevel,testlevel) real*4 gridlevel integer testlevel double precision dval character*4 ctestlevel call movw(4,testlevel,ctestlevel) m0levequal = 0 if (gridlevel .eq. testlevel) m0levequal = 1 rc = mcstrtodbl(ctestlevel,dval) if (rc .ge. 0) then if (gridlevel .eq. dval) m0levequal = 1 if (nint(gridlevel*10000) .eq. idnint(dval*10000)) m0levequal=1 endif return end