c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE GETGCMF(VOL,NVOL,ISTART,MT,FIELDS,NFIELDS,IFIELDS,NLON, c + NZP,NLAT,NF,IDEN,LU,IPRHDR,IVOL,ISTIEGCM,IER) c c Get tiegcm history at time mt(3) from mss volume(s) vol, and return c tiegcm output in fields array. c Relocatable library for Cray is in mss file /FOSTER/lib/getgcm.a c c ON INPUT: c VOL = character var containing mss path(s) to model history volume(s) c NVOL = number of file names in vol c ISTART = flag for mss history volume(s) as follows: c 0 -> continue search from current file position on current volume c 1 -> restart search from beginning of first volume c < 0 -> start search from volume index abs(istart) (added 9/93, bf) c Normally, istart=1 when you get the 1st history, then istart=0 c for subsequent histories with increasing times. c Note istart enables the user to access histories out of order, c i.e., decreasing times. If a current time is less than a previous c time, set istart=1 to search from beginning of first volume. c ISTART < 0 forces search to begin from vol index abs(istart) (9/93) c MT(3) = integer model day, hour, and minute of desired history c Note if you just want to find out what histories are on a volume, c pass in a high model day (e.g., mt(1)=99). (only one such time c i.e. one call, is necessary to search all given volumes) c FIELDS is dimensioned (nlon,nzp,nlat,nfields) (should be 73,25,36,nfields) c NFIELDS = number of fields to get c IFIELDS(NF) = which fields to get (each ifield(i) = 0 or 1) c (sum of number of ifields(i) > 0 should = nfields) c NLON,NZP,NLAT,NF should be 73, 25, 36, 17: c number of longitudes, pressures, latitudes, and fields respectively c The tgcm global grid is 73 longitudes (-180->180 by 5.), c 36 latitudes (-87.5->87.5 by 5.), and 25 pressure levels c (-7->5 by 0.5). There are 17 fields as follows: c T,U,V,O2,O1,N4S,NO,O+,N2D,TI,TE,NE,O2+,W,Z,POT,N2 c IDEN = density flag c 0 -> leave species as on history (most are mass mixing ratio) c 1 -> convert species to number densities (cm3) c 2 -> convert species to mass density (gm/cm3) c (Note O+, Ne, and O2+ will remain number densities regardless of iden) c LU = logical unit for mss history volumes (0 > lu < 100 and != 5,6, or 2) c if IPRHDR > 0, getgcm will print a summary of the tgcm header for the c found history. c c ON OUTPUT: c IVOL = index to vol on which history was found (will be < 0 if history c was not found) c ISTIEGCM (logical) = .true. if history is found to be from tiegcm c model, .false. otherwise (history is from tigcm model) c if IER = 0 -> no error has occurred. If IER=1, history was not found, c if IER != 0 and IER != 1, some error has occurred, and an error c message will be printed to standard out (unit 6). c If no error has occurred, fields array will contain desired fields at c tiegcm global grid in the following order: c T,U,V,O2,O1,N4S,NO,O+,N2D,TI,TE,NE,O2+,W,Z,POT,N2 c c Notes: c 1) This code runs on the Cray only and should be run with pshell c (e.g., pshell a.out) c 2) The job should be run in $TMPDIR on shavano (script should c cd $TMPDIR before execution) c 3) History volumes are staged to shavano dir /usr/tmp/TIGCM, c which is made with 777 permissions if it does not already exist. c Links are made from /usr/tmp/TIGCM to cwd ($TMPDIR) if the c volume is already on /usr/tmp/TIGCM, and before returning, c links are made back to /usr/tmp/TIGCM if the vol does not c exist there at the time of the return. This avoids unnecessary c acquires from the mss, saving files in /usr/tmp for subsequent runs. c The disk file on /usr/tmp/TIGCM is the mss path, with the home c dir dropped, and subsequent slashes converted to dots, e.g., c if mss=/ROBLE/RGR92/TISS11, then file on /usr/tmp/TIGCM/RGR92.TISS11. c 4) If the volume given is a tigcm volume rather than tiegcm, then c the potential field (field 16) will contain a temperature field, c NOT potential. It is the users responsibility to be aware of this. c 5) N2 is not stored in the histories. It is calculated as 1.-o2-o1. c 6) The getgcm.a library makes fortran calls to the ncar mss routines c msread and mserror. These are located on shavano in the library c /usr/local/lib/libmss.a, so this lib needs to be loaded as well. c c Ben Foster c foster@ncar.ucar.edu c 303-497-1595 c Feb, 1992 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c subroutine getgcmf(vol,nvol,istart,mt,fields,nfields,ifields, + nlon,nzp,nlat,nf,iden,lu,iprhdr,ivol,istiegcm,ier) c include "tgcmhdr.h" include "getgcm.h" character*(*) vol dimension mt(3),ifields(nf),fields(nlon,nzp,nlat,nfields), + vol(nvol) character*128 flnm,flnm1 logical isopen,exists,istiegcm data ivc/1/, thresh/2000./ save ivc c c Check some inputs: c ier = 0 if (lu.le.0.or.lu.gt.99.or.lu.eq.5.or.lu.eq.6) then write(6,"('>>> getgcm: bad lu = ',i5)") lu ier = 2 return endif if (mt(2).lt.0.or.mt(2).gt.23) then write(6,"('>>> getgcm: bad model hour (mt(2) = ',i5)") + mt(2) ier = 3 return endif if (mt(3).lt.0.or.mt(3).gt.59) then write(6,"('>>> getgcm: bad model minute (mt(3) = ',i5)") + mt(3) ier = 4 return endif if (nvol.le.0) then write(6,"('>>> getgcm: need history volumes: nvol=',i3)") + nvol ier = 5 return endif if (iden.gt.2.or.iden.lt.0) then write(6,"('>>> getgcm: bad iden=',i3,' (will default to ', + ' no.densities (iden=1))')") iden iden = 1 endif if (nlon.ne.imx.or.nlat.ne.jmx.or.nzp.ne.kmx.or.nf.ne.nflds+1) + then write(6,"('>>> warning getgcm: nlon,nlat,nzp,nf=',4i4, + ' imx,jmx,kmx,nflds+1=',4i4,/' (these values should be the ', + 'same and are not)')") nlon,nlat,nzp,nf,imx,jmx,kmx,nflds+1 endif do k=1,kmx gcmzp(k) = zp1 + (k-1)*dzp enddo c c Set starting volume for search: c Changed 9/93 to allow istart < 0, abs(istart)=index to first search vol: c istart > 0 -> start search from 1st volume c istart < 0 -> search from volume index abs(istart) c istart = 0 -> continue search from current vol (ivc saved from last exec) c if (istart.gt.0) then iv1 = 1 elseif (istart.lt.0) then iv1 = abs(istart) else iv1 = ivc endif c c Volume search loop: do 300 iv=iv1,nvol ivc = iv inquire(lu,opened=isopen) if (istart.gt.0.or..not.isopen) then call getvol(vol(iv),lu,isopen,iier) if (iier.eq.2) then write(6,"('>>> getgcm: getvol could not find vol ',a, + ' on mss -- ',/12x,'skipping to next vol')") vol(iv) goto 300 elseif (iier.ne.0) then write(6,"('>>> getgcm: error ',i3,' from getvol')") iier ier = 6 return endif rewind(lu) endif c c Now we should be positioned for history search: c it = 0 lenvol = lenstr(vol(iv)) 100 continue call rdhdr(lu,ieof) if (ieof.gt.0) goto 900 it = it+1 if (mt(1).eq.nday.and.mt(2).eq.nhr.and.mt(3).eq.nmin) goto 200 write(6,"('Getgcm: Searching for ',i2,':',i2,':',i2, + ' Found ',i2,':',i2,':',i2,' vol ',a,' it ',i3)") + mt,nday,nhr,nmin,vol(iv)(1:lenvol),it c c Read past unwanted history: c read(lu) dummy ! summary do j=1,nlat read(lu) dummy enddo goto 100 c c Found desired history -- process lat slices: c 200 continue istiegcm = .false. if (data(1).eq.'ECRIDLEY'.and.data(2).eq.'ECR90 '.and. + data(3).eq.'ECRMG6 ') istiegcm = .true. if (istiegcm) then write(6,"('Getgcm found tiegcm history ',i2,':',i2,':',i2, + ' on vol ',a,' (ivol=',i3,')')") mt,vol(iv)(1:lenvol),iv else write(6,"('Getgcm found tigcm history ',i2,':',i2,':',i2, + ' on vol ',a,' (ivol=',i3,')')") mt,vol(iv)(1:lenvol),iv endif ivol = iv read(lu) dummy ! summary do j=1,nlat buffer in(lu,1)(frd(1),frd(nwlat)) if (unit(lu)) 10,11,11 11 write(6,"(' >>> Getgcm: io problem buffering in j=', + i3,' lu=',i3,' unit(lu)=',e10.3)") j,lu,unit(lu) ier = 7 return 10 continue call proclat(j,iden) c c Define field array -- only desired fields: c ipp = 0 do ip=1,nflds if (ifields(ip).gt.0) then ipp = ipp+1 do i=1,imx fields(i,:,j,ipp) = f(i,:,ip) enddo endif enddo if (ifields(nflds+1).gt.0) then ipp = ipp+1 do i=1,imx fields(i,:,j,ipp) = gcmn2(i,:) enddo endif enddo ! j-loop c c Print summary of header if desired: c if (iprhdr.gt.0) call printhdr(vol(iv),mt) c c Save a link of the volume to /usr/tmp/TIGCM for possible future c reference, and return: c call mkflnm(vol(iv),flnm) flnm1 = "/usr/tmp/TIGCM/"//flnm(1:lenstr(flnm)) inquire(file=flnm1,exist=exists) if (.not.exists) istat = link(flnm,"/usr/tmp/TIGCM") return c c Got end of file: c 900 continue write(6,"('Getgcm: EOF encountered on unit ',i3,' it=',i3)") lu,it write(6,"(' History ',3i4,' not found on vol ',a,/8x, + '(closing unit',i3,')')") mt,vol(iv)(1:lenvol),lu close(lu) c c Volume loop: 300 continue write(6,"('Getgcm: could not find history ',3i3,' The following', + ' volumes were searched:')") mt do i=1,nvol write(6,"(a)") vol(i)(1:lenstr(vol(i))) enddo ier = 1 ivol = -1 return end