subroutine wrtcdf(jrow,f,m,n,scale,fldid,vindx,tindx,fileid) c c======================================================================= c === c This routine writes out the field F(m,n) at the specified slab === c JROW and at the requested levels in LEV(NLEV) in NetCDF format. === c If LEV is greater than KM then LEV is taken as depth in meters === c to interpolate. === c === c On Input: === c === c JROW current slab index (integer). === c F field to write (real array). === c M,N first and second dimension for field F (integer). === c SCALE scale factor for field (real). === c FLDID field ID in output NetCDF file (integer). === c VINDX vector component index (integer). === c TINDX time index (counter) in output NetCDF file (integer). === c FILEID NetCDF output file ID (integer). === c === c Calls: NCVPT (NetCDF library) === c EXITUS, LINTRP === c === c======================================================================= c c----------------------------------------------------------------------- c Define global data. c----------------------------------------------------------------------- c #include #include #include #include #include #include #include #include #include #include #include c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c logical levless,tpoint,vpoint,wtpoint,wvpoint integer dindx,fileid,fldid,i,jrow,k,klev,m,n,l,tindx,vindx integer count(5),start(5) FLOAT * scale,val,zlev FLOAT * f(m,n),fk(km),r(imt),zk(km) c c======================================================================= c Begin Executable code. c======================================================================= c c Determine the grid point type from field identification. c levless=.false. tpoint=.false. vpoint=.false. wtpoint=.false. wvpoint=.false. do 10 l=1,nt #if defined oias & defined fcsterr if((fldid.eq.trcsid(l)).or.(fldid.eq.tferid(l))) tpoint=.true. # else if(fldid.eq.trcsid(l)) tpoint=.true. #endif 10 continue if((fldid.eq.pbarid).or.(fldid.eq.qbarid).or. * (fldid.eq.vbarid).or. #if defined oias & defined fcsterr * (fldid.eq.pferid).or. #endif #ifdef ext_tide * (fldid.eq.stidid).or. #endif * (fldid.eq.mldid)) levless=.true. if((fldid.eq.buoyid).or.(fldid.eq.nh4pid).or. * (fldid.eq.no3pid).or.(fldid.eq.bgrdid).or. * (fldid.eq.exptid).or.(fldid.eq.zgrpid).or. * (fldid.eq.zgrbid).or.(fldid.eq.zgroid).or. #if defined oias & defined fcsterr * (fldid.eq.pferid).or. #endif * (fldid.eq.bgrnid)) tpoint=.true. if((fldid.eq.vtotid).or.(fldid.eq.vgeoid).or. * (fldid.eq.vcliid).or.(fldid.eq.ketotid).or. #if defined oias & defined fcsterr * (fldid.eq.vferid).or. #endif #ifdef ext_tide * (fldid.eq.vtidid).or.(fldid.eq.stidid).or. #endif * (fldid.eq.ketrmid).or.(fldid.eq.mldid)) vpoint=.true. if((fldid.eq.wvstid).or.(fldid.eq.wvztid).or. * (fldid.eq.fpflid)) wtpoint=.true. if((fldid.eq.wvsvid).or.(fldid.eq.wvzvid)) wvpoint=.true. c c----------------------------------------------------------------------- c Write out field into netCDF file. Interpolate, scale back salinity, c and scale integrated geostrophic shear velocities when appropriate. c----------------------------------------------------------------------- c c Determine dimensionality rank for 3D vectors, 3D scalars, and c 2D scalars. c if ((vindx.gt.0).and.(.not.levless)) then dindx=1 elseif ((vindx.gt.0).or.(.not.levless)) then dindx=2 else dindx=3 endif c c Set netCDF indices. c if (vindx.gt.0) then start(dindx)=vindx count(dindx)=1 endif start(3)=1 count(3)=m start(4)=jrow count(4)=1 start(5)=tindx count(5)=1 c c Write out two-dimensional fields: transport streamfuntion, rate of c change of vorticity, and mixed-layer depth. c if (levless) then call ncvpt(fileid,fldid,start(dindx),count(dindx),f,rcode) if (rcode.ne.0) then write(stdout,900) fldid call exitus('WRTCDF') endif c c Select field at the requested levels or depths. c else do 50 l=1,nlev start(2)=l count(2)=1 klev=lev(l) c c Interpolate to specified pressure (flat) levels. The interpolation c is activated when the level is greater than the number of vertical c levels. Then, LEV(L) is taken as depth in meters. c if(klev.gt.km) then zlev=FLoaT(klev)*m2cm do 30 i=1,m do 20 k=1,n if(fldid.eq.trcsid(2)) then fk(k)=f(i,k)+smean elseif((fldid.eq.vgeoid).and.(vindx.eq.xindx)) then fk(k)=-f(i,k)*p5/(omega*sine(i,jrow)) elseif((fldid.eq.vgeoid).and.(vindx.eq.yindx)) then fk(k)=f(i,k)*p5/(omega*sine(i,jrow)) else fk(k)=f(i,k) endif if(tpoint) then zk(k)=tdepth(i,k,jrs) elseif(vpoint) then zk(k)=vdepth(i,k,jrn) elseif(wtpoint) then zk(k)=tdepth(i,k,jrs)+p5*dzqz(i,k,0) elseif(wvpoint) then zk(k)=vdepth(i,k,jrn)+p5*dzvqz(n,k,0) endif 20 continue val=spval if((zk(1).le.zlev).and.(zlev.le.zk(km))) then call lintrp(n,zk,fk,1,zlev,val) r(i)=val*scale else r(i)=spval endif 30 continue c c Interpolation was not requested. c else do 40 i=1,m if(fldid.eq.trcsid(2)) then r(i)=f(i,klev)*scale+smean elseif((fldid.eq.vgeoid).and.(vindx.eq.xindx)) then r(i)=-f(i,klev)*scale*p5/(omega*sine(i,jrow)) elseif((fldid.eq.vgeoid).and.(vindx.eq.yindx)) then r(i)=f(i,klev)*scale*p5/(omega*sine(i,jrow)) else r(i)=f(i,klev)*scale endif 40 continue endif c c Write out field at the requested levels or depths. c call ncvpt(fileid,fldid,start(dindx),count(dindx),r,rcode) if(rcode.ne.0) then write(stdout,901) fldid,klev call exitus('WRTCDF') endif c 50 continue endif c 900 format(' WRTCDF - error while writing variable with NetCDF ID = ', * i4) 901 format(' WRTCDF - error while writing variable with NetCDF ID = ', * i4,2x,' at output level/depth = ',i6) return end