c subroutine mksut(fields,path,it) c c Make netcdf file from current history: c (file made will be path) c include 'mkncdf.h' include '/usr/local/include/netcdf.inc' pointer(pglbui,glbui(1)), (pglbvi,glbvi(1)),(pglbwi,glbwi(1)) common/drifts/ pglbui,pglbvi,pglbwi integer iret dimension fields(imx,kmx,jmx,nflds) dimension iddims(3),idvars(nftot),istart3(3),idim3(3),hpcpby(3), + f107(2) data istart3/1,1,1/ character*(*) path c c netCDF id integer cdfid c c variable shapes integer latdims(1), londims(1), izpdims(1) c write(6,"(' ')") c c enter define mode cdfid = nccre (path, NCCLOB, iret) c c define dimensions (returns dimension id's): latdim = ncddef(cdfid, "lat", jmx, iret) londim = ncddef(cdfid, "lon", imx, iret) izpdim = ncddef(cdfid, "izp", kmx, iret) c c define dimension variables c (5th arg is list of dimension id's from ncddef): c c latitudes: latdims(1) = latdim latid = ncvdef (cdfid, "lat", NCFLOAT, 1, latdims, iret) c c longitudes: londims(1) = londim lonid = ncvdef (cdfid, "lon", NCFLOAT, 1, londims, iret) c c pressures: izpdims(1) = izpdim izpid = ncvdef (cdfid, "zp", NCFLOAT, 1, izpdims, iret) c c Define field variables (includes field name): c iddims(1) = londim iddims(2) = izpdim iddims(3) = latdim do 100 ip=1,nftot if (ifields(ip).le.0) goto 100 idvars(ip) = ncvdef(cdfid,flab(ip),NCFLOAT,3,iddims,ier) if (ier.ne.0) then write(6,"('mkcdf error from ncvdef: ier=',i4,' ip=',i4)") + ier,ip stop 'ncvdef' endif 100 continue c c Assign global attributes for file: c write(6,"(' ')") write(6,"('Writing netcdf file ',a)") path c c History volume name: write(6,"(' history volume=',a)") histvol(ivol) call ncaptc(cdfid,NCGLOBAL,'histvol',NCCHAR,24,histvol(ivol),ier) if (ier.ne.0) then write(6,"('mkcdf error ',i3,' from ncaptc (global attribute', + ' history volume')") ier stop 'ncpatc' endif c c Model day, hour, minute: write(6,"(' md:mh:mm=',i3,':',i2,':',i2)") + (mtimes(i,it),i=1,3) call ncapt(cdfid,NCGLOBAL,'md:mh:mm',NCSHORT,3,mtimes(1,it),ier) if (ier.ne.0) then write(6,"('mkcdf error ',i3,' from ncaptc (global attribute', + ' md:mh:mm')") ier stop 'ncpatc' endif c c Year-day: iyd = (date(1)-1900)*1000+date(2) write(6,"(' iyd=',i5)") iyd call ncapt(cdfid,NCGLOBAL,'yyddd',NCLONG,1,iyd,ier) if (ier.ne.0) then write(6,"('mkcdf error ',i3,' from ncaptc (global attribute', + ' yyddd')") ier stop 'ncpatc' endif c c Hp,cp,by: hpcpby(1) = hp hpcpby(2) = cp hpcpby(3) = byimf write(6,"(' hp,cp,by=',3f10.2)") hpcpby call ncapt(cdfid,NCGLOBAL,'hp,cp,by',NCFLOAT,3,hpcpby,ier) if (ier.ne.0) then write(6,"('mkcdf error ',i3,' from ncaptc (global attribute', + ' hp,cp,by')") ier stop 'ncpatc' endif c c F10.7: write(6,"(' f107d=',f10.2,' f107a=',f10.2)") f107d,f107a f107(1) = f107d f107(2) = f107a call ncapt(cdfid,NCGLOBAL,'f107d,f107a',NCFLOAT,2,f107,ier) if (ier.ne.0) then write(6,"('mkcdf error ',i3,' from ncaptc (global attribute', + ' f107d,f107a')") ier stop 'ncpatc' endif c c Density conversion flag: write(6,"(' iden=',i2)") iden call ncapt(cdfid,NCGLOBAL,'iden',NCSHORT,1,iden,ier) if (ier.ne.0) then write(6,"('mkcdf error ',i3,' from ncaptc (global attribute', + ' iden')") ier stop 'ncpatc' endif c c Ion drift flag: write(6,"(' ionvel=',i2)") ionvel call ncapt(cdfid,NCGLOBAL,'ionvel',NCSHORT,1,ionvel,ier) if (ier.ne.0) then write(6,"('mkcdf error ',i3,' from ncaptc (global attribute', + ' ionvel')") ier stop 'ncpatc' endif c c isdyn: iisdyn = 0 if (isdyn) iisdyn = 1 call ncapt(cdfid,NCGLOBAL,'isdyn',NCSHORT,1,iisdyn,ier) if (ier.ne.0) then write(6,"('mkcdf error ',i3,' from ncaptc (global attribute', + ' isdyn')") ier stop 'ncpatc' endif c c Assign attributes to variables: do 110 ip=1,nftot if (ifields(ip).le.0) goto 110 lenlab = lenstr(flab(ip)) call ncaptc(cdfid,idvars(ip),"long_name",NCCHAR,lenlab, + flab(ip)(1:lenlab),ier) if (ier.ne.0) then write(6,"('mkcdf error from ncaptc for long_name: ier=',i4, + ' ip=',i4)") ier,ip stop 'ncaptc' endif call ncapt(cdfid,idvars(ip),"log10",NCSHORT,1,logint(ip),ier) if (ier.ne.0) then write(6,"('mkcdf error from ncaptc for logint: ier=',i4, + ' ip=',i4)") ier,ip stop 'ncaptc' endif 110 continue c c Leave define mode: call ncendf (cdfid, iret) c c Give values to variables: c idim3(1) = imx idim3(2) = kmx idim3(3) = jmx c c Dimension variables: call ncvpt(cdfid,lonid,1,imx,gcmlon,ier) call ncvpt(cdfid,latid,1,jmx,gcmlat,ier) call ncvpt(cdfid,izpid,1,kmx,gcmzp,ier) if (ier.ne.0) then write(6,"('mkcdf error ',i3,' from ncvpt (values to dimension', + ' variables')") ier stop 'ncvpt' endif c c Field variables: nf = 0 do ip=1,nftot if (ifields(ip).gt.0) nf = nf+1 enddo write(6,"(' number of fields = ',i2)") nf do 120 ip=1,nftot if (ifields(ip).le.0) goto 120 if (ip.le.nfhist) then call ncvpt(cdfid,idvars(ip),istart3,idim3, + fields(1,1,1,ifget(ip)),ier) call fminmax(fields(1,1,1,ifget(ip)),imx*kmx*jmx,fmin,fmax, + 1.e-20,spval) else if (ip.eq.ixui) then call ncvpt(cdfid,idvars(ip),istart3,idim3,glbui,ier) call fminmax(glbui,imx*kmx*jmx,fmin,fmax,1.e-20,spval) endif if (ip.eq.ixvi) then call ncvpt(cdfid,idvars(ip),istart3,idim3,glbvi,ier) call fminmax(glbvi,imx*kmx*jmx,fmin,fmax,1.e-20,spval) endif if (ip.eq.ixwi) then call ncvpt(cdfid,idvars(ip),istart3,idim3,glbwi,ier) call fminmax(glbwi,imx*kmx*jmx,fmin,fmax,1.e-20,spval) endif endif if (ier.ne.0) then write(6,"('mkcdf error from ncvpt: ier=',i4,' ip=',i4)") + ier,ip stop 'ncvpt' endif write(6,"(' Field ',a,' (min, max =',e12.4,', ', + e12.4,')')") flab(ip),fmin,fmax 120 continue write(6,"(' ')") c c Close netcdf: call ncclos (cdfid,ier) return end