subroutine readgrids c c======================================================================= c === c This subroutine reads in domain configuration parameters and === c bottom topography at the tracer points from GRIDS NetCDF file. === c It could be used, for example, when the initialization is via === c the routine ANAFLDS, and not from the PE_INITIAL NetCDF file. === c === c======================================================================= c c----------------------------------------------------------------------- c Define global data. c----------------------------------------------------------------------- c #include #include #include #include #include #include #include #include #include #include c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c logical flat,fndx,fndy integer dblsig,dimid,dimsiz,i,icoast,imax,ios,j,jmax,k,kmax, * lendim,lenstr,lenvar,n,ndims,ngatts,nvars,nvatts,nvdims, * recdim,vartyp integer count(2),start(2),vdims(maxvdims) integer lnblk character*1 string character*20 dimnam,varnam c data fndx,fndy /.false.,.false./ c c======================================================================= c Begin executable code. c======================================================================= c c Initialize some parameters. c icoast=0 coord=0 c c Open GRIDS NetCDF file. c lenstr=lnblk(grdname,len(grdname)) ncinpid=ncopn(grdname(1:lenstr),ncnowrit,rcode) if(rcode.ne.0) then write(stdout,900) grdname(1:lenstr) call exitus('READGRIDS') endif c c----------------------------------------------------------------------- c Inquire about the contents of open NetCDF file: Inquire about the c dimensions and variables. c----------------------------------------------------------------------- c call ncinq(ncinpid,ndims,nvars,ngatts,recdim,rcode) if(rcode.eq.0) then c c Inquire about dimensions. c do 10 n=1,ndims dimid=n call ncdinq(ncinpid,dimid,dimnam,dimsiz,rcode) if(rcode.ne.0) then write(stdout,910) n,grdname(1:lenstr) call exitus('READGRIDS') endif lendim=lnblk(dimnam,len(dimnam)) if(dimnam(1:lendim).eq.'tlon') then imax=dimsiz elseif(dimnam(1:lendim).eq.'tlat') then jmax=dimsiz elseif(dimnam(1:lendim).eq.'level') then kmax=dimsiz endif 10 continue c c Check main dimensions. c if(imax.ne.imt) then write(stdout,920) 'IMT = ',imt,imax call exitus('READGRIDS') endif if(jmax.ne.jmt) then write(stdout,920) 'JMT = ',jmt,jmax call exitus('READGRIDS') endif if(kmax.ne.km) then write(stdout,920) 'KM = ',km,kmax call exitus('READGRIDS') endif c c----------------------------------------------------------------------- c Inquire about variables. Read as needed. c----------------------------------------------------------------------- c do 20 n=1,nvars varid=n call ncvinq(ncinpid,varid,varnam,vartyp,nvdims,vdims,nvatts, * rcode) if(rcode.eq.0) then c c Read in model domain parameters. c lenvar=lnblk(varnam,len(varnam)) if(varnam(1:lenvar).eq.'coord') then call ncvgt1(ncinpid,varid,1,coord,rcode) if(rcode.ne.0) then write(stdout,930) 'coord',grdname(1:lenstr) call exitus('READGRIDS') elseif((coord.lt.0).or.(coord.gt.2)) then write(stdout,940) 'COORD = ',coord call exitus('READGRIDS') endif elseif(varnam(1:lenvar).eq.'rlngd') then call ncvgt1 (ncinpid,varid,1,rlngd,rcode) if(rcode.ne.0) then write(stdout,930) 'rlngd',grdname(1:lenstr) call exitus('READGRIDS') endif elseif(varnam(1:lenvar).eq.'rlatd') then call ncvgt1(ncinpid,varid,1,rlatd,rcode) if(rcode.ne.0) then write(stdout,930) 'rlatd',grdname(1:lenstr) call exitus('READGRIDS') endif elseif(varnam(1:lenvar).eq.'delx') then call ncvgt1(ncinpid,varid,1,delx,rcode) if(rcode.ne.0) then write(stdout,930) 'delx',grdname(1:lenstr) call exitus('READGRIDS') endif fndx = .true. elseif(varnam(1:lenvar).eq.'dely') then call ncvgt1(ncinpid,varid,1,dely,rcode) if(rcode.ne.0) then write(stdout,930) 'dely',grdname(1:lenstr) call exitus('READGRIDS') endif fndy = .true. elseif(varnam(1:lenvar).eq.'thetad') then call ncvgt1(ncinpid,varid,1,thetad,rcode) if(rcode.ne.0) then write(stdout,930) 'thetad',grdname(1:lenstr) call exitus('READGRIDS') endif elseif(varnam(1:lenvar).eq.'meandx') then call ncvgt1(ncinpid,varid,1,gridx,rcode) if(rcode.ne.0) then write(stdout,930) 'meandx',grdname(1:lenstr) call exitus('READGRIDS') endif elseif(varnam(1:lenvar).eq.'meandy') then call ncvgt1(ncinpid,varid,1,gridy,rcode) if(rcode.ne.0) then write(stdout,930) 'meandy',grdname(1:lenstr) call exitus('READGRIDS') endif c c Read in terrain-following coordinate system parameters. c elseif(varnam(1:lenvar).eq.'kc') then call ncvgt1(ncinpid,varid,1,kc,rcode) if(rcode.ne.0) then write(stdout,930) 'kc',grdname(1:lenstr) call exitus('READGRIDS') endif iflag(8)=kc elseif(varnam(1:lenvar).eq.'flat') then call ncvg1c(ncinpid,varid,1,string,rcode) if(rcode.eq.0) then read(string,'(l1)',iostat=ios) flat if(ios.eq.0) then if(flat) then dblsig=0 else dblsig=1 endif iflag(9)=dblsig else write(stdout,950) 'flat',string call exitus('READGRIDS') endif else write(stdout,930) 'flat',grdname(1:lenstr) call exitus('READGRIDS') endif #ifdef dblsigma elseif(varnam(1:lenvar).eq.'zc1') then call ncvgt1(ncinpid,varid,1,zc1,rcode) if(rcode.ne.0) then write(stdout,930) 'zc1',grdname(1:lenstr) call exitus('READGRIDS') endif zc1=cm1*zc1 elseif(varnam(1:lenvar).eq.'zc2') then call ncvgt1(ncinpid,varid,1,zc2,rcode) if(rcode.ne.0) then write(stdout,930) 'zc2',grdname(1:lenstr) call exitus('READGRIDS') endif zc2=cm1*zc2 elseif(varnam(1:lenvar).eq.'zref') then call ncvgt1(ncinpid,varid,1,zref,rcode) if(rcode.ne.0) then write(stdout,930) 'zref',grdname(1:lenstr) call exitus('READGRIDS') endif zref=cm1*zref elseif(varnam(1:lenvar).eq.'zslope') then call ncvgt1(ncinpid,varid,1,zslope,rcode) if(rcode.ne.0) then write(stdout,930) 'zslope',grdname(1:lenstr) call exitus('READGRIDS') endif #endif c c Read in flat level thicknesses. c elseif(varnam(1:lenvar).eq.'hz') then call ncvgt(ncinpid,varid,1,km,hz,rcode) if(rcode.ne.0) then write(stdout,930) 'hz',grdname(1:lenstr) call exitus('READGRIDS') endif c c Read in bottom topography. c elseif(varnam(1:lenvar).eq.'tbath') then start(1)=1 count(1)=imt start(2)=1 count(2)=jmt call ncvgt(ncinpid,varid,start,count,hr,rcode) if(rcode.ne.0) then write(stdout,930) 'tbath',grdname(1:lenstr) call exitus('READGRIDS') endif c c Availability of Land/Sea mask data. c elseif((varnam(1:lenvar).eq.'landt').or. * (varnam(1:lenvar).eq.'landt')) then icoast=1 elseif((varnam(1:lenvar).eq.'isis').or. * (varnam(1:lenvar).eq.'ieis').or. * (varnam(1:lenvar).eq.'jsis').or. * (varnam(1:lenvar).eq.'jeis')) then icoast=2 endif c c Unable to examine GRIDS NetCDF variable. c else write(stdout,960) n,grdname(1:lenstr) call exitus('READGRIDS') endif 20 continue c c Ensure backward compatibility. c if (.not.(fndx.and.fndy)) then if (coord.ne.1) then delx = c0 dely = c0 write (stdout,980) else delx = rlngd dely = rlatd rlngd = c0 rlatd = c0 write (stdout,990) rlngd,rlatd endif endif c c Unable to examine GRIDS NetCDF file. c else write(stdout,970) grdname(1:lenstr) call exitus('READGRIDS') endif c c----------------------------------------------------------------------- c Convert some variables from MKS to CGS. c----------------------------------------------------------------------- c if(coord.eq.0) then gridx=gridx*m2cm gridy=gridy*m2cm delx =delx*m2cm dely =dely*m2cm endif #ifdef dblsigma zc1=zc1*m2cm zc2=zc2*m2cm zref=zref*m2cm #endif do 30 k=1,km hz(k)=hz(k)*m2cm 30 continue do 40 j=1,jmt do 40 i=1,imt hr(i,j)=abs(hr(i,j))*m2cm 40 continue c c Set Land/Sea mask switch. c iflag(10)=icoast c c Compute reference flat level depths from thicknesses. c refz(1)=p5*hz(1) #ifndef barotropic do 50 k=2,km refz(k)=refz(k-1)+p5*(hz(k-1)+hz(k)) 50 continue #endif c 900 format(/,'READGRIDS - unable to GRIDS NetCDF file: ',a) 910 format(/' READGRIDS - error while reading dimension: ',a,2x, * ' in GRIDS NetCDF file: ',a) 920 format(/' READGRIDS - inconsistent parameter value, ',a,2i5) 930 format(/' READGRIDS - error while reading variable: ',a,2x, * ' in GRIDS NetCDF file: ',a) 940 format(/' READGRIDS - illegal parameter value, ',a,i5) 950 format(/' READGRIDS - illegal parameter value, ',a,a) 960 format(/' READGRIDS - error inquiring information for variable: ', * i3,2x,' in GRIDS NetCDF file: ',a) 970 format(/' READGRIDS - unable to inquire about contents of', * ' GRIDS NetCDF file: ',a) 980 format (/'+++Warning: READGRIDS - old GRIDS file.'/13x, & 'Replacing GRIDS values (DELX,DELY) by (0,0)') 990 format (/'+++Warning: READGRIDS - old GRIDS file.'/13x, & 'Replacing GRIDS values (DELX,DELY) by (',f8.3,', ',f8.3, & ')'/13x,'and GRIDS values (RLNGD,RLATD) by (0,0)') c return end