subroutine defbias c c======================================================================= c === c This routine creates the PE model output NetCDF file, it defines === c its dimensions, the geometry (coordinates) variables and their === c attributes, and the requested output variables their attributes. === c Depth positions are written in "meters" for post-processing and === c and visualization purposes. === c === c Calls: NCAPT, NCAPTC, NCCRE, NCDDEF, NCENDF, NCPOPT, NCVDEF, === c NCVID, NCVPT, NCVGPC, NCVGP1 (NetCDF library) === c DEFNRG, DEPTHSLAB, EXITUS, LNBLK === c === c WARNING: Character argument to NetCDF routines NCAPT, NCAPTC, === c NCDDEF, NCVDEF, and NCVID is (upper/lower) case === c sensitive. === 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 integer imjmkm parameter (imjmkm=imt*jmt*km) c integer ax3dim,i,ip,j,k,ldate,lenstr,levdim,lmod,lvnum,nskip, * vartyp,vecdim,vg3did,vlatdim,vlondim #if defined shapiro & defined shapmean * ,tg3did,tlatdim,tlondim,trcdim #endif integer count(4),start(4),vgrd3d(4),vfld4d(4) #if defined shapiro & defined shapmean * ,tgrd3d(4),tfld4d(4) #endif integer lnblk FLOAT * wkslb(imt,km),work(imjmkm) character*24 dummy character*33 fmt c c======================================================================= c Begin executable code. c======================================================================= c c Create NetCDF file. c ncpbid=nccre(pbisnam,ncnoclob,rcode) if(rcode.eq.0) then ncpbst = 1 else write(stdout,900) pbisnam call exitus('DEFBIAS') endif c c Define the dimensions of the NetCDF fields. c #if defined shapiro & defined shapmean tlatdim=ncddef(ncpbid,'tlat',jmt,rcode) tlondim=ncddef(ncpbid,'tlon',imt,rcode) #endif vlatdim=ncddef(ncpbid,'vlat',jmt,rcode) vlondim=ncddef(ncpbid,'vlon',imt,rcode) levdim=ncddef(ncpbid,'level',km,rcode) vecdim=ncddef(ncpbid,'vector',2,rcode) #if defined shapiro & defined shapmean trcdim=ncddef(ncpbid,'tracer',nt,rcode) #endif ax3dim=ncddef(ncpbid,'axis3',3,rcode) c c Define dimension vectors for tracer and velocity type variables. c #if defined shapiro & defined shapmean tgrd3d(1)=ax3dim tgrd3d(2)=levdim tgrd3d(3)=tlondim tgrd3d(4)=tlatdim c tfld4d(1)=trcdim tfld4d(2)=levdim tfld4d(3)=tlondim tfld4d(4)=tlatdim c #endif vgrd3d(1)=ax3dim vgrd3d(2)=levdim vgrd3d(3)=vlondim vgrd3d(4)=vlatdim c vfld4d(1)=vecdim vfld4d(2)=levdim vfld4d(3)=vlondim vfld4d(4)=vlatdim c c----------------------------------------------------------------------- c Define type of floating-point variables: single or double precision. c----------------------------------------------------------------------- c #ifdef dblprec vartyp=ncdouble #else vartyp=ncfloat #endif c c----------------------------------------------------------------------- c Define titles and scalar variables and their attributes in the c NetCDF file. c----------------------------------------------------------------------- c c Create history attribute. c call get_date(date_str) ldate=lnblk(date_str,len(date_str)) lmod=lnblk(model,len(model)) lvnum=lnblk(vnum,len(vnum)) if(lenstr.gt.0) then history=model(1:lmod)//', Version '//vnum(1:lvnum)//', ' & //date_str(1:ldate) else history=model(1:lmod)//', Version '//vnum(1:lvnum) endif c c Create code identifier. c lenstr=lnblk(vdate,len(vdate)) nskip=28-(lenstr+lmod+lvnum) write (fmt,960) nskip write (codeid,fmt) model(1:lmod),vnum(1:lvnum),vdate(1:lenstr) c c Put global attributes to NetCDF file. c dummy=model(1:lmod)//' bias fields' lenstr=lnblk(dummy,len(dummy)) call ncaptc(ncpbid,ncglobal,'title',ncchar,lenstr,dummy(1:lenstr) * ,rcode) call ncaptc(ncpbid,ncglobal,'type',ncchar,lmod,model(1:lmod), * rcode) call ncaptc(ncpbid,ncglobal,'version',ncchar,lvnum, * vnum(1:lvnum),rcode) lenstr=lnblk(history,len(history)) call ncaptc(ncpbid,ncglobal,'history',ncchar,lenstr, * history(1:lenstr),rcode) c c----------------------------------------------------------------------- c Define geometry variables and their attributes in the NetCDF file. c----------------------------------------------------------------------- c c Define 3D grid positions at tracer and velocity points. These fields c are used in the post-processing/visualization modules. c vg3did=ncvdef(ncpbid,'vgrid3',vartyp,4,vgrd3d,rcode) call ncaptc(ncpbid,vg3did,'long_name',ncchar,36, * '3D grid positions at velocity points',rcode) call ncaptc(ncpbid,vg3did,'axis',ncchar,35, * '1: longitude, 2: latitude, 3: depth',rcode) call ncaptc(ncpbid,vg3did,'units',ncchar,34, * 'degrees_east, degrees_north, meter',rcode) c #if defined shapiro & defined shapmean tg3did=ncvdef(ncpbid,'tgrid3',vartyp,4,tgrd3d,rcode) call ncaptc(ncpbid,tg3did,'long_name',ncchar,34, * '3D grid positions at tracer points',rcode) call ncaptc(ncpbid,tg3did,'axis',ncchar,35, * '1: longitude, 2: latitude, 3: depth',rcode) call ncaptc(ncpbid,tg3did,'units',ncchar,34, * 'degrees_east, degrees_north, meter',rcode) c #endif c----------------------------------------------------------------------- c Define output variables and their attributes in the NetCDF file. c----------------------------------------------------------------------- c c Define bias in pressure gradient. c varid=ncvdef(ncpbid,'press_bias',vartyp,4,vfld4d,rcode) call ncaptc(ncpbid,varid,'long_name',ncchar,25, * 'bias in pressure gradient',rcode) call ncaptc(ncpbid,varid,'units',ncchar,19, * 'centimeter second-2',rcode) call ncaptc(ncpbid,varid,'vector',ncchar,18, * '1: dp/dx, 2: dp/dy',rcode) call ncaptc(ncpbid,varid,'field',ncchar,21, * 'pressure bias, vector',rcode) call ncaptc(ncpbid,varid,'positions',ncchar,6,'vgrid3', * rcode) call ncapt (ncpbid,varid,'_FillValue',vartyp,1,spval,rcode) call ncapt (ncpbid,varid,'missing_value',vartyp,1,spval,rcode) c #if defined shapiro & defined shapmean c Define tracer means. c varid=ncvdef(ncpbid,'tracer_mean',vartyp,4,tfld4d,rcode) call ncaptc(ncpbid,varid,'long_name',ncchar,17, * 'mean tracer field',rcode) call ncaptc(ncpbid,varid,'units',ncchar,19, * 'Celsius, PSU, other',rcode) call ncaptc(ncpbid,varid,'tracer',ncchar,34, * '1: temperature, 2: salinity, other',rcode) call ncaptc(ncpbid,varid,'field',ncchar,20, * 'mean tracers, vector',rcode) call ncaptc(ncpbid,varid,'positions',ncchar,6,'tgrid3', * rcode) call ncapt (ncpbid,varid,'_FillValue',vartyp,1,spval,rcode) call ncapt (ncpbid,varid,'missing_value',vartyp,1,spval,rcode) c #endif c======================================================================= c Leave definition mode. ============================================= c======================================================================= c call ncendf(ncpbid,rcode) if(rcode.eq.0) then ncpbst = 2 else write(stdout,910) outname call exitus('DEFBIAS') endif c c======================================================================= c Write geometry variables into NetCDF file. c======================================================================= c c----------------------------------------------------------------------- c Write out positions at tracer and velocity points. c----------------------------------------------------------------------- #if defined shapiro & defined shapmean c c Write (x,y) positions for 3D fields at tracer points. c Use a volume data working array to minimize number IO calls. c start(2)=1 count(2)=km start(3)=1 count(3)=imt start(4)=1 count(4)=jmt c ip=0 do 50 j=1,jmt do 50 i=1,imt do 50 k=1,km ip=ip+1 work(ip)=tlon(i,j) 50 continue start(1)=xindx count(1)=1 call ncvpt(ncpbid,tg3did,start,count,work,rcode) if(rcode.ne.0) then write(stdout,930) 'tgrid3 x-axis' call exitus('DEFBIAS') endif c ip=0 do 60 j=1,jmt do 60 i=1,imt do 60 k=1,km ip=ip+1 work(ip)=tlat(i,j) 60 continue start(1)=yindx count(1)=1 call ncvpt(ncpbid,tg3did,start,count,work,rcode) if(rcode.ne.0) then write(stdout,930) 'tgrid3 y-axis' call exitus('DEFBIAS') endif #endif c c Write (x,y) positions for 3D fields at velocity and W-velocity points. c Use a volume data working array to minimize number IO calls. c start(2)=1 count(2)=km start(3)=1 count(3)=imt start(4)=1 count(4)=jmt c ip=0 do 70 j=1,jmt do 70 i=1,imt do 70 k=1,km ip=ip+1 work(ip)=vlon(i,j) 70 continue start(1)=xindx count(1)=1 call ncvpt(ncpbid,vg3did,start,count,work,rcode) if(rcode.ne.0) then write(stdout,930) 'vgrid3 x-axis' call exitus('DEFBIAS') endif c ip=0 do 80 j=1,jmt do 80 i=1,imt do 80 k=1,km ip=ip+1 work(ip)=vlat(i,j) 80 continue start(1)=yindx count(1)=1 call ncvpt(ncpbid,vg3did,start,count,work,rcode) if(rcode.ne.0) then write(stdout,930) 'vgrid3 y-axis' call exitus('DEFBIAS') endif c c----------------------------------------------------------------------- c Write out depths (meters) at the center of the tracer and velocity c boxes into positional arrays. c----------------------------------------------------------------------- c start(1)=zindx count(1)=1 start(2)=1 count(2)=km start(3)=1 count(3)=imt start(4)=1 count(4)=jmt #if defined shapiro & defined shapmean c c Write out (z) positions for 3D fields tracer points. c ip=0 do 100 j=1,jmt call depthslab(j,tgrid,wkslb) do 100 i=1,imt do 100 k=1,km ip=ip+1 work(ip)=-abs(wkslb(i,k))*cm2m 100 continue call ncvpt(ncpbid,tg3did,start,count,work,rcode) if(rcode.ne.0) then write(stdout,930) 'tgrid3 z-axis' call exitus('DEFBIAS') endif #endif c c Write out (z) positions for 3D fields velocity points. c ip=0 do 120 j=1,jmt call depthslab(j,vgrid,wkslb) do 120 i=1,imt do 120 k=1,km ip=ip+1 work(ip)=-abs(wkslb(i,k))*cm2m 120 continue call ncvpt(ncpbid,vg3did,start,count,work,rcode) if(rcode.ne.0) then write(stdout,930) 'vgrid3 z-axis' call exitus('DEFBIAS') endif c 900 format(/' DEFBIAS - unable to create PE output NetCDF file: ',a) 910 format(/' DEFBIAS - unable to define PE output NetCDF file: ',a) 920 format(/' DEFBIAS - undefined variable: ',a,2x, * ' in energy/diagnostics output NetCDF file.') 930 format(/' DEFBIAS - error while writing variable: ',a,2x, * ' into PE output NetCDF file.') 940 format(/' DEFBIAS - error while writing variable: ',a,2x, * ' into energy output NetCDF file.') 950 format(/' DEFBIAS - undefined variable: ',a,2x, * ' in PE output NetCDF file.') 960 format ('(',1h','@(#)',1h',',a,',i2,'x,a,',1h',' updated on ',1h', * ',a)') return end