c*** RDFGSA c subroutine rdfgsa(idate,btim) use filunit use grid use tracer c c----CAMx v7Beta6 190902 c c----------------------------------------------------------------------- c Description: c This routine reads the instantaneous file for the tracer c species. c c Copyright 1996 - 2018 c Ramboll c c Argument description: c Outputs: c Inputs: c idate I begining date of simulation (YYJJJ) c btim R begining time of simulation c c----------------------------------------------------------------------- c LOG: c----------------------------------------------------------------------- c c 11/06/01 --cemery-- Input dates are now Julian c c----------------------------------------------------------------------- c Include files: c----------------------------------------------------------------------- c include 'camx.prm' c c----------------------------------------------------------------------- c Argument declarations: c----------------------------------------------------------------------- c integer idate real btim c c----------------------------------------------------------------------- c Local variables: c----------------------------------------------------------------------- c character*60 msg character*10 cname integer*8 idx integer numfin, nspcs, ndate, indate integer ixfb, jyfb, ixfe, jyfe, nhf, nvf integer ifgptr, ifglvl, i, j, k, l, igrd, ifin integer ibgdat real ttime, timein, begtim logical lmatch c character*10 cspec(MXTRSP) integer nfx(MXGRID) integer nfy(MXGRID) integer nfz(MXGRID) integer irdgrd(MXGRID) logical lread(MXGRID) real cnctmp(MXCELLS,MXCELLS) c c----------------------------------------------------------------------- c Entry point: c----------------------------------------------------------------------- c c --- initialize all of the tracer concs to zero ---- c do igrd=2,ngrid do l=1,nsaspc do k=1,nlay(igrd) do j=1,nrow(igrd) do i=1,ncol(igrd) idx = ipsa3d(igrd)-1 + DBLE(i) + & DBLE(ncol(igrd))*DBLE(j-1) + & DBLE(ncol(igrd))*DBLE(nrow(igrd))*DBLE(k-1) + & DBLE(ncol(igrd))*DBLE(nrow(igrd))*DBLE(nlay(igrd))*DBLE(l-1) ptconc(idx) = 0. enddo enddo enddo enddo enddo c c --- initialize the "read-in" flag --- c do i=1,ngrid lread(i) = .FALSE. enddo c c --- if the file was not supplied then all of the grids are c to be assigned ---- c if( inifil(IDXFIN) .EQ. ' ' ) goto 222 c c --- open the fine grids instantaneous file --- c open(unit=iorini(IDXFIN),file=inifil(IDXFIN), & form='UNFORMATTED',ERR=7000,status='UNKNOWN') c c --- convert the date and time --- c ndate = idate ttime = btim if( ttime .EQ. 2400.0 ) then ttime = 0. ndate = ndate + 1 if( MOD(ndate,1000) .GT. 365 ) then if( MOD(INT(ndate/1000),4) .EQ. 0 ) then if( MOD(ndate,1000) .EQ. 367 ) & ndate = (INT(ndate/1000)+1)*1000 + 1 else ndate = (INT(ndate/1000)+1)*1000 + 1 endif endif endif c c --- file description header --- c read(iorini(IDXFIN),ERR=7000) msg read(iorini(IDXFIN),ERR=7000) numfin, nspcs if( nspcs .GT. MXTRSP ) then write(iout,'(//,A)') 'ERROR in RDFGSA:' write(iout,*) 'A parameter in the camx.prm is not ', & 'sufficiently large.' write(iout,*) 'Please change the value for parameter: MXTRSP' write(iout,*) 'It should be set to a value of at least: ',nspcs call flush(iout) call camxerr() endif c c ---- species list --- c read(iorini(IDXFIN),ERR=7000) (cspec(i),i=1,nspcs) c c --- make sure species list is compatable, up to timing tracers --- c do l=1,nspcs cname = cspec(l) if( cname .NE. ptname(l) ) goto 7004 enddo c c --- read the fine grid descriptions, and check for c consistancy --- c do ifin=1,numfin read(iorini(IDXFIN),ERR=7000) ixfb, jyfb, ixfe, jyfe, & nhf, nvf, nfx(ifin), nfy(ifin), nfz(ifin), & ifgptr, ifglvl do igrd=2,ngrid lmatch = .TRUE. if( ixfb .NE. inst1(igrd) ) lmatch = .FALSE. if( jyfb .NE. jnst1(igrd) ) lmatch = .FALSE. if( ixfe .NE. inst2(igrd) ) lmatch = .FALSE. if( jyfe .NE. jnst2(igrd) ) lmatch = .FALSE. if( nhf .NE. meshold(igrd) ) lmatch = .FALSE. if( nvf .NE. meshold(igrd) ) lmatch = .FALSE. if( nfx(ifin) .NE. ncol(igrd) ) lmatch = .FALSE. if( nfy(ifin) .NE. nrow(igrd) ) lmatch = .FALSE. if( nfz(ifin) .NE. nlay(igrd) ) lmatch = .FALSE. if( lmatch ) then lread(mapgrd(igrd)) = .TRUE. irdgrd(mapgrd(igrd)) = ifin endif enddo enddo c c --- make sure time span is correct --- c read(iorini(IDXFIN),ERR=7000) timein, indate ibgdat = indate begtim = timein if( begtim .EQ. 2400.0 ) then begtim = 0. ibgdat = ibgdat + 1 if( MOD(ibgdat,1000) .GT. 365 ) then if( MOD(INT(ibgdat/1000),4) .EQ. 0 ) then if( MOD(ibgdat,1000) .EQ. 367 ) & ibgdat = (INT(ibgdat/1000)+1)*1000 + 1 else ibgdat = (INT(ibgdat/1000)+1)*1000 + 1 endif endif endif if( ibgdat .NE. ndate .OR. & ABS(begtim-ttime) .GT. 0.00001 ) goto 7002 c c --- read the data for this hour ---- c do 50 ifin=1,numfin do 60 l=1,nspcs do 70 k=1,nfz(ifin) read(iorini(IDXFIN)) ((cnctmp(i,j),i=1,nfx(ifin)), & j=1,nfy(ifin)) c c-----Find the grid in this setup ---- c do igrd = 2,ngrid if( irdgrd(igrd) .EQ. ifin ) then if( l .EQ. 1 .and. k .EQ. 1 ) & write(iout,'(a40,f5.0,i8.5,a,i3)') & 'Read fine grid restart file at ', & timein, ibgdat,' grid',igrd do 80 j=1,nrow(igrd) do 90 i=1,ncol(igrd) idx = DBLE(ipsa3d(igrd)-1) + DBLE(i) + & DBLE(ncol(igrd))*DBLE(j-1) + & DBLE(ncol(igrd))*DBLE(nrow(igrd))*DBLE(k-1) + & DBLE(ncol(igrd))*DBLE(nrow(igrd))*DBLE(nlay(igrd))*DBLE(l-1) ptconc(idx) = cnctmp(i,j) 90 continue 80 continue endif enddo 70 continue 60 continue 50 continue c c --- close file and return to calling routine --- c close(iorini(IDXFIN)) c c-----Load data for the grids not found in restart file---- c 222 continue do ip = 1,ngrid do ic = 1,nchdrn(ip) ig = idchdrn(ic,ip) if( .NOT. lread(ig) ) then write(iout,'(a40,f7.0,i8.5,a,i3)') & 'Assigning SA concs from parent grid at ', & btim, idate,' grid',ig call rassgn4d(ncol(ip),nrow(ip),nlay(ip),nsaspc,i1(ig), & j1(ig),nmesh(ig),ncol(ig), & nrow(ig),nlay(ig),ptconc(ipsa3d(ip)), & ptconc(ipsa3d(ig)) ) endif enddo enddo goto 9999 c c----------------------------------------------------------------------- c Error messages: c----------------------------------------------------------------------- c 7000 continue write(iout,'(//,a)') 'ERROR in RDFGSA:' write(iout,9000,ERR=9999)'Reading the header of the ', & 'tracer concentration initialization file for fine grids: ', & inifil(IDXFIN)(:istrln(inifil(IDXFIN))) call camxerr() c 7002 continue write(iout,'(//,a)') 'ERROR in RDFGSA:' write(iout,9000,ERR=9999) 'Tracer concentration ', & 'initialization file for fine grids is not for correct ', & 'time period; ',inifil(IDXFIN)(:istrln(inifil(IDXFIN))) write(iout,9001,ERR=9999) 'Simulation Start: ',idate,btim write(iout,9001,ERR=9999) 'Initialization File: ',ibgdat,timein call camxerr() c 7004 continue write(iout,'(//,a)') 'ERROR in RDFGSA:' write(iout,9000,ERR=9999) 'Species list for tracer ', & 'concentration initialization file for fine grids ', & 'is inconsistent with user parameters ', & inifil(IDXFIN)(:istrln(inifil(IDXFIN))) write(iout,9004,ERR=9999) 'Species number: ',l,' should be ', & ptname(l),' and ',cname,' was read instead.' call camxerr() c c----------------------------------------------------------------------- c Format statements: c----------------------------------------------------------------------- c 9000 format(/,1X,6A) 9001 format(1X,A,I10.5,F10.1) 9004 format(1X,A,I5,5A) c c----------------------------------------------------------------------- c Return point: c----------------------------------------------------------------------- c 9999 continue c return end