*=*=*=*= mkstat.html =*=*=*=*
PROGRAM mkstat c c modif 03/1997: stockage des stats dans cumul.dat et cumul.hdr c ecriture dans stats.dat et stats.ctl c au lieu d'une sauvegarde dans stats.bak c c This program rewrites a stats.dat file from sums and sums of squares c to means and standard deviations and also writes a grads style .ctl c file so that the data can be viewed easily. The data file is c overwritten in place. Those of a nervous disposition can set c lcopy=.true. to get a backup copy of the stats data before anything c else is done. c SRL 21 May 1996 c implicit none integer npgmax ! maximum number of grid points per level parameter (npgmax = 7010) integer nlmax ! maximum number of levels parameter (nlmax = 50) integer nsmax ! maximum number of time levels parameter (nsmax = 24) c._. real*8 rntape real*4 rntape integer kstart, ktotal, itspd, kphysic, refday integer cols, rows, npgrid, nl integer istats, istime, n2dvar, n3dvar, nltime integer nstore(nsmax) real*4 field(npgmax), field2(npgmax) real*4 sigma(nlmax), ftemp, rn integer i, j, k, l, n integer nls, irec integer dstart, dend, hstart, hint real*4 xstart, xint, ystart, yint integer isurf integer uin integer uout C c logical lcopy /.false./ logical lcopy data isurf,uin,uout/0,10,11/ data lcopy/.true./ CHARACTER*80 suff INTEGER lnblnk EXTERNAL lnblnk print*,'fichiers entree de type: cumula3m5.dat et cumula3m5.hdr' print*,'fichiers sortie de type: statsa3m5.dat et statsa3m5.ctl' print*,'entrer l\'anneeetlemoissouslaformea3m5' read(*,'(a)') suff C c Read header file open(uin, file='cumul'//suff(1:lnblnk(suff))//'.hdr', . form='unformatted', status='old') read(uin) rntape, kstart, ktotal, itspd, kphysic, refday read(uin) cols, rows, npgrid, nl if (nl.gt.nlmax) then print *, 'mkstat: nlmax is too small for this data set' print *, ' recompile with nlmax >= ',nl stop endif read(uin) (sigma(k), k=1,nl) read(uin) istats, istime, n2dvar, n3dvar, nltime if (istime.gt.nsmax) then print *, 'mkstat: nsmax is too small for this data set' print *, ' recompile with nsmax >= ',istime stop endif read(uin) (nstore(k), k=1,istime) close(uin) if (npgrid.gt.npgmax) then print *, 'mkstat: npgmax is too small for this data set' print *, ' recompile with npgmax >= ',npgrid stop endif c Copy data file if required open(uin, file='cumul'//suff(1:lnblnk(suff))//'.dat', . form='unformatted', status='old', : access='direct', recl=4*npgrid) if (lcopy) then open(uout, file='stats'//suff(1:lnblnk(suff))//'.dat', . form='unformatted', status='new', : access='direct', recl=4*npgrid) nls = istime*nltime do l = 1, nls read(uin, rec=l) (field(k), k=1,npgrid) write(uout, rec=l) (field(k), k=1,npgrid) enddo close(uout) close(uin) endif open(uin, file='stats'//suff(1:lnblnk(suff))//'.dat', . form='unformatted', status='old', : access='direct', recl=4*npgrid) c c Re-write stats.dat to contain the mean and standard deviation irec = 1 do i = 1, istime rn = 1.0/float(nstore(i)) do j = 1, n2dvar read(uin, rec=irec) (field(k), k=1,npgrid) do n = 1, npgrid field(n) = rn*field(n) enddo write(uin, rec=irec) (field(k), k=1,npgrid) irec = irec + 1 read(uin, rec=irec) (field2(k), k=1,npgrid) do n = 1, npgrid ftemp = rn*field2(n) - field(n)**2 field2(n) = sqrt(max(0.0,ftemp)) enddo write(uin, rec=irec) (field2(k), k=1,npgrid) irec = irec + 1 enddo do j = 1, n3dvar do l = 1, nl read(uin, rec=irec) (field(k), k=1,npgrid) do n = 1, npgrid field(n) = rn*field(n) enddo write(uin, rec=irec) (field(k), k=1,npgrid) read(uin, rec=irec+nl) (field2(k), k=1,npgrid) do n = 1, npgrid ftemp = rn*field2(n) - field(n)**2 field2(n) = sqrt(max(0.0,ftemp)) enddo write(uin, rec=irec+nl) (field2(k), k=1,npgrid) irec = irec + 1 enddo irec = irec + nl enddo enddo close(uin) c c Write a grads header file dstart = kstart/itspd + refday dend = (ktotal - istats*kphysic)/itspd + refday hstart = 0 hint = (24*istats*kphysic)/itspd xstart = -180.0 xint = 360.0/float(cols) ystart = -90.0 + 90.0/float(rows) yint = 180.0/float(rows) open(uout, file='stats'//suff(1:lnblnk(suff))//'.ctl', . status='new') write(uout,'(a)') '*' write(uout,'(a)') '* Grads header file written by mkstat' write(uout,'(a)') '* Seasonal means and standard deviations' write(uout,'(a)') '*' write(uout,'(a,a,a)') 'dset stats',suff(1:lnblnk(suff)),'.dat' write(uout,'(a,f8.3,a,i5,a,i5)') : 'title Run ',rntape,', day ',dstart,' to ',dend write(uout,'(a)') 'undef -9.99E33' write(uout,'(a)') 'options yrev' write(uout,'(a,i5,a,f9.4,f9.4)') : 'xdef ',cols,' linear ',xstart,xint write(uout,'(a,i5,a,f9.4,f9.4)') : 'ydef ',rows,' linear ',ystart,yint write(uout,'(a,i5,a)') 'zdef ',nl,' levels' write(uout,'(5f10.7)') (sigma(k), k=1,nl) write(uout,'(a,i5,a,i10,a,i2,a)') : 'tdef ',istime,' linear ',hstart,'z1jan0001 ',hint,'hr' write(uout,'(a,i10)')'vars ',2*(n2dvar+n3dvar) c co2ice 2d co2 ice cover c emis 2d surface emissivity c tsurf 2d surface temperature c ps 2d surface pressure c t 3d temperature c u 3d zonal wind c v 3d meridional wind c rho 3d density c q2 3d b/layer eddy kinetic energy write(uout,'(a,i4,a)') : 'co2ice ',isurf,' 99 mean CO2 ice cover (kg/m2)' write(uout,'(a,i4,a)') : 'sdco2ice ',isurf,' 99 stdv CO2 ice cover (kg/m2)' write(uout,'(a,i4,a)') : 'emis ',isurf,' 99 mean emissivity' write(uout,'(a,i4,a)') : 'sdemis ',isurf,' 99 stdv emissivity' write(uout,'(a,i4,a)') : 'tsurf ',isurf,' 99 mean surface temperature (K)' write(uout,'(a,i4,a)') : 'sdtsurf ',isurf,' 99 stdv surface temperature (K)' write(uout,'(a,i4,a)') : 'ps ',isurf,' 99 mean surface pressure (Pa)' write(uout,'(a,i4,a)') : 'sdps ',isurf,' 99 stdv surface pressure (Pa)' write(uout,'(a,i4,a)') : 't ', nl,' 99 mean temperature (K)' write(uout,'(a,i4,a)') : 'sdt ', nl,' 99 stdv temperature (K)' write(uout,'(a,i4,a)') : 'u ', nl,' 99 mean zonal velocity (m/s)' write(uout,'(a,i4,a)') : 'sdu ', nl,' 99 stdv zonal velocity (m/s)' write(uout,'(a,i4,a)') : 'v ', nl,' 99 mean meridional velocity (m/s)' write(uout,'(a,i4,a)') : 'sdv ', nl,' 99 stdv meridional velocity (m/s)' write(uout,'(a,i4,a)') : 'rho ', nl,' 99 mean density (kg/m3)' write(uout,'(a,i4,a)') : 'sdrho ', nl,' 99 stdv density (kg/m3)' write(uout,'(a,i4,a)') : 'q2 ', nl,' 99 mean b/layer eddy ke (m2/s2)' write(uout,'(a,i4,a)') : 'sdq2 ', nl,' 99 stdv b/layer eddy ke (m2/s2)' write(uout,'(a)') 'endvars' close(uout) c stop end