c c------------------------------------------------------------------ c Begin file /home/sting/foster/timegcm/gettime.f c------------------------------------------------------------------ c subroutine gettime(vols,nhvols,lu,md,mh,mm,istart,found,ivf) c c Find and process history md:mh:mm c c On input: c vols(nhvols) = history volume(s) to search for md:mh:mm c md,mh,mm = model day, hour minute of history to be found c istart defined: if > 0 -> rewind all volumes and start c search from beginning of 1st vol c On output: c found = .true. if history was found, .false. otherwise c ivf = index of volume in vols in which history was found c if found, history has been processed with subroutine timelat c c Note: Current volume (ivc) and position in that volume (itc) c are saved between calls so that chronological histories c may be found in a series of calls without searching over c from the beginning each time. (if istart > 0, however, c the search always starts at beginning of first volume) c include 'timeparam.h' include 'timerd.h' include 'timegcm.h' include 'tgcmhdr.h' c character*8 vols(3,nhvols) logical found,isthere,isopen character*80 errmsg character*128 srchpath,msspath dimension dum(8) c c lu = fort logical unit for history volume c ivc = current volume index (saved) c itc = current history index (saved) c itd = 1 -> store total density in td(i,k,j) c data ivc/1/ itc/1/, itd/0/, iprint/0/ save ivc,itc c c First close any previously assigned files under unit lu, c if starting new volume: c if (istart.eq.1) then inquire(lu,opened=isopen) if (isopen) then close(lu,iostat=ios) if (ios.ne.0) then write(6,"('>>> gettime: error ',i3,' closing unit ',i2)") + ios,lu else write(6,"('gettime: closed unit ',i2)") lu endif endif endif c c Set starting place for volume and history search: c found = .false. if (istart.gt.0) then iv1 = 1 it1 = 1 else iv1 = ivc it1 = itc endif c c Make sure /usr/tmp/TIGCM exists: istat = ishell( + "test -d /usr/tmp/TIGCM || mkdir -m 777 -p /usr/tmp/TIGCM") if (istat.ne.0) then write(6,"('>>> warning: ishell to make /usr/tmp/TIGCM failed', + ': istat=',i3)") istat endif c c Volume loop: c do 100 iv=iv1,nhvols ivc = iv c c Check in /usr/tmp/TIGCM before acquiring: c srchpath = '/usr/tmp/TIGCM/'//vols(2,iv)(1:lnblnk(vols(2,iv))) + //'.'//vols(3,iv)(1:lnblnk(vols(3,iv))) lenpath = lnblnk(srchpath) inquire(file=srchpath(1:lenpath),exist=isthere,opened=isopen) write(6,"('gettime: srchpath=',a,' isthere=',l1, + ' isopen=',l1)") srchpath(1:lenpath),isthere,isopen c c Acquire volume if not on /usr/tmp/TIGCM, c msspath = '/'//vols(1,ivc)(1:lnblnk(vols(1,ivc))) + //'/'//vols(2,ivc)(1:lnblnk(vols(2,ivc))) + //'/'//vols(3,ivc)(1:lnblnk(vols(3,ivc))) lenmss = lnblnk(msspath) call msread(ier,srchpath(1:lenpath),msspath(1:lenmss),' ',' ') if (ier.eq.3) then write(6,"('gettime: msread found file ',a,' on the disk', + /9x,'and did not read mss file ',a)") + srchpath(1:lenpath),msspath(1:lenmss) elseif (ier.ne.0) then call mserror(errmsg) write(6,"('gettime: msread error ',i3,' errmsg=',a, + /' msspath=',a)") + ier,errmsg,msspath(1:lenmss) else write(6,"('Successful msread of mss file ',a,' to ', + /' unicos file ',a)") msspath(1:lenmss),srchpath(1:lenpath) endif c c Assign volume, and rewind if necessary: c c if (.not.isopen) call assgn(srchpath,lu) inquire(file=srchpath(1:lenpath),opened=isopen,number=luopen) if (isopen) then write(6,"('gettime closing file ',a,' attached to unit ',i3)") + srchpath(1:lenpath),luopen close(luopen,iostat=ios) endif call assgn(srchpath,lu) if (istart.gt.0) then write(6,"('gettime rewinding unit ',i3)") lu rewind lu endif c c History loop: c do 105 it=it1,500 read(lu,end=900) iter,nday,nhr,nmin,label, + date,output,start,stp,hist,sav,step,mag,difhor,iuivi, + sdtide,ipower,aurora,dispos,data,source,sourct,dtide, + dum,rdate,naurp,hp,cp,byimf write(6,"('Gettime: Searching for ',i2,':',i2,':',i2, + ' -- Found ',i2,':',i2,':',i2,' vol =',a,' it=',i3)") + md,mh,mm,nday,nhr,nmin,vols(3,ivc),it c c History found -- process latitude slices and return: c if (nday.eq.md.and.nhr.eq.mh.and.nmin.eq.mm) then found = .true. ivf = ivc write(6,"(' ')") write(6,"('Gettime found history ',i2,':',i2,':', + i2,' on volume ',3a8,' at it=',i3)") + md,mh,mm,(vols(i,ivc),i=1,3),it read(lu) dummy do 110 j=1,jmx buffer in(lu,1)(frd(1),frd(nwlat)) if (unit(lu)) 10,11,11 11 write(6,"(' >>> Gettime: io problem buffering in j=', + i3,' lu=',i3,' unit(lu)=',e12.4)") + j,lu,unit(lu) stop 'bufin' 10 continue c c Temp: if (iprint.gt.0.and.j.eq.5) then do ip=1,nfrd write(6,"(' ')") write(6,"('Field ',a8)") timelab_short(ip) write(6,"('gettime: ip=',i3,' j=',i3, + ' f(1,1-kmx,ip)=',/(5e12.4))") ip,j, + (f(1,k,ip),k=1,kmx) write(6,"('gettime: ip=',i3,' j=',i3, + ' f(2,1-kmx,ip)=',/(5e12.4))") ip,j, + (f(2,k,ip),k=1,kmx) write(6,"('gettime: ip=',i3,' j=',i3, + ' f(37,1-kmx,ip)=',/(5e12.4))") ip,j, + (f(37,k,ip),k=1,kmx) write(6,"('gettime: ip=',i3,' j=',i3, + ' f(73,1-kmx,ip)=',/(5e12.4))") ip,j, + (f(73,k,ip),k=1,kmx) write(6,"('gettime: ip=',i3,' j=',i3, + ' f(74,1-kmx,ip)=',/(5e12.4))") ip,j, + (f(74,k,ip),k=1,kmx) enddo endif c End temp: c c call timelat(j,itd,0,0) 110 continue return else c c History not found -- skip summary and latitude slices: c read(lu) dummy do 115 j=1,jmx 115 read(lu) dummy endif 105 continue 900 write(6,"(' ')") write(6,"('Gettime: EOF encountered on unit ',i3,' it=',i3, + ' hist=',a)") lu,it,srchpath(1:lenpath) close(lu) 100 continue write(6,"(' ')") write(6,"('Gettime: Could not find time ',i2,':',i2,':',i2)") + md,mh,mm return end