subroutine cdfout(j) c c======================================================================= c === c This routine writes out, if requested, transport streamfunction, === c barotropic vorticity, total (internal plus external) velocity, === c integrated geostrophic shear components, terrain-following === c vertical velocity, vertical velocity, tracers (temperature, === c salinity, and others), and density anomaly at the Jth slab using === c Network Common Data Form (NetCDF) software. === c === c Calls: NCSNC, NCVPT1 (NetCDF library) === c EXITUS, WRTCDF === c === c======================================================================= c c----------------------------------------------------------------------- c Define global data c----------------------------------------------------------------------- c #include #include #include #include #include #include #include #include #include #include #include #include #include #if defined bioMcGillic | defined bioFasham | defined bioAnder | defined bioDuse # include #endif #include #ifdef ext_tide # include #endif #if defined oias & defined fcsterr # include # include #endif #include c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c integer i,id,j,k,m,madd,tindx FLOAT * r(imt,km),scl,wk(imt,km) save tindx c c----------------------------------------------------------------------- c Begin executable code. c----------------------------------------------------------------------- c c Write out time on first pass. c if(j.eq.2) then toutindx=((itt-1)/ntsout)+1 tindx=toutindx call ncvpt1(ncoutid,toutid,tindx,ttsec-dtts,rcode) if(rcode.ne.0) then write(stdout,900) 'time' call exitus('CDFOUT') endif endif c c Write out transport streamfunction. c if(iout(1).ne.0) then scl=c1 call wrtcdf(j,p(1,j),imt,1,scl,pbarid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,p(1,j-1),imt,1,scl,pbarid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,p(1,j+1),imt,1,scl,pbarid,sindx,tindx,ncoutid) call wrtcdf(j+2,p(1,j+2),imt,1,scl,pbarid,sindx,tindx,ncoutid) endif endif c c Write out total horizontal velocity components. c if(iout(2).ne.0) then scl=c1 #if !defined ext_tide | !defined add_tide call wrtcdf(j,u,imt,km,scl,vtotid,xindx,tindx,ncoutid) call wrtcdf(j,v,imt,km,scl,vtotid,yindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,um,imt,km,scl,vtotid,xindx,tindx,ncoutid) call wrtcdf(j-1,vm,imt,km,scl,vtotid,yindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,up,imt,km,scl,vtotid,xindx,tindx,ncoutid) call wrtcdf(j+1,vp,imt,km,scl,vtotid,yindx,tindx,ncoutid) endif endif #else call addtide (u,v,utide,vtide,fuwtd,fvntd) call wrtcdf(j,fuwtd,imt,km,scl,vtotid,xindx,tindx,ncoutid) call wrtcdf(j,fvntd,imt,km,scl,vtotid,yindx,tindx,ncoutid) if(j.eq.2) then call addtide (um,vm,utidem,vtidem,fuwtd,fvntd) call wrtcdf(j-1,fuwtd,imt,km,scl,vtotid,xindx,tindx,ncoutid) call wrtcdf(j-1,fvntd,imt,km,scl,vtotid,yindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call addtide (up,vp,utidep,vtidep,fuwtd,fvntd) call wrtcdf(j+1,fuwtd,imt,km,scl,vtotid,xindx,tindx,ncoutid) call wrtcdf(j+1,fvntd,imt,km,scl,vtotid,yindx,tindx,ncoutid) endif endif #endif c c Write out internal horizontal velocity components. c if(iout(3).ne.0) then scl=c1 call wrtcdf(j,ucl,imt,km,scl,vcliid,xindx,tindx,ncoutid) call wrtcdf(j,vcl,imt,km,scl,vcliid,yindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,uclm,imt,km,scl,vcliid,xindx,tindx,ncoutid) call wrtcdf(j-1,vclm,imt,km,scl,vcliid,yindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,uclp,imt,km,scl,vcliid,xindx,tindx,ncoutid) call wrtcdf(j+1,vclp,imt,km,scl,vcliid,yindx,tindx,ncoutid) endif endif c c Write out external horizontal velocity components. c if(iout(4).ne.0) then scl=c1 call wrtcdf (j,ubar,imt,1,scl,vbarid,xindx,tindx,ncoutid) call wrtcdf (j,vbar,imt,1,scl,vbarid,yindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf (j-1,ubarm,imt,1,scl,vbarid,xindx,tindx, & ncoutid) call wrtcdf (j-1,vbarm,imt,1,scl,vbarid,yindx,tindx, & ncoutid) elseif(j.eq.jmtm2) then call wrtcdf (j+1,ubarp,imt,1,scl,vbarid,xindx,tindx, & ncoutid) call wrtcdf (j+1,vbarp,imt,1,scl,vbarid,yindx,tindx, & ncoutid) call wrtcdf (j+2,ubarp,imt,1,scl,vbarid,xindx,tindx, & ncoutid) call wrtcdf (j+2,vbarp,imt,1,scl,vbarid,yindx,tindx, & ncoutid) endif endif c c c Write out integrated geotrophic shear components. c if(iout(5).ne.0) then scl=c1 call wrtcdf(j,dpdy,imt,km,scl,vgeoid,xindx,tindx,ncoutid) call wrtcdf(j,dpdx,imt,km,scl,vgeoid,yindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,dpdy,imt,km,scl,vgeoid,xindx,tindx,ncoutid) call wrtcdf(j-1,dpdx,imt,km,scl,vgeoid,yindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,dpdy,imt,km,scl,vgeoid,xindx,tindx,ncoutid) call wrtcdf(j+1,dpdx,imt,km,scl,vgeoid,yindx,tindx,ncoutid) endif endif #ifdef ext_tide c c Write out tidal velocity components. c if(iout(17).ne.0) then scl=c1 call wrtcdf(j,utide,imt,km,scl,vtidid,xindx,tindx,ncoutid) call wrtcdf(j,vtide,imt,km,scl,vtidid,yindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,utidem,imt,km,scl,vtidid,xindx,tindx,ncoutid) call wrtcdf(j-1,vtidem,imt,km,scl,vtidid,yindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,utidep,imt,km,scl,vtidid,xindx,tindx,ncoutid) call wrtcdf(j+1,vtidep,imt,km,scl,vtidid,yindx,tindx,ncoutid) endif endif #endif c c Write terrain-following vertical velocity at velocity points. Do c not write out the first level; recall that vertical velocity is c zero at the surface (rigid lid) and there are KM+1 levels. c if(iout(6).ne.0) then scl=c1 call wrtcdf(j,wu(1,2),imt,km,scl,wvsvid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,wu(1,2),imt,km,scl,wvsvid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,wu(1,2),imt,km,scl,wvsvid,sindx,tindx,ncoutid) endif endif c c Write terrain-following vertical velocity at tracer points. Do c not write out the first level; recall that vertical velocity is c zero at the surface (rigid lid) and there are KM+1 levels. c if(iout(7).ne.0) then scl=c1 call wrtcdf(j,w(1,2),imt,km,scl,wvstid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,w(1,2),imt,km,scl,wvstid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,w(1,2),imt,km,scl,wvstid,sindx,tindx,ncoutid) endif endif c c Write vertical velocity at velocity points. Center of u-box. c if(iout(8).ne.0) then id=wvzvid scl=c1 call wrtcdf(j,wvelu,imt,km,scl,id,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,wvelu,imt,km,scl,id,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,wvelu,imt,km,scl,id,sindx,tindx,ncoutid) endif endif c c Write vertical velocity at tracer points. Center of t-box. c if(iout(9).ne.0) then id=wvztid scl=c1 call wrtcdf(j,wvelt,imt,km,scl,id,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,wvelt,imt,km,scl,id,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,wvelt,imt,km,scl,id,sindx,tindx,ncoutid) endif endif c c Write out time rate of change of barotropic vorticity. c if(iout(11).ne.0) then id=qbarid scl=c1 call wrtcdf(j,ztdb(1,j),imt,1,scl,id,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,ztdb(1,j-1),imt,1,scl,id,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,ztdb(1,j+1),imt,1,scl,id,sindx,tindx,ncoutid) call wrtcdf(j+2,ztdb(1,j+2),imt,1,scl,id,sindx,tindx,ncoutid) endif endif c c Write out temperature and salinity c do 10 m=1,2 madd=11 id=trcsid(m) scl=c1 if(iout(m+madd).ne.0) then call wrtcdf(j,t(1,1,m),imt,km,scl,id,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,tm(1,1,m),imt,km,scl,id,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,tp(1,1,m),imt,km,scl,id,sindx,tindx,ncoutid) call wrtcdf(j+2,tp(1,1,m),imt,km,scl,id,sindx,tindx,ncoutid) endif endif 10 continue c c Write out density anomaly. c if(iout(14).eq.1) then if(j.eq.2) call state(tm(1,1,1),tm(1,1,2),tdepth(1,1,jrs),wk) #ifndef leqstate do 20 k=1,km do 20 i=1,imt # ifdef rmdenbar if(j.eq.2) then wk(i,k)=wk(i,k)*rho0 elseif(j.eq.jmtm2) then wk(i,k)=(rhon(i,k)+rhobar(i,j+1,k))*rho0 endif r(i,k)=(rhos(i,k)+rhobar(i,j,k))*rho0 # else if(j.eq.2) then wk(i,k)=wk(i,k)*rho0 elseif(j.eq.jmtm2) then wk(i,k)=rhon(i,k)*rho0 endif r(i,k)=rhos(i,k)*rho0 # endif 20 continue #else do 20 k=1,km do 20 i=1,imt # ifdef rmdenbar if(j.eq.2) then wk(i,k)=(wk(i,k)*rbar+rbar)-c1000 elseif(j.eq.jmtm2) then wk(i,k)=((rhon(i,k)+rhobar(i,j+1,k))*rbar+rbar)-c1000 endif r(i,k)=((rhos(i,k)+rhobar(i,j,k))*rbar+rbar)-c1000 # else if(j.eq.2) then wk(i,k)=(wk(i,k)*rbar+rbar)-c1000 elseif(j.eq.jmtm2) then wk(i,k)=(rhon(i,k)*rbar+rbar)-c1000 endif r(i,k)=(rhos(i,k)*rbar+rbar)-c1000 # endif 20 continue #endif scl=c1 call wrtcdf(j,r,imt,km,scl,denaid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,wk,imt,km,scl,denaid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,wk,imt,km,scl,denaid,sindx,tindx,ncoutid) call wrtcdf(j+2,wk,imt,km,scl,denaid,sindx,tindx,ncoutid) endif endif c c Write out mixed-layer depth. c if((iout(16).ne.0).and.(mldopt.gt.0)) then scl=-cm2m call wrtcdf(j,mldu,imt,km,scl,mldid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,mldum,imt,km,scl,mldid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,mldu,imt,km,scl,mldid,sindx,tindx,ncoutid) endif endif #ifdef ext_tide c c Write out tidal surface elevation. c if(iout(18).ne.0) then scl=cm2m call wrtcdf(j,srftd(1,j),imt,km,scl,stidid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1, * srftd(1,j),imt,km,scl,stidid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1, * srftd(1,j+1),imt,km,scl,stidid,sindx,tindx,ncoutid) endif endif # ifdef tide_zero c c Write out residual tidal stress tensor components. c if(iout(19).ne.0) then scl=c1 call wrtcdf(j,tuux,imt,km,scl,ttidid,xindx,tindx,ncoutid) call wrtcdf(j,tvuy,imt,km,scl,ttidid,yindx,tindx,ncoutid) call wrtcdf(j,tuvx,imt,km,scl,ttidid,xindx+2,tindx,ncoutid) call wrtcdf(j,tvvy,imt,km,scl,ttidid,yindx+2,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,tuux,imt,km,scl,ttidid,xindx,tindx,ncoutid) call wrtcdf(j-1,tvuy,imt,km,scl,ttidid,yindx,tindx,ncoutid) call wrtcdf(j-1,tuvx,imt,km,scl,ttidid,xindx+2,tindx,ncoutid) call wrtcdf(j-1,tvvy,imt,km,scl,ttidid,yindx+2,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,tuux,imt,km,scl,ttidid,xindx,tindx,ncoutid) call wrtcdf(j+1,tvuy,imt,km,scl,ttidid,yindx,tindx,ncoutid) call wrtcdf(j+1,tuvx,imt,km,scl,ttidid,xindx+2,tindx,ncoutid) call wrtcdf(j+1,tvvy,imt,km,scl,ttidid,yindx+2,tindx,ncoutid) endif endif # endif #endif #if defined bioMcGillic | defined bioFasham | defined bioAnder | defined bioDuse c c Write out biological tracers. c do 30 m=3,nt madd=-2 id=trcsid(m) scl=c1 if(ibiout(m+madd).ne.0) then call wrtcdf(j,t(1,1,m),imt,km,scl,id,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,tm(1,1,m),imt,km,scl,id,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,tp(1,1,m),imt,km,scl,id,sindx,tindx,ncoutid) call wrtcdf(j+2,tp(1,1,m),imt,km,scl,id,sindx,tindx,ncoutid) endif endif 30 continue c c Write out NH4 production rate. c if(ibiout(nt-2+1).ne.0) then scl=day2sec call wrtcdf(j,nh4pr,imt,km,scl,nh4pid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,nh4pr,imt,km,scl,nh4pid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,nh4pr,imt,km,scl,nh4pid,sindx,tindx,ncoutid) call wrtcdf(j+2,nh4pr,imt,km,scl,nh4pid,sindx,tindx,ncoutid) endif endif c c Write out NO3 production rate. c if(ibiout(nt-2+2).ne.0) then scl=day2sec call wrtcdf(j,no3pr,imt,km,scl,no3pid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,no3pr,imt,km,scl,no3pid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,no3pr,imt,km,scl,no3pid,sindx,tindx,ncoutid) call wrtcdf(j+2,no3pr,imt,km,scl,no3pid,sindx,tindx,ncoutid) endif endif c c Write out zooplankton grazing rate of phytoplankton. c if(ibiout(nt-2+3).ne.0) then scl=day2sec call wrtcdf(j,zgrphy,imt,km,scl,zgrpid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,zgrphy,imt,km,scl,zgrpid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,zgrphy,imt,km,scl,zgrpid,sindx,tindx,ncoutid) call wrtcdf(j+2,zgrphy,imt,km,scl,zgrpid,sindx,tindx,ncoutid) endif endif #endif #ifdef bioMcGillic c c Write out export rate. c if(ibiout(nt-2+4).ne.0) then scl=day2sec call wrtcdf(j,export,imt,km,scl,exptid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,export,imt,km,scl,exptid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,export,imt,km,scl,exptid,sindx,tindx,ncoutid) call wrtcdf(j+2,export,imt,km,scl,exptid,sindx,tindx,ncoutid) endif endif #endif #ifdef bioFasham c c Write out zooplankton grazing rate of bacteria. c if(ibiout(nt-2+4).ne.0) then scl=day2sec call wrtcdf(j,zgrbac,imt,km,scl,zgrbid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,zgrbac,imt,km,scl,zgrbid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,zgrbac,imt,km,scl,zgrbid,sindx,tindx,ncoutid) call wrtcdf(j+2,zgrbac,imt,km,scl,zgrbid,sindx,tindx,ncoutid) endif endif c c Write out zooplankton grazing rate of PON. c if(ibiout(nt-2+5).ne.0) then scl=day2sec call wrtcdf(j,zgrpon,imt,km,scl,zgroid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,zgrpon,imt,km,scl,zgroid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,zgrpon,imt,km,scl,zgroid,sindx,tindx,ncoutid) call wrtcdf(j+2,zgrpon,imt,km,scl,zgroid,sindx,tindx,ncoutid) endif endif c c Write out bacteria uptake rate of NH4. c if(ibiout(nt-2+6).ne.0) then scl=day2sec call wrtcdf(j,bgrnh4,imt,km,scl,bgrnid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,bgrnh4,imt,km,scl,bgrnid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,bgrnh4,imt,km,scl,bgrnid,sindx,tindx,ncoutid) call wrtcdf(j+2,bgrnh4,imt,km,scl,bgrnid,sindx,tindx,ncoutid) endif endif c c Write out bacteria uptake rate of DON. c if(ibiout(nt-2+7).ne.0) then scl=day2sec call wrtcdf(j,bgrdon,imt,km,scl,bgrdid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,bgrdon,imt,km,scl,bgrdid,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,bgrdon,imt,km,scl,bgrdid,sindx,tindx,ncoutid) call wrtcdf(j+2,bgrdon,imt,km,scl,bgrdid,sindx,tindx,ncoutid) endif endif c c Write out fast sinking particle export flux. Note that this is only c the flux due to the ZMORTEX*ZMORTR*ZOO term, and does not include c the PON sinking flux. It is defined on the W-Tracer grid. c if(ibiout(nt-2+8).ne.0) then id=fpflid scl=day2sec*c10 call wrtcdf(j,fpflux(1,2),imt,km,scl,id,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,fpflux(1,2),imt,km,scl,id,sindx,tindx,ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,fpflux(1,2),imt,km,scl,id,sindx,tindx,ncoutid) call wrtcdf(j+2,fpflux(1,2),imt,km,scl,id,sindx,tindx,ncoutid) endif endif #endif #if defined oias & defined fcsterr c c Write forecast errors. c if ((iout(21).ne.0).and.(iobserr.ne.0)) then c c Internal mode velocity forecast errors. c scl=c1 call wrtcdf(j,ufcterr(1,1,j),imt,km,scl,vferid,xindx,tindx, & ncoutid) call wrtcdf(j,vfcterr(1,1,j),imt,km,scl,vferid,yindx,tindx, & ncoutid) if(j.eq.2) then call wrtcdf(j-1,ufcterr(1,1,1),imt,km,scl,vferid,xindx,tindx, & ncoutid) call wrtcdf(j-1,vfcterr(1,1,1),imt,km,scl,vferid,yindx,tindx, & ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,ufcterr(1,1,j+1),imt,km,scl,vferid,xindx,tindx & ,ncoutid) call wrtcdf(j+1,vfcterr(1,1,j+1),imt,km,scl,vferid,yindx,tindx & ,ncoutid) endif c c Tracer forecast errors. c scl=c1 do 40 m=1,nt id=tferid(m) call wrtcdf(j,tfcterr(1,1,m,j),imt,km,scl,id,sindx,tindx, & ncoutid) if(j.eq.2) then call wrtcdf(j-1,tfcterr(1,1,m,1),imt,km,scl,id,sindx,tindx, & ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,tfcterr(1,1,m,j+1),imt,km,scl,id,sindx,tindx & ,ncoutid) call wrtcdf(j+2,tfcterr(1,1,m,j+2),imt,km,scl,id,sindx,tindx & ,ncoutid) endif 40 continue c c Transport streamfunction forecast errors. c scl=c1 call wrtcdf(j,pfcterr(1,j),imt,1,scl,pferid,sindx,tindx,ncoutid) if(j.eq.2) then call wrtcdf(j-1,pfcterr(1,1),imt,1,scl,pferid,sindx,tindx, & ncoutid) elseif(j.eq.jmtm2) then call wrtcdf(j+1,pfcterr(1,j+1),imt,1,scl,pferid,sindx,tindx, & ncoutid) call wrtcdf(j+2,pfcterr(1,j+2),imt,1,scl,pferid,sindx,tindx, & ncoutid) endif endif #endif c c Synchronize output NetCDF file to disk to allow other processes to c access data immediately after it is written. c if(j.eq.jmtm2) then call ncsnc(ncoutid,rcode) if(rcode.ne.0) then write(stdout,901) call exitus('CDFOUT') endif endif c 900 format(/,' CDFOUT - error while writing variable: ',a) 901 format(/,' CDFOUT - unable to synchronize output NetCDF to disk.') return end