cdftools-3.0/0000755000175000017500000000000012241227326014324 5ustar amckinstryamckinstrycdftools-3.0/cdfmoyuvwt.f900000644000175000017500000003615512241227304017061 0ustar amckinstryamckinstryPROGRAM cdfmoyuvwt !!====================================================================== !! *** PROGRAM cdfmoyuvwt *** !!===================================================================== !! ** Purpose : Compute mean values of some quantities, required for !! other cdftools ( cdfbci, cdfbti and cdfnrjcomp). !! At U point : ubar, u2bar !! At V point : vbar, v2bar !! At W point : wbar !! AT T point : tbar, t2bar, uvbar, utbar, vtbar, wtbar !! !! ** Method : take care of double precision on product !! !! History : 2.1 : 02/2008 : A. Melet : Original code !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4), PARAMETER :: jp_var = 11 INTEGER(KIND=4) :: ji, jj, jk, jt, jtt INTEGER(KIND=4) :: ntframe INTEGER(KIND=4) :: npiglo, npjglo INTEGER(KIND=4) :: npk, npt, ntags INTEGER(KIND=4) :: iimin, iimax, ijmin, ijmax INTEGER(KIND=4) :: iup=1, idwn=2 INTEGER(KIND=4) :: narg, iargc, ijarg INTEGER(KIND=4) :: ncout INTEGER(KIND=4) :: ierr INTEGER(KIND=4), DIMENSION(jp_var) :: ipk, id_varout ! REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: w2d REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: u2d, v2d, t2d REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtabu, dtabv, dtabu2, dtabv2, dtabuv REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtabw, dtabt, dtabut, dtabvt, dtabt2 REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtabwt REAL(KIND=8) :: dcoef REAL(KIND=8) :: dtotal_time CHARACTER(LEN=256) :: cf_ufil, cf_vfil CHARACTER(LEN=256) :: cf_wfil, cf_tfil CHARACTER(LEN=256) :: cf_out='moyuvwt.nc' CHARACTER(LEN=256) :: cldum CHARACTER(LEN=256) :: config , ctag CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: ctabtag TYPE (variable), DIMENSION(jp_var) :: stypvar ! structure for attibutes LOGICAL :: llnam_nemo = .FALSE. !!---------------------------------------------------------------------- CALL ReadCdfNames() !! narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmoyuv CONFCASE [-zoom imin imax jmin jmax ] ''list of tags'' ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute temporal mean fields for velocity components (u,v,w) and' PRINT *,' temperature (t), as well as second order moments ( u2, v2, t2, uv, ut,' PRINT *,' vt, wt).' PRINT *,' These fields are required in other cdftools which computes either ' PRINT *,' barotropic (cdfbti) or baroclinic (cdfbci) instabilities, and a global' PRINT *,' energy balance (cdfnrjcomp)' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' CONFCASE : the root name for the data files. Grid files are assumed to' PRINT *,' be gridT, gridU, gridV, gridW. ( grid_T, grid_U, grid_V and' PRINT *,' grid_W are also supported.' PRINT *,' List_of_tags : The list of time tags corresponding to the time serie' PRINT *,' whose mean is being computed.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-zoom imin imax jmin jmax ] : limit the mean computation to the ' PRINT *,' specified sub area.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : There are 11 variables produced by this program.' PRINT *,' tbar, t2bar : mean t (Kelvin) and mean t^2 (K^2) [T-point]' PRINT *,' ubar, u2bar : mean u (m/s) and mean u^2 (m2/s2) [U-point]' PRINT *,' vbar, v2bar : mean v (m/s) and mean v^2 (m2/s2) [V-point]' PRINT *,' wbar : mean w (m/s) [W-point]' PRINT *,' uvbar : mean product u . v (m2/s2) [T-point]' PRINT *,' utbar, vtbar, wtbar : mean product [uvw].t (m/s.K) [T-point]' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfbti, cdfbci and cdfnrjcomp' PRINT *,' ' STOP ENDIF iimin=0 ; ijmin=0 iimax=0 ; ijmax=0 ijarg = 1 ; ntags=-1 ALLOCATE (ctabtag ( narg ) ) ! allocate string array for tags ( OK: it is an over-estimate). DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum) ; ijarg = ijarg +1 SELECT CASE (cldum) CASE ( '-zoom' ) CALL getarg(ijarg, cldum) ; ijarg = ijarg +1 ; READ(cldum,*) iimin CALL getarg(ijarg, cldum) ; ijarg = ijarg +1 ; READ(cldum,*) iimax CALL getarg(ijarg, cldum) ; ijarg = ijarg +1 ; READ(cldum,*) ijmin CALL getarg(ijarg, cldum) ; ijarg = ijarg +1 ; READ(cldum,*) ijmax CASE DEFAULT ntags=ntags+1 SELECT CASE ( ntags ) CASE (0) ; config = cldum CASE DEFAULT ctabtag(ntags) = cldum END SELECT END SELECT END DO ! check if all files exists DO jt=1, ntags ctag = ctabtag(jt) ! check U-file WRITE(cf_ufil,'(a,"_",a,"_gridU.nc")') TRIM(config),TRIM(ctag) IF ( chkfile (cf_ufil ) ) THEN WRITE(cf_ufil,'(a,"_",a,"_grid_U.nc")') TRIM(config),TRIM(ctag) IF ( chkfile (cf_ufil ) ) STOP ! missing gridU or grid_U file llnam_nemo=.TRUE. ! assume all files are nemo style ... ENDIF ! check V-file WRITE(cf_vfil,'(a,"_",a,"_gridV.nc")') TRIM(config),TRIM(ctag) IF ( chkfile (cf_vfil ) ) THEN WRITE(cf_vfil,'(a,"_",a,"_grid_V.nc")') TRIM(config),TRIM(ctag) IF ( chkfile (cf_vfil ) ) STOP ! missing gridV or grid_V file ENDIF ! check W-file WRITE(cf_wfil,'(a,"_",a,"_gridW.nc")') TRIM(config),TRIM(ctag) IF ( chkfile (cf_wfil ) ) THEN WRITE(cf_wfil,'(a,"_",a,"_grid_W.nc")') TRIM(config),TRIM(ctag) IF ( chkfile (cf_wfil ) ) STOP ! missing gridW or grid_W file ENDIF ! check T-file WRITE(cf_tfil,'(a,"_",a,"_gridT.nc")') TRIM(config),TRIM(ctag) IF ( chkfile (cf_tfil ) ) THEN WRITE(cf_tfil,'(a,"_",a,"_grid_T.nc")') TRIM(config),TRIM(ctag) IF ( chkfile (cf_tfil ) ) STOP ! missing gridT or grid_T file ENDIF END DO ! assume all input files have same spatial size npiglo = getdim (cf_ufil, cn_x ) npjglo = getdim (cf_ufil, cn_y ) npk = getdim (cf_ufil, cn_z ) ! modify sizes with respect to zoomed area IF (iimin /= 0 ) THEN ; npiglo=iimax -iimin + 1 ; ELSE ; iimin=1 ; iimax=npiglo ; ENDIF IF (ijmin /= 0 ) THEN ; npjglo=ijmax -ijmin + 1 ; ELSE ; ijmin=1 ; ijmax=npjglo ; ENDIF ! define new variables for output ( must update att.txt) stypvar( 1)%cname = 'ubar' stypvar( 1)%clong_name = 'temporal mean of u on U point' stypvar( 1)%cshort_name = 'ubar' stypvar( 1)%cunits = 'm/s' stypvar( 2)%cname = 'vbar' stypvar( 2)%clong_name = 'temporal mean of v on V point' stypvar( 2)%cshort_name = 'vbar' stypvar( 2)%cunits = 'm/s' stypvar( 3)%cname = 'u2bar' stypvar( 3)%clong_name = 'temporal mean of u * u on U point' stypvar( 3)%cshort_name = 'u2bar' stypvar( 3)%cunits = 'm2/s2' stypvar( 4)%cname = 'v2bar' stypvar( 4)%clong_name = 'temporal mean of v * v on V point' stypvar( 4)%cshort_name = 'v2bar' stypvar( 4)%cunits = 'm2/s2' stypvar( 5)%cname = 'uvbar' stypvar( 5)%clong_name = 'temporal mean of u * v on T point' stypvar( 5)%cshort_name = 'uvbar' stypvar( 5)%cunits = 'm2/s2' stypvar( 6)%cname = 'wbar' stypvar( 6)%clong_name = 'temporal mean of w on W point' stypvar( 6)%cshort_name = 'wbar' stypvar( 6)%cunits = 'm/s' stypvar( 7)%cname = 'tbar' stypvar( 7)%clong_name = 'temporal mean of T on T point in K' stypvar( 7)%cshort_name = 'tbar' stypvar( 7)%cunits = 'K' stypvar( 8)%cname = 'utbar' stypvar( 8)%clong_name = 'temporal mean of u * T (in K) on T point' stypvar( 8)%cshort_name = 'utbar' stypvar( 8)%cunits = 'm/s.K' stypvar( 9)%cname = 'vtbar' stypvar( 9)%clong_name = 'temporal mean of v * T (in K) on T point' stypvar( 9)%cshort_name = 'vtbar' stypvar( 9)%cunits = 'm/s.K' stypvar(10)%cname = 't2bar' stypvar(10)%clong_name = 'temporal mean of T * T on T point in K^2' stypvar(10)%cshort_name = 't2bar' stypvar(10)%cunits = 'K2' stypvar(11)%cname = 'wtbar' stypvar(11)%clong_name = 'temporal mean of w * T (in K) on T point' stypvar(11)%cshort_name = 'wtbar' stypvar(11)%cunits = 'm/s.K' stypvar%rmissing_value = 0. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' ipk(:) = npk PRINT *, ' npiglo = ', npiglo PRINT *, ' npjglo = ', npjglo PRINT *, ' npk = ', npk ! create output fileset ncout = create (cf_out, cf_ufil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, jp_var, ipk, id_varout ) ierr = putheadervar(ncout, cf_ufil, npiglo, npjglo, npk ) ! Allocate the memory ALLOCATE ( u2d(npiglo,npjglo), v2d(npiglo,npjglo) ) ALLOCATE ( t2d(npiglo,npjglo), w2d(npiglo,npjglo,2) ) ALLOCATE ( dtabu(npiglo,npjglo), dtabu2(npiglo,npjglo), dtabut(npiglo,npjglo) ) ALLOCATE ( dtabv(npiglo,npjglo), dtabv2(npiglo,npjglo), dtabvt(npiglo,npjglo) ) ALLOCATE ( dtabt(npiglo,npjglo), dtabt2(npiglo,npjglo) ) ALLOCATE ( dtabw(npiglo,npjglo), dtabwt(npiglo,npjglo) ) ALLOCATE ( dtabuv(npiglo,npjglo) ) DO jk=1, npk-1 ! level npk is masked for T U V and is 0 for W ( bottom ) ! PRINT *,' level ',jk dtotal_time = 0.d0 ; ntframe=0 dtabu(:,:) = 0.d0 ; dtabv(:,:) = 0.d0 ; dtabuv(:,:) = 0.d0 dtabu2(:,:) = 0.d0 ; dtabv2(:,:) = 0.d0 ; dtabt(:,:) = 0.d0 dtabw(:,:) = 0.d0 ; dtabut(:,:) = 0.d0 ; dtabvt(:,:) = 0.d0 dtabt2(:,:) = 0.d0 ; dtabwt(:,:) = 0.d0 DO jt= 1, ntags ctag = ctabtag(jt) IF ( llnam_nemo ) THEN WRITE(cf_ufil,'(a,"_",a,"_grid_U.nc")') TRIM(config),TRIM(ctag) WRITE(cf_vfil,'(a,"_",a,"_grid_V.nc")') TRIM(config),TRIM(ctag) WRITE(cf_wfil,'(a,"_",a,"_grid_W.nc")') TRIM(config),TRIM(ctag) WRITE(cf_tfil,'(a,"_",a,"_grid_T.nc")') TRIM(config),TRIM(ctag) ELSE ! drakkar style WRITE(cf_ufil,'(a,"_",a,"_gridU.nc")') TRIM(config),TRIM(ctag) WRITE(cf_vfil,'(a,"_",a,"_gridV.nc")') TRIM(config),TRIM(ctag) WRITE(cf_wfil,'(a,"_",a,"_gridW.nc")') TRIM(config),TRIM(ctag) WRITE(cf_tfil,'(a,"_",a,"_gridT.nc")') TRIM(config),TRIM(ctag) ENDIF IF ( jk == 1 ) THEN npt = getdim(cf_ufil, cn_t) ALLOCATE ( tim(npt) ) tim=getvar1d(cf_ufil, cn_vtimec, npt) dtotal_time = dtotal_time + SUM(DBLE(tim)) DEALLOCATE ( tim ) ENDIF DO jtt = 1, npt ntframe = ntframe+1 u2d(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jtt ) v2d(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jtt ) w2d(:,:,iup) = getvar(cf_wfil, cn_vovecrtz, jk, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jtt ) w2d(:,:,idwn) = getvar(cf_wfil, cn_vovecrtz, jk+1, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jtt ) t2d(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jtt ) WHERE ( t2d /= 0. ) t2d = t2d + 273.15 ! from C to K dtabu(:,:) = dtabu(:,:) + u2d(:,:) dtabu2(:,:) = dtabu2(:,:) + u2d(:,:) * u2d(:,:) * 1.d0 dtabv(:,:) = dtabv(:,:) + v2d(:,:) dtabv2(:,:) = dtabv2(:,:) + v2d(:,:) * v2d(:,:) * 1.d0 dtabw(:,:) = dtabw(:,:) + w2d(:,:,iup) dtabt(:,:) = dtabt(:,:) + t2d(:,:) dtabt2(:,:) = dtabt2(:,:) + t2d(:,:) * t2d(:,:) * 1.d0 DO jj = npjglo, 2 , -1 DO ji = npiglo, 2 , -1 ! put u, v on T point ( note the loops starting from the end for using u2d and v2d as tmp array) u2d(ji,jj) = 0.5 * ( u2d(ji,jj) + u2d(ji-1,jj ) ) v2d(ji,jj) = 0.5 * ( v2d(ji,jj) + v2d(ji, jj-1) ) END DO END DO u2d(1,:) = 0. ; u2d(:,1) = 0. v2d(1,:) = 0. ; v2d(:,1) = 0. w2d(:,:,iup) = 0.5 * ( w2d(:,:,iup) + w2d(:,:,idwn) ) ! W at T point dtabuv(:,:) = dtabuv(:,:) + u2d(:,:) * v2d(:,:) * 1.d0 dtabut(:,:) = dtabut(:,:) + u2d(:,:) * t2d(:,:) * 1.d0 dtabvt(:,:) = dtabvt(:,:) + v2d(:,:) * t2d(:,:) * 1.d0 dtabwt(:,:) = dtabwt(:,:) + w2d(:,:,iup) * t2d(:,:) * 1.d0 END DO ! jtt END DO ! tags dcoef = 1.d0 / ntframe ! save on file ierr = putvar(ncout, id_varout( 1), REAL(dtabu * dcoef), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout( 2), REAL(dtabv * dcoef), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout( 3), REAL(dtabu2* dcoef), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout( 4), REAL(dtabv2* dcoef), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout( 5), REAL(dtabuv* dcoef), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout( 6), REAL(dtabw * dcoef), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout( 7), REAL(dtabt * dcoef), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout( 8), REAL(dtabut* dcoef), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout( 9), REAL(dtabvt* dcoef), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout(10), REAL(dtabt2* dcoef), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout(11), REAL(dtabwt* dcoef), jk, npiglo, npjglo ) END DO ! loop on level ! fill up empty last level dtabu = 0.d0 ! reset this dummy array to 0 for npk output DO jk= 1, jp_var ierr = putvar(ncout, id_varout(jk), REAL(dtabu), npk, npiglo, npjglo ) END DO ierr = putvar1d(ncout, (/REAL(dtotal_time*dcoef)/), 1, 'T') ierr = closeout(ncout) END PROGRAM cdfmoyuvwt cdftools-3.0/cdflinreg.f900000644000175000017500000003205712241227304016604 0ustar amckinstryamckinstryPROGRAM cdflinreg !!====================================================================== !! *** PROGRAM cdflinreg *** !!===================================================================== !! ** Purpose : Compute linear regression coef from a bunch of input !! cdf files given as argument. !! Store the results on a 'similar' cdf file. !! !! ** Method : compute a and b such as yr = a . t + b !! yr is the estimation of the field value, t is the time (in days ). !! a= cov(y,t) / var(t) !! b= moy(y) - a . moy(t) !! R2 pearson value [0,1], giving the quality of the adjustment is also given !! R2= a*a*var(t)/var(y) !! cov(y,t)= moy(y*t) - moy(y)*moy(t) !! var(t) = moy(t*t) - moy(t)*moy(t) !! var(y) = moy(y*y) - moy(y)*moy(y) !! !! History : 2.1 : 01/2008 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!-------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4), PARAMETER :: jptmax=1000 ! maximum number of time frame INTEGER(KIND=4) :: jk, jfil, jvar, jv, jt ! dummy loop index INTEGER(KIND=4) :: ierr, ijvar ! working integer INTEGER(KIND=4) :: narg, iargc ! INTEGER(KIND=4) :: npiglo, npjglo, npk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! Number of variables in a file INTEGER(KIND=4) :: ntframe ! Cumul of time frame INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipki ! arrays of vertical level for each var INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipko ! arrays of vertical level for each var INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! id of output variable REAL(KIND=4) :: zspval = -99999. ! special value/ missing value REAL(KIND=4), DIMENSION(2) :: timean ! trick : timean(1) hold moy(t) (days) ! ! timean(2) hold moy(t2) (days)**2 REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=8) :: dt, dt2 ! variables for cumulated time values REAL(KIND=8) :: dtotal_time ! cumulated time REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dy, dyy, dyt ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dv2d ! Array to read a layer of data REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmean, dmean2, dmean3 ! REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dareg, dbreg, dpear ! slope, origin ordinate, pearson coef CHARACTER(LEN=256) :: cf_in ! file names CHARACTER(LEN=256) :: cf_out='linreg.nc' ! file names CHARACTER(LEN=256) :: cv_dep ! depth variable name CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_namesi ! array of var name CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nameso ! array of var22 name for output TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvari, stypvaro ! data structure LOGICAL :: lcaltmean ! flag for timemean computation !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdflinreg ''list of model files'' ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the linear regression coefficients for a bunch of' PRINT *,' input files. ' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' A list of netcdf model file of same kind' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : for each input variables, there are 3 computed field' PRINT *,' - slope coefficient' PRINT *,' - barycenter ' PRINT *,' - Pearson Coefficient' STOP ENDIF !! Initialisation from 1st file (all file are assume to have the same geometry) CALL getarg (1, cf_in ) IF ( chkfile(cf_in) ) STOP ! missing file npiglo = getdim (cf_in,cn_x ) npjglo = getdim (cf_in,cn_y ) npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk ALLOCATE( dy (npiglo,npjglo), dyt (npiglo,npjglo), dyy (npiglo,npjglo), dv2d(npiglo,npjglo) ) ALLOCATE( dmean(npiglo,npjglo), dmean2(npiglo,npjglo), dmean3(npiglo,npjglo) ) ALLOCATE( dareg(npiglo,npjglo), dbreg (npiglo,npjglo) ,dpear (npiglo,npjglo) ) ALLOCATE( tim (jptmax) ) nvars = getnvar(cf_in) PRINT *,' nvars =', nvars ALLOCATE (cv_namesi(nvars), cv_nameso(3*nvars) ) ALLOCATE (stypvari (nvars), stypvaro (3*nvars) ) ALLOCATE (ipki (nvars), ipko (3*nvars) ) ALLOCATE ( id_varout(3*nvars) ) ! get list of variable names and collect attributes in stypvari (optional) cv_namesi(:) = getvarname(cf_in, nvars, stypvari) DO jvar = 1, nvars ijvar=(jvar -1)*3 +1 ! AREG cv_nameso(ijvar) = TRIM(cv_namesi(jvar))//'_areg' stypvaro(ijvar)%cname = TRIM(stypvari(jvar)%cname)//'_areg' ! name stypvaro(ijvar)%cunits = TRIM(stypvari(jvar)%cunits)//'/year' ! unit stypvaro(ijvar)%rmissing_value = zspval ! missing_value stypvaro(ijvar)%valid_min = -100. ! valid_min = zero stypvaro(ijvar)%valid_max = 100. ! valid_max *valid_max stypvaro(ijvar)%scale_factor = 1. stypvaro(ijvar)%add_offset = 0. stypvaro(ijvar)%savelog10 = 0. stypvaro(ijvar)%clong_name = TRIM(stypvari(jvar)%clong_name)//'_linear_slope' stypvaro(ijvar)%cshort_name = TRIM(stypvari(jvar)%cshort_name)//'_areg' stypvaro(ijvar)%conline_operation = TRIM(stypvari(jvar)%conline_operation) stypvaro(ijvar)%caxis = TRIM(stypvari(jvar)%caxis) ! BREG cv_nameso(ijvar+1) = TRIM(cv_namesi(jvar))//'_breg' stypvaro(ijvar+1)%cname = TRIM(stypvari(jvar)%cname)//'_breg' ! name stypvaro(ijvar+1)%cunits = TRIM(stypvari(jvar)%cunits) ! unit stypvaro(ijvar+1)%rmissing_value = zspval ! missing_value stypvaro(ijvar+1)%valid_min = -100. ! valid_min = zero stypvaro(ijvar+1)%valid_max = 100. ! valid_max *valid_max stypvaro(ijvar+1)%scale_factor = 1. stypvaro(ijvar+1)%add_offset = 0. stypvaro(ijvar+1)%savelog10 = 0. stypvaro(ijvar+1)%clong_name = TRIM(stypvari(jvar)%clong_name)//'_b' stypvaro(ijvar+1)%cshort_name = TRIM(stypvari(jvar)%cshort_name)//'_breg' stypvaro(ijvar+1)%conline_operation = TRIM(stypvari(jvar)%conline_operation) stypvaro(ijvar+1)%caxis = TRIM(stypvari(jvar)%caxis) ! R2 pearson cv_nameso(ijvar+2) = TRIM(cv_namesi(jvar))//'_r2' stypvaro(ijvar+2)%cname = TRIM(stypvari(jvar)%cname)//'_r2' ! name stypvaro(ijvar+2)%cunits = 'no unit' ! unit stypvaro(ijvar+2)%rmissing_value = zspval ! missing_value stypvaro(ijvar+2)%valid_min = 0. ! valid_min = zero stypvaro(ijvar+2)%valid_max = 1. ! valid_max *valid_max stypvaro(ijvar+2)%scale_factor = 1. stypvaro(ijvar+2)%add_offset = 0. stypvaro(ijvar+2)%savelog10 = 0. stypvaro(ijvar+2)%clong_name = TRIM(stypvari(jvar)%clong_name)//'_r2_Pearson' stypvaro(ijvar+2)%cshort_name = TRIM(stypvari(jvar)%cshort_name)//'_r2' stypvaro(ijvar+2)%conline_operation = TRIM(stypvari(jvar)%conline_operation) stypvaro(ijvar+2)%caxis = TRIM(stypvari(jvar)%caxis) END DO ! ipki gives the number of level or 0 if not a T[Z]YX variable ipki(:) = getipk (cf_in, nvars, cdep=cv_dep) DO jvar=1,nvars ipko( (jvar-1)*3 +1 ) = ipki(jvar) ipko( (jvar-1)*3 +2 ) = ipki(jvar) ipko( (jvar-1)*3 +3 ) = ipki(jvar) ENDDO WHERE( ipki == 0 ) cv_namesi = 'none' WHERE( ipko == 0 ) cv_nameso = 'none' stypvari(:)%cname = cv_namesi stypvaro(:)%cname = cv_nameso ! create output fileset cf_out='linreg.nc' ! create output file taking the sizes in cf_in ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep ) ierr = createvar (ncout, stypvaro, 3*nvars, ipko, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk, cdep=cv_dep ) lcaltmean=.TRUE. ; dt=0.d0 ; dt2=0.d0 DO jvar = 1,nvars ijvar=(jvar-1)*3 + 1 IF (cv_namesi(jvar) == cn_vlon2d .OR. & cv_namesi(jvar) == cn_vlat2d ) THEN ! skip these variable ELSE PRINT *,' Working with ', TRIM(cv_namesi(jvar)), ipki(jvar), jvar DO jk = 1, ipki(jvar) dy(:,:) = 0.d0 ; dyt(:,:) = 0.d0 ; dyy(:,:) =0.d0 ; dtotal_time = 0.; ntframe=0 DO jfil = 1, narg CALL getarg (jfil, cf_in) IF ( jvar == 1 ) THEN IF ( chkfile(cf_in) ) STOP ! missing file ENDIF npt = getdim (cf_in,cn_t) ntframe=ntframe+npt IF ( lcaltmean ) THEN ! read time and convert seconds to years tim(ntframe-npt+1:ntframe)=getvar1d(cf_in,cn_vtimec,npt)/86400.d0/365. END IF DO jt=1,npt ! If forcing fields is without depth dimension dv2d(:,:) = getvar(cf_in, cv_namesi(jvar), jk ,npiglo, npjglo, ktime=jt ) dy(:,:) = dy(:,:) + dv2d(:,:) dyy(:,:) = dyy(:,:) + dv2d(:,:)*dv2d(:,:) dyt(:,:) = dyt(:,:) + dv2d(:,:)*tim(ntframe-npt+jt) ENDDO END DO ! finish with level jk ; compute mean (assume zspval is 0 ) dt = SUM(tim(1:ntframe) ) dt2 = SUM(tim(1:ntframe)*tim(1:ntframe) ) dmean(:,:) = dy (:,:) / ntframe dmean2(:,:) = dyt(:,:) / ntframe dmean3(:,:) = dyy(:,:) / ntframe IF (lcaltmean ) THEN timean(1)= dt/ntframe timean(2)= dt2/ntframe ierr=putvar1d(ncout,timean,1,'T') END IF !compute dareg, dbreg, dpear WHERE (dmean /= 0 ) dareg(:,:) = ( dmean2(:,:) - dmean(:,:) *timean(1) ) / ( timean(2) -timean(1)*timean(1) ) dbreg(:,:) = dmean(:,:) - dareg(:,:)*timean(1) dpear(:,:) = dareg(:,:)*dareg(:,:)*( timean(2) -timean(1)*timean(1))/( dmean3(:,:) -dmean(:,:)*dmean(:,:) ) WHERE (dpear < 0 ) dpear=0 ; WHERE (dpear > 1 ) dpear=1 ELSEWHERE dareg=zspval ; dbreg=zspval ; dpear=zspval ENDWHERE ierr = putvar(ncout, id_varout(ijvar ), REAL(dareg), jk, npiglo, npjglo) ierr = putvar(ncout, id_varout(ijvar+1), REAL(dbreg), jk, npiglo, npjglo) ierr = putvar(ncout, id_varout(ijvar+2), REAL(dpear), jk, npiglo, npjglo) lcaltmean = .FALSE. ! tmean already computed END DO ! loop to next level END IF END DO ! loop to next var in file ierr = closeout(ncout) END PROGRAM cdflinreg cdftools-3.0/cdfsiginsitu.f900000644000175000017500000001231212241227304017332 0ustar amckinstryamckinstryPROGRAM cdfsiginsitu !!====================================================================== !! *** PROGRAM cdfsiginsitu *** !!===================================================================== !! ** Purpose : Compute sigma insitu 3D field from gridT file !! Store the results on a 'similar' cdf file. !! !! ** Method: read temp and salinity, compute sigma insitu !! using depth taken from input T file !! History : 2.0 : 11/2004 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: narg, iargc ! browse command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's REAL(KIND=4) :: zspval ! missing value REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp ! temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsal ! salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsigi ! sigma-insitu REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! depth of T points CHARACTER(LEN=256) :: cf_tfil ! input filename CHARACTER(LEN=256) :: cf_out='siginsitu.nc' ! output file name TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfsiginsitu T-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute in situ density from temperature and salinity.' PRINT *,' Depths are taken from input file.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with temperature and salinity.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : vosigmainsitu (kg/m3 -1000 )' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfsig0, cdfsigi ' PRINT *,' ' STOP ENDIF CALL getarg (1, cf_tfil) IF ( chkfile(cf_tfil) ) STOP ! missing file npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) ipk(:)= npk ! all variables (input and output are 3D) stypvar(1)%cname = 'vosigmainsitu' stypvar(1)%cunits = 'kg/m3' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0.001 stypvar(1)%valid_max = 45. stypvar(1)%clong_name = 'in situ density' stypvar(1)%cshort_name = 'vosigmainsitu' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE (ztemp(npiglo,npjglo), zsal (npiglo,npjglo) ) ALLOCATE (zsigi(npiglo,npjglo), zmask(npiglo,npjglo) ) ALLOCATE (gdept(npk), tim(npt) ) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) zspval = getatt(cf_tfil, cn_vosaline, 'missing_value') gdept = getvar1d(cf_tfil, cn_vdeptht, npk ) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jt = 1, npt PRINT *,'time: ',jt DO jk = 1, npk zmask(:,:) = 1. ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zsal( :,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) WHERE( zsal == zspval ) zmask = 0 zsigi(:,:) = sigmai(ztemp, zsal, gdept(jk), npiglo, npjglo )* zmask(:,:) ierr = putvar(ncout, id_varout(1), zsigi, jk, npiglo, npjglo, ktime=jt) END DO ! loop to next level END DO ! loop on time ierr = closeout(ncout) END PROGRAM cdfsiginsitu cdftools-3.0/cdfdiv.f900000644000175000017500000002136012241227304016101 0ustar amckinstryamckinstryPROGRAM cdfdiv !!====================================================================== !! *** PROGRAM cdfdiv *** !!===================================================================== !! ** Purpose : Compute the divergence for given gridU gridV files !! and variables !! !! ** Method : Use the equation on continuity: Integrate the !! horizontal divergence from bottom to the top. !! ( Use the same routines than in the NEMO code ) !! !! History : 3.0 : 10/2011 : P. Mathiot : first version, based on cdfw.f90 !! !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: itmp ! working integer for level swap INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vars REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: wn ! vertical velocity on the top ! ! and bottom of a cell. ! ! wn(top) is computed REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t ! horizontal T metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e2u ! horizontal V and U metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3v, e3u, e3t ! vertical metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamt, gphit ! T longitude latitude REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn ! horizontal velocity component REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: hdivn ! horizontal divergence REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of W points REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics (full step) CHARACTER(LEN=256) :: cf_ufil ! U file name CHARACTER(LEN=256) :: cf_vfil ! V file name CHARACTER(LEN=256) :: cf_out='div.nc' ! W file name ( output) CHARACTER(LEN=256) :: cldum ! dummy string TYPE(variable), DIMENSION(1) :: stypvar ! output attributes LOGICAL :: lchk ! missing files flag LOGICAL :: lfull=.FALSE. ! full step flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg < 2 ) THEN PRINT *,' usage : cdfdiv U-file V-file [ U-var V-var ] [ -full ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the vertical velocity from the vertical integration of' PRINT *,' of the horizontal divergence of the velocity. ' PRINT *,' Limitation: coded only for C grid (be carefful with forcing field)' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' U-file : netcdf file with the zonal velocity component.' PRINT *,' V-file : netcdf file with the meridional velocity component.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ U-var V-var ] : names of the zonal and meridional velocity ' PRINT *,' components. Default are ', TRIM(cn_vozocrtx),' and ', TRIM(cn_vomecrty) PRINT *,' [ -full ] : in case of full step configuration. Default is partial step.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : div (s-1)' STOP ENDIF ijarg = 1 CALL getarg(ijarg, cf_ufil) ; ijarg = ijarg + 1 CALL getarg(ijarg, cf_vfil) ; ijarg = ijarg + 1 DO WHILE (ijarg <= narg ) CALL getarg(ijarg, cldum) ; SELECT CASE ( cldum ) CASE ( '-full' ) lfull = .TRUE. ijarg = ijarg + 1 CASE DEFAULT CALL getarg(ijarg, cn_vozocrtx) ; ijarg = ijarg + 1 CALL getarg(ijarg, cn_vomecrty) ; ijarg = ijarg + 1 END SELECT END DO PRINT *, cn_vozocrtx, cn_vomecrty lchk = chkfile (cn_fhgr) lchk = chkfile (cn_fzgr) .OR. lchk lchk = chkfile (cf_ufil) .OR. lchk lchk = chkfile (cf_vfil) .OR. lchk IF ( lchk ) STOP ! missing files npiglo = getdim(cf_ufil,cn_x) npjglo = getdim(cf_ufil,cn_y) npk = getdim(cf_ufil,cn_z) npt = getdim(cf_ufil,cn_t) ! define new variables for output ipk(1) = npk stypvar(1)%cname = 'div' stypvar(1)%cunits = 's-1' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -10. stypvar(1)%valid_max = 10. stypvar(1)%clong_name = 'Divergence field' stypvar(1)%cshort_name = 'div' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' ! Allocate the memory ALLOCATE ( e1v(npiglo,npjglo), e2u(npiglo,npjglo) ) ALLOCATE ( e1t(npiglo,npjglo), e2t(npiglo,npjglo) ) ALLOCATE ( e3u(npiglo,npjglo), e3v(npiglo,npjglo), e3t(npiglo,npjglo) ) ALLOCATE ( glamt(npiglo,npjglo), gphit(npiglo,npjglo) ) ALLOCATE ( un(npiglo,npjglo), vn(npiglo,npjglo), hdivn(npiglo,npjglo) ) ALLOCATE ( wn(npiglo,npjglo,2) ) ALLOCATE ( gdepw(npk), tim(npt) ) IF ( lfull ) ALLOCATE ( e31d (npk) ) ! Read the metrics from the mesh_hgr file e2u = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo) e1v = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo) e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) ! and the coordinates from the mesh_hgr file glamt = getvar(cn_fhgr, cn_glamt, 1, npiglo, npjglo) gphit = getvar(cn_fhgr, cn_gphit, 1, npiglo, npjglo) ! Read the depth of the w points (in the file, it is not a vector but a 1x1xnpk array) gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk) IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk) ! create output fileset ncout = create (cf_out, cf_ufil, npiglo, npjglo, npk, cdep=cn_vdepthw ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, 'dummy', npiglo, npjglo, npk, glamt, gphit, gdepw ) tim = getvar1d(cf_ufil, cn_vtimec, npt ) ierr = putvar1d(ncout , tim , npt, 'T') ! Main time loop DO jt = 1, npt ! Main level loop from top to bottom DO jk = 1, npk PRINT *,'jt = ', jt,' jk = ', jk ! velocities at level jk un(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jt) vn(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt) IF ( lfull ) THEN e3u(:,:) = e31d(jk) e3v(:,:) = e31d(jk) e3t(:,:) = e31d(jk) ELSE ! e3 metrics at level jk ( Partial steps) e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.) e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.) e3t(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF ! Compute divergence : DO jj = 2, npjglo -1 DO ji = 2, npiglo -1 hdivn(ji,jj) = & & ( e2u(ji,jj)*e3u(ji,jj) * un(ji,jj) - e2u(ji-1,jj )*e3u(ji-1,jj ) * un(ji-1,jj ) & & + e1v(ji,jj)*e3v(ji,jj) * vn(ji,jj) - e1v(ji ,jj-1)*e3v(ji ,jj-1) * vn(ji ,jj-1) ) & & / ( e1t(ji,jj)*e2t(ji,jj) * e3t(ji,jj) ) END DO END DO ! write level jk ierr = putvar(ncout, id_varout(1), hdivn, jk, npiglo, npjglo, ktime=jt) END DO ! loop to next level END DO ! loop on time ierr = closeout(ncout) END PROGRAM cdfdiv cdftools-3.0/cdfstdevts.f900000644000175000017500000001420112241227304017007 0ustar amckinstryamckinstryPROGRAM cdfstdevts !!====================================================================== !! *** PROGRAM cdfstdevts *** !!===================================================================== !! ** Purpose : Compute the RMS of T and S, from the mean squared value. !! !! ** Method : Read gridT and gridT2 and compute rms !! !! History : 2.1 : 11/2004 : J.M. Molines : Original code !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output variable INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4), DIMENSION(2) :: ipko, id_varout ! output variable REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvbar, zvba2 ! mean and mean2 variable REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsdev ! standard deviation CHARACTER(LEN=256) :: cf_in ! input mean file name CHARACTER(LEN=256) :: cf_in2 ! input mean2 file name CHARACTER(LEN=256) :: cf_out = 'stdevts.nc'! output file name CHARACTER(LEN=256) :: cv_in, cv_in2 ! input variable names CHARACTER(LEN=256) :: cldum ! dummy character variable CHARACTER(LEN=256), DIMENSION(2) :: cv_namesi ! input variable names TYPE(variable), DIMENSION(2) :: stypvaro ! output data structure LOGICAL :: lchk = .FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() cv_namesi(1) = cn_votemper cv_namesi(2) = cn_vosaline narg= iargc() IF ( narg /= 2 ) THEN PRINT *,' usage : cdfstdevts T-file T2-file ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the standard deviation of the temperature' PRINT *,' and salinity from their mean and mean square values. ' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with mean values for T, S' PRINT *,' T2-file : netcdf file with mean squared values for T,S' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cn_votemper)//'_stdev, same unit than the input.' PRINT *,' ', TRIM(cn_vosaline)//'_stdev, same unit than the input.' PRINT *,' ' PRINT *,' SEA ALSO :' PRINT *,' cdfstd, cdfrmsssh, cdfstdevw.' STOP ENDIF ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg) CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE DEFAULT ireq = ireq + 1 SELECT CASE ( ireq ) CASE ( 1 ) ; cf_in = cldum CASE ( 2 ) ; cf_in2 = cldum CASE DEFAULT PRINT *, ' Too many variables ' ; STOP END SELECT END SELECT ENDDO ! check existence of files lchk = lchk .OR. chkfile(cf_in ) lchk = lchk .OR. chkfile(cf_in2) IF (lchk ) STOP ! missing file npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z) npt = getdim (cf_in, cn_t) ipko(1) = npk stypvaro(1)%cname = TRIM(cn_votemper)//'_stdev' stypvaro(1)%cunits = 'DegC' stypvaro(1)%rmissing_value = 0. stypvaro(1)%valid_min = 0. stypvaro(1)%valid_max = 20 stypvaro(1)%clong_name = 'STDEV_Temperature' stypvaro(1)%cshort_name = TRIM(cn_votemper)//'_stdev' stypvaro(1)%conline_operation = 'N/A' stypvaro(1)%caxis = 'TZYX' ipko(2) = npk stypvaro(2)%cname = TRIM(cn_vosaline)//'_stdev' stypvaro(2)%cunits = 'PSU' stypvaro(2)%rmissing_value = 0. stypvaro(2)%valid_min = 0. stypvaro(2)%valid_max = 10 stypvaro(2)%clong_name = 'STDEV_Salinity' stypvaro(2)%cshort_name = TRIM(cn_vosaline)//'_stdev' stypvaro(2)%conline_operation = 'N/A' stypvaro(2)%caxis = 'TZYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE( zvbar(npiglo,npjglo), zvba2(npiglo,npjglo) ) ALLOCATE( dsdev(npiglo,npjglo), tim(npt) ) ncout = create (cf_out, cf_in, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvaro, 2, ipko, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk ) DO jvar = 1, 2 cv_in = cv_namesi(jvar) cv_in2 = TRIM(cv_in)//'_sqd' DO jt = 1, npt DO jk = 1, npk zvbar(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt) zvba2(:,:) = getvar(cf_in2, cv_in2, jk, npiglo, npjglo, ktime=jt) dsdev(:,:) = SQRT ( DBLE(zvba2(:,:) - zvbar(:,:)*zvbar(:,:)) ) ierr = putvar(ncout, id_varout(jvar), REAL(dsdev), jk, npiglo, npjglo, ktime=jt) END DO END DO END DO tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdfstdevts cdftools-3.0/cdfzonalsum.f900000644000175000017500000004231512241227304017172 0ustar amckinstryamckinstryPROGRAM cdfzonalsum !!====================================================================== !! *** PROGRAM cdfzonalsum *** !!===================================================================== !! ** Purpose : Compute the zonal sum of a file !! !! ** Method : In this program the 'zonal' sum is in fact a sum !! along the I coordinate. !! !! History : 2.1 : 11/2005 : J.M. Molines : Original code !! : 06/2007 : P. Mathiot : adaptation for 2D files !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- !! * Local variables IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk ,jt ! dummy loop index INTEGER(KIND=4) :: jbasin, jvar ! dummy loop index INTEGER(KIND=4) :: ijvar ! variable counter INTEGER(KIND=4) :: npbasins=1 ! number of subbasin INTEGER(KIND=4) :: ivar = 0 ! output variable counter INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvarin, nvar ! number of input variables: all/valid INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipki, id_varin ! jpbasin x nvar INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipko, id_varout ! jpbasin x nvar INTEGER(KIND=4), DIMENSION(2) :: ijloc ! working array for maxloc REAL(KIND=4) :: ra = 6371229. ! earth radius (m) REAL(KIND=4) :: z2pi ! 2 x 3.14... REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep ! gdept or gdepw REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: alpha ! REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, gphi, zv ! metrics, latitude, data value REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdumlon ! dummy longitude = 0. REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdumlat ! latitude for i = north pole REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmaskvar ! variable mask REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask ! basin mask jpbasins x npiglo x npjglo REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dzosum ! jpbasins x npjglo x npk CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cf_out='zonalsum.nc' ! output file name CHARACTER(LEN=256) :: cf_pdeg='zonalintdeg.nc' ! output file name CHARACTER(LEN=256) :: cf_basins='none' ! sub basin file name CHARACTER(LEN=10 ) :: cv_e1, cv_e2 ! horizontal metrics variable names CHARACTER(LEN=10 ) :: cv_phi ! latitude variable name CHARACTER(LEN=10 ) :: cv_msk ! mask variable name CHARACTER(LEN=10 ) :: cv_depi, cv_depo ! depth variable name (input/output) CHARACTER(LEN=256) :: cldum ! dummy character variable CHARACTER(LEN=256) :: ctyp ! variable type on C-grid CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_namesi ! input variable names CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nameso ! output variable names CHARACTER(LEN=4 ), DIMENSION(5) :: cbasin=(/'_glo','_atl','_inp','_ind','_pac'/) ! sub basin suffixes TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvari ! structure for input variables TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvaro ! structure for output variables LOGICAL :: lpdep =.FALSE. ! flag for depth sign (default dep < 0) LOGICAL :: lpdeg =.FALSE. ! flag for per degree normalization LOGICAL :: l2d =.FALSE. ! flag for 2D files LOGICAL :: lchk =.FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfzonalsum IN-file point_type [ BASIN-file] ...' PRINT *,' ... [-pdep | --positive_depths]' PRINT *,' ... [-pdeg | --per_degree]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the zonal sum of all the variables available in the' PRINT *,' input file. This program assume that all the variables are' PRINT *,' located on the same C-grid point, specified on the command line.' PRINT *,' ' PRINT *,' Zonal sum is in fact the integral value computed along the I coordinate.' PRINT *,' The result is a vertical slice, in the meridional direction.' PRINT *,' ' PRINT *,' REMARK : partial step are not handled properly (but probably ' PRINT *,' minor impact on results).' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : input netcdf file.' PRINT *,' point_type : indicate the location on C-grid (T|U|V|F|W)' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [BASIN-file] : netcdf file describing sub basins, similar to ' PRINT *,' ', TRIM(cn_fbasins),'. If this name is not given ' PRINT *,' as option, only the global zonal integral is computed.' PRINT *,' [-pdep | --positive_depths ] : use positive depths in the output file.' PRINT *,' Default behaviour is to have negative depths.' PRINT *,' [-pdeg | --per_degree ] : When using this option, the zonal integral' PRINT *,' is normalized per degree of latitude. This was formally' PRINT *,' done with cdfzonalintdeg program, which is now merged' PRINT *,' in this one.' PRINT *,' Default behaviour is not to normalize.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),', ', TRIM(cn_fzgr),' and ', TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out),' or ', TRIM(cf_pdeg),' (-pdeg option)' PRINT *,' variables : output variable names are built with the following' PRINT *,' convention: zoixxxx_bas' PRINT *,' where zoi replace vo/so prefix of the input variable' PRINT *,' where bas is a suffix for each sub-basins (or glo)' PRINT *,' if a BASIN-file is used.' PRINT *,' Units are modified by adding ''.m2'' at the end. Can be improved !' PRINT *,' In addition, ''.degree-1'' is append to unit with -pdeg option.' STOP ENDIF ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg ) CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE (cldum) CASE ( '-pdep' , '--positive_depths' ) ; lpdep =.TRUE. CASE ( '-pdeg' , '--per_degree' ) ; lpdeg =.TRUE. CASE DEFAULT ireq=ireq+1 SELECT CASE (ireq) CASE (1) ; cf_in = cldum ! file name is the 1rst argument CASE (2) ; ctyp = cldum ! point type is the 2nd CASE (3) ; cf_basins = cldum ! sub basin file is the 3rd (optional) npbasins = 5 lchk = chkfile (cf_basins) CASE DEFAULT PRINT *,' Too many arguments ...' ; STOP END SELECT END SELECT END DO ! check files existence lchk = lchk .OR. chkfile (cn_fhgr) lchk = lchk .OR. chkfile (cn_fzgr) lchk = lchk .OR. chkfile (cn_fmsk) lchk = lchk .OR. chkfile (cf_in ) IF ( lchk ) STOP ! missing files ! set the metrics according to C grid point SELECT CASE (ctyp) CASE ('T', 't', 'S', 's') cv_e1 = cn_ve1t ; cv_e2 = cn_ve2t cv_depi = cn_gdept ; cv_depo = cn_vdeptht cv_phi = cn_gphit ; cv_msk = 'tmask' CASE ('U', 'u') cv_e1 = cn_ve1u ; cv_e2 = cn_ve2u cv_depi = cn_gdept ; cv_depo = cn_vdepthu cv_phi = cn_gphiu ; cv_msk = 'umask' CASE ('V', 'v') cv_e1 = cn_ve1v ; cv_e2 = cn_ve2v cv_depi = cn_gdept ; cv_depo = cn_vdepthv cv_phi = cn_gphiv ; cv_msk = 'vmask' CASE ('F', 'f') cv_e1 = cn_ve1f ; cv_e2 = cn_ve2f cv_depi = cn_gdept ; cv_depo = cn_vdeptht cv_phi = cn_gphif ; cv_msk = 'fmask' CASE ('W', 'w') cv_e1 = cn_ve1t ; cv_e2 = cn_ve2t cv_depi = cn_gdepw ; cv_depo = cn_vdepthw cv_phi = cn_gphit ; cv_msk = 'tmask' CASE DEFAULT PRINT *, ' C grid:', TRIM(ctyp),' point not known!' ; STOP END SELECT nvarin = getnvar(cf_in) ! number of input variables ALLOCATE ( cv_namesi(nvarin), ipki(nvarin), id_varin (nvarin) ) ALLOCATE ( cv_nameso(npbasins*nvarin), ipko(npbasins*nvarin), id_varout(npbasins*nvarin) ) ALLOCATE ( stypvari(nvarin) ) ALLOCATE ( stypvaro(npbasins*nvarin) ) cv_namesi(1:nvarin) = getvarname(cf_in, nvarin, stypvari ) ipki (1:nvarin) = getipk (cf_in, nvarin ) ! buildt output filename nvar = 0 ! over all number of valid variables for zonal sum ( < nvarin) ivar = 0 ! over all variable counter ( nvar x basins) DO jvar = 1,nvarin ! skip variables such as nav_lon, nav_lat, time_counter deptht ... IF (ipki(jvar) == 0 ) THEN cv_namesi(jvar)='none' ELSE nvar = nvar + 1 ! count for valid input variables id_varin(nvar) = jvar ! use indirect adressing for those variables DO jbasin=1,npbasins ivar=ivar + 1 ! count for output variables cv_nameso(ivar)='zoi'//TRIM(cv_namesi(jvar)(3:))//TRIM(cbasin(jbasin) ) ! intercept case of duplicate zonal name IF (cv_namesi(jvar) == 'iowaflup' ) cv_nameso(ivar)='zoiwaflio' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'cfc11' ) cv_nameso(ivar)='zoicfc11' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'bombc14' ) cv_nameso(ivar)='zoibc14' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'invcfc' ) cv_nameso(ivar)='zoiinvcfc' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'invc14' ) cv_nameso(ivar)='zoiinvc14' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'qtrcfc' ) cv_nameso(ivar)='zoiqtrcfc' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'qtrc14' ) cv_nameso(ivar)='zoiqtrc14' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'qintcfc' ) cv_nameso(ivar)='zoiqintcfc' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'qintc14' ) cv_nameso(ivar)='zoiqintc14' // TRIM(cbasin(jbasin) ) stypvaro(ivar)%cname = cv_nameso(ivar) ! units can be build automatically: add .m2 at the end (not very nice ...) ! a special function to parse the unit and build the proper one is to be done ! this is tricky as many details are to be taken into account : ! eg : mol/m2, kg.m-2, W/m2 IF ( lpdeg ) THEN cf_out = cf_pdeg stypvaro(ivar)%cunits = stypvari(jvar)%cunits//'.m2.degree-1' stypvaro(ivar)%clong_name = 'Zonal_Integral_per_pegree_'//TRIM(stypvari(jvar)%clong_name)//TRIM(cbasin(jbasin) ) ELSE stypvaro(ivar)%cunits = stypvari(jvar)%cunits//'.m2' stypvaro(ivar)%clong_name = 'Zonal_Integral_'//TRIM(stypvari(jvar)%clong_name)//TRIM(cbasin(jbasin) ) ENDIF stypvaro(ivar)%rmissing_value = stypvari(ivar)%rmissing_value stypvaro(ivar)%valid_min = stypvari(jvar)%valid_min stypvaro(ivar)%valid_max = stypvari(jvar)%valid_max stypvaro(ivar)%cshort_name = stypvaro(ivar)%cname stypvaro(ivar)%conline_operation = '/N/A' IF (ipki(jvar) == 1 ) THEN stypvaro(ivar)%caxis ='TY' ELSE stypvaro(ivar)%caxis ='TZY' ENDIF ipko(ivar)=ipki(jvar) END DO ENDIF END DO npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z) npt = getdim (cf_in, cn_t) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! if 2D fields, npk=0, assume 1 IF ( npk == 0 ) THEN npk = 1 l2d = .TRUE. PRINT *,' It is a 2D field, assume npk=1 and gdep=0' END IF ! Allocate arrays ALLOCATE ( zmask(npbasins,npiglo,npjglo) ) ALLOCATE ( zv(npiglo,npjglo), zmaskvar(npiglo,npjglo) ) ALLOCATE ( e1(npiglo,npjglo), e2 (npiglo,npjglo) ) ALLOCATE ( gphi(npiglo,npjglo), gdep(npk), tim(npt) ) ALLOCATE ( zdumlon(1,npjglo), zdumlat(1,npjglo) ) ALLOCATE ( dzosum(npjglo,npk), alpha(npjglo) ) ! get the metrics e1(:,:) = getvar(cn_fhgr, cv_e1, 1, npiglo, npjglo) e2(:,:) = getvar(cn_fhgr, cv_e2, 1, npiglo, npjglo) gphi(:,:) = getvar(cn_fhgr, cv_phi, 1, npiglo, npjglo) ! compute the size of the meridional mesh size in degree IF ( lpdeg ) THEN z2pi = 2.0 * ACOS( -1.) alpha(:) = e2(1,:) *360. / z2pi / ra ELSE alpha(:) = 1.e0 ENDIF IF (l2d) THEN gdep(:) = 0 ELSE gdep(:) = getvare3(cn_fzgr, cv_depi ,npk) ENDIF IF ( .NOT. lpdep ) gdep(:) = -1.* gdep(:) ! helps for plotting the results ! Look for the i-index that go through the North Pole ijloc = MAXLOC(gphi) zdumlat(1,:) = gphi(ijloc(1),:) zdumlon(:,:) = 0. ! set the dummy longitude to 0 ! create output fileset ncout = create (cf_out, cf_in, 1, npjglo, npk, cdep=cv_depo ) ierr = createvar (ncout, stypvaro, ivar, ipko, id_varout ) ierr = putheadervar(ncout, cf_in, 1, npjglo, npk, pnavlon=zdumlon, pnavlat=zdumlat, pdep=gdep ) tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ! reading the surface masks ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif zmask(1,:,:) = getvar(cn_fmsk, cv_msk, 1, npiglo, npjglo) IF ( cf_basins /= 'none' ) THEN zmask(2,:,:) = getvar(cf_basins, 'tmaskatl', 1, npiglo, npjglo ) zmask(4,:,:) = getvar(cf_basins, 'tmaskind', 1, npiglo, npjglo ) zmask(5,:,:) = getvar(cf_basins, 'tmaskpac', 1, npiglo, npjglo ) zmask(3,:,:) = zmask(5,:,:) + zmask(4,:,:) ! ensure that there are no overlapping on the masks WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1 ENDIF ! main computing loop ivar = 0 DO jvar = 1, nvar ijvar = id_varin(jvar) DO jt = 1,npt IF (MOD(jt,100)==0) PRINT *, jt,'/',npt DO jk = 1, ipki(ijvar) PRINT *,TRIM(cv_namesi(ijvar)), ' level ',jk ! Get variables and mask at level jk zv(:,:) = getvar(cf_in, cv_namesi(ijvar), jk ,npiglo, npjglo, ktime=jt) zmaskvar(:,:) = getvar(cn_fmsk, cv_msk, jk ,npiglo, npjglo ) ! For all basins DO jbasin = 1, npbasins dzosum(:,:) = 0.d0 ! integrates 'zonally' (along i-coordinate) DO ji=1,npiglo DO jj=1,npjglo dzosum(jj,jk) = dzosum(jj,jk) + e1(ji,jj)*e2(ji,jj)* zmask(jbasin,ji,jj)*zmaskvar(ji,jj)*zv(ji,jj)*1.d0 END DO END DO dzosum(:,jk) = dzosum(:,jk) / alpha(:) ! eventual normalization per degree ivar = (jvar-1)*npbasins + jbasin ierr = putvar (ncout, id_varout(ivar), REAL(dzosum(:,jk)), jk, 1, npjglo, ktime=jt) END DO !next basin END DO ! next k END DO ! next time END DO ! next variable ierr = closeout(ncout) END PROGRAM cdfzonalsum cdftools-3.0/cdfbathy.f900000644000175000017500000006356112241227304016437 0ustar amckinstryamckinstryPROGRAM cdfbathy !!====================================================================== !! *** PROGRAM cdfbathy *** !!===================================================================== !! ** Purpose : Utility to modify a bathymetric file according to !! specific option (eg : fill an area, modify points ...) !! Using -var option and -lev, can also edit any file with !! the same tool, except the specific actions dedicated to !! the bathymetry (eg : zstep like ...) !! !! ** Method : All modifications are save in a fortran file ready to be !! used to replay all the modif at once. !! !! History : 2.1 : 11/2007 : J.M. Molines : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! zgr_zps !! zgr_read !! prlog !! fillzone !! raz_zone !! raz_below !! set_below !! dumpzone !! nicedumpzone !! replacezone !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE ! INTEGER(KIND=4) :: narg, iargc, ijarg ! browse command line INTEGER(KIND=4) :: iimin, iimax ! selected area INTEGER(KIND=4) :: ijmin, ijmax ! selected area INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: iklev ! selected level INTEGER(KIND=4) :: itime ! selected time INTEGER(KIND=4) :: npiglo, npjglo ! domain size INTEGER(KIND=4) :: npk, npt ! domaine size INTEGER(KIND=4) :: iversion=1 ! version counter for working copy INTEGER(KIND=4) :: iostat, ipos ! used for version control INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mbathy ! map of wet model level REAL(KIND=4) :: e3zps_min=25. ! minimum thickness of bottom cell REAL(KIND=4) :: e3zps_rat=0.2 ! minimum ratio e3bot/e3_0 REAL(KIND=4) :: rdepmin=600. ! default value for depmin (full step like) REAL(KIND=4) :: rdepfill=0. ! default filling value REAL(KIND=4) :: scale_factor=1. ! divide by scale factor when reading REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e3t, e3w ! vertical metrics REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept, gdepw ! depth at T and W points REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3_bot ! bottom depth (partial steps) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: bathyin ! initial data value REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: bathy ! modified data value ! CHARACTER(LEN=256) :: cf_in ! original input file name CHARACTER(LEN=256) :: cf_root ! root part of the file name CHARACTER(LEN=256) :: cf_dump ! dump txt file name (out) CHARACTER(LEN=256) :: cf_replace ! replace txt file name (in) CHARACTER(LEN=80) :: cf_batfile = 'zgrbat.txt' ! txt file giving vertical mesh CHARACTER(LEN=80) :: cf_log = 'log.f90' ! default log file CHARACTER(LEN=80) :: cv_in ! variable name CHARACTER(LEN=256) :: cwkc ! filename of working copy CHARACTER(LEN=256) :: cldum ! dummy string LOGICAL :: lexist = .TRUE., lfill = .FALSE. ! all required flags for options LOGICAL :: lfullstep = .FALSE., lappend = .FALSE. ! all required flags for options LOGICAL :: lreplace = .FALSE., ldump = .FALSE. ! all required flags for options LOGICAL :: lmodif = .FALSE., loverwrite = .FALSE. ! all required flags for options LOGICAL :: lraz = .FALSE., ldumpn = .FALSE. ! all required flags for options LOGICAL :: lrazb = .FALSE., lsetb = .FALSE. ! all required flags for options LOGICAL :: lchk = .FALSE. ! all required flags for options !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfbathy/cdfvar -f IN-file [options]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Allow manual modification of the input file. Very convenient' PRINT *,' for bathymetric files, can also be used with any model file' PRINT *,' Keep a log.f90 file of the modifications for automatic reprocessing' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : original input file. The program works on a copy of the' PRINT *,' original file (default)' PRINT *,' ' PRINT *,' OPTIONS :' PRINT 9999, ' -file (or -f ) : name of input file ' PRINT 9999, ' -var (or -v ) : name of cdf variable [default: Bathymetry]' PRINT 9999, ' -lev (or -l ) : level to work with ' PRINT 9999, ' -time (or -t ) : time to work with ' PRINT 9999, ' -scale s : use s as a scale factor (divide when read the file)' PRINT 9999, ' -zoom (or -z ) : sub area of the bathy file to work with (imin imax jmin jmax)' PRINT 9999, ' -fillzone (or -fz ) : sub area will be filled with 0 up to the first coast line ' PRINT 9999, ' -raz_zone (or -raz ) : sub area will be filled with 0 up ' PRINT 9999, ' -raz_below depmin : any depth less than depmin in subarea will be replaced by 0 ' PRINT 9999, ' (or -rb depmin ) ' PRINT 9999, ' -set_below depmin : any depth less than depmin in subarea will be replaced by depmin ' PRINT 9999, ' (or -sb depmin ) ' PRINT 9999, ' -fullstep depmin : sub area will be reshaped as full-step, below depmin' PRINT 9999, ' (or -fs depmin ) requires the presence of the file zgr_bat.txt (from ocean.output, eg )' PRINT 9999, ' -dumpzone (or -d ) : sub area will be output to an ascii file, which can be used by -replace' PRINT 9999, ' after manual editing ' PRINT 9999, ' -nicedumpzone : sub area will be output to an ascii file (nice output)' PRINT 9999, ' (or -nd )' PRINT 9999, ' -replace (or -r ) : sub area defined by the file will replace the original bathy' PRINT 9999, ' -append (or -a ) : fortran log file (log.f90) will be append with actual modif' PRINT 9999, ' Standard behaviour is to overwrite/create log file' PRINT 9999, ' -overwrite (or -o ) : input bathy file will be used as output.' PRINT 9999, ' Standard behaviour is to use a work copy of the original file' PRINT 9999, ' (indexed from 01 to 99 if necessary ) ' PRINT 9999, ' -log logfile : log file for change (default is log.f90) ' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT 9999, ' netcdf file : according to used options, if the original file is to be modified' PRINT 9999, ' a sequence number is added at the end of the input file name, to keep' PRINT 9999, ' modifications.' PRINT *,' variables : same as input file' STOP ENDIF 9999 FORMAT(5x,a) ijarg = 1 iimin=-10 ; iimax=-10 ; ijmin=-10 ; ijmax=-10 cv_in = cn_bathymet ! default value iklev = 1 itime = 1 DO WHILE (ijarg <= narg) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) ! CASE ( '-file' , '-f' ) ! name of input file CALL getarg(ijarg, cf_in) ; ijarg = ijarg + 1 lchk = ( lchk .OR. chkfile (cf_in) ) ! CASE ( '-var' , '-v' ) ! name of netcdf variable CALL getarg(ijarg, cv_in) ; ijarg = ijarg + 1 ! CASE ( '-lev' , '-k' ) ! level to work with CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iklev ! CASE ( '-time' , '-t' ) ! time frame to work with CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itime ! CASE ( '-scale' ) ! dividing scale factor CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) scale_factor ! CASE ( '-zoom' , '-z' ) ! specify zoomed area CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimin CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax CASE ( '-fillzone' , '-fz' ) ! Fill the area specified with zoom ! with 0 till a coast is encountered in the East lfill=.TRUE. ; lmodif=.TRUE. ! CASE ( '-raz_zone' , '-raz' ) ! Set a zoomed area to 0 lraz=.TRUE. ; lmodif=.TRUE. ! CASE ( '-raz_below' , '-rb' ) ! Area below this value are set to 0 CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rdepfill lrazb=.TRUE. ; lmodif=.TRUE. ! CASE ( '-set_below' , '-sb' ) ! Area below this value are set to values CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rdepfill lsetb=.TRUE. ; lmodif=.TRUE. ! CASE ( '-fullstep' , '-fs' ) ! Create a full-step like bathy in zoomed area lfullstep=.TRUE. ; lmodif=.TRUE. CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rdepmin ! CASE ( '-append' , '-a' ) ! Append modification to the f90 log file lappend=.TRUE. ! CASE ( '-overwrite' , '-o' ) ! Overwrite modifications in f90 log file loverwrite=.TRUE. ! CASE ( '-replace' , '-r' ) ! Replace zoomed area by values in ascii file lreplace=.TRUE. ; lmodif=.TRUE. CALL getarg(ijarg, cf_replace) ; ijarg = ijarg +1 lchk = ( lchk .OR. chkfile (cf_replace) ) ! CASE ( '-log' ) ! log file name CALL getarg(ijarg, cf_log) ; ijarg = ijarg +1 ! CASE ( '-dumpzone' , '-d' ) ! output the zoomed area in a formatted file ldump=.TRUE. CALL getarg(ijarg, cf_dump) ; ijarg = ijarg +1 ! CASE ( '-nicedumpzone' , '-nd' ) ! idem dumpzone above but with nicer format ldumpn=.TRUE. CALL getarg(ijarg, cf_dump) ; ijarg = ijarg +1 ! CASE DEFAULT PRINT *, cldum,' : unknown option ' STOP END SELECT END DO IF ( lchk ) STOP ! missing files IF ( lmodif .AND. .NOT. loverwrite) THEN ! creating a working copy of the file indexed by iversion ipos=INDEX(cf_in,'.',.TRUE.) READ(cf_in(ipos+1:),*,IOSTAT=iostat) iversion IF (iostat /=0 ) THEN iversion=0 cf_root=cf_in ELSE cf_root=cf_in(1:ipos-1) ENDIF iversion=iversion+1 DO WHILE ( lexist ) WRITE(cwkc,'(a,a,i2.2)') TRIM(cf_root),'.',iversion INQUIRE(FILE=cwkc,EXIST=lexist) iversion=iversion+1 END DO PRINT *, 'Working copy will be : ' ,TRIM(cwkc) CALL system(' cp -f '//cf_in//' '//cwkc ) ELSE cwkc=cf_in ENDIF npiglo = getdim(cwkc,cn_x) npjglo = getdim(cwkc,cn_y) npk = getdim(cwkc,cn_z) npt = getdim(cwkc,cn_t) IF (npk == 0 ) npk = 1 IF (npt == 0 ) npt = 1 IF ( iklev > npk ) THEN PRINT *,' ERROR : not enough levels in input file ', TRIM(cwkc) ENDIF IF ( itime > npt ) THEN PRINT *,' ERROR : not enough times in input file ', TRIM(cwkc) ENDIF IF ( iimin == -10 ) THEN ! no zoom option passed iimin=1 ; iimax=npiglo ijmin=1 ; ijmax=npjglo END IF PRINT *, 'NPIGLO = ', npiglo PRINT *, 'NPJGLO = ', npjglo PRINT *, 'IMIN IMAX JMIN JMAX :', iimin, iimax,ijmin,ijmax ALLOCATE (mbathy(npiglo,npjglo), e3_bot( npiglo,npjglo)) ALLOCATE (bathy( npiglo,npjglo), bathyin(npiglo,npjglo)) ! we use bathy as variable name but it can be any field from cf_in bathy(:,:) = getvar(cwkc, cv_in, iklev, npiglo, npjglo, ktime=itime) bathy(:,:) = bathy(:,:)/scale_factor bathyin = bathy ! save original IF (lfullstep ) THEN ;CALL zgr_read ; CALL zgr_zps(iimin, iimax, ijmin, ijmax) ; ENDIF IF (lfill ) CALL fillzone (iimin, iimax, ijmin, ijmax) IF (lraz ) CALL raz_zone (iimin, iimax, ijmin, ijmax) IF (lrazb ) CALL raz_below (iimin, iimax, ijmin, ijmax, rdepfill) IF (lsetb ) CALL set_below (iimin, iimax, ijmin, ijmax, rdepfill) IF (ldump ) CALL dumpzone (cf_dump, iimin, iimax, ijmin, ijmax) IF (ldumpn ) CALL nicedumpzone (cf_dump, iimin, iimax, ijmin, ijmax) IF (lreplace ) CALL replacezone (cf_replace) IF (lmodif ) THEN ! save log CALL prlog(bathyin, bathy, npiglo, npjglo, lappend) ierr = putvar(cwkc, cv_in, iklev, iimax-iimin+1, ijmax-ijmin+1, kimin=iimin, kjmin=ijmin, & & ptab=bathy(iimin:iimax,ijmin:ijmax)*scale_factor, ktime=itime) ENDIF CONTAINS SUBROUTINE zgr_zps ( kimin, kimax ,kjmin, kjmax ) !!--------------------------------------------------------------------- !! *** ROUTINE zgr_zps *** !! !! ** Purpose : Build the partial steps !! !! ** Method : Use NEMO routine !! !!---------------------------------------------------------------------- INTEGER(KIND=4) ,INTENT(in) :: kimin, kimax, kjmin, kjmax !! * Local declarations INTEGER(KIND=4) :: ji, jj, jk ! dummy loop indices INTEGER(KIND=4) :: ik, it ! temporary integers INTEGER(KIND=4), PARAMETER :: wp=4 ! working precision is 4 in the CDFTOOLS REAL(wp) :: ze3tp, ze3wp ! Last ocean level thickness at T- and W-points REAL(wp) :: zdepwp ! Ajusted ocean depth to avoid too small e3t REAL(wp) :: zdepth ! " " REAL(wp) :: zmax, zmin ! Maximum and minimum depth REAL(wp) :: zdiff ! temporary scalar !!---------------------------------------------------------------------- ! Initialization of constant zmax = gdepw(npk) + e3t(npk) zmin = gdepw(4) ! initialize mbathy to the maximum ocean level available mbathy(kimin:kimax,kjmin:kjmax) = npk-1 ! storage of land and island's number (zero and negative values) in mbathy WHERE (bathy(kimin:kimax,kjmin:kjmax) <= 0. ) mbathy(kimin:kimax,kjmin:kjmax)=INT( bathy(kimin:kimax,kjmin:kjmax) ) ! bounded value of bathy ! minimum depth == 3 levels ! maximum depth == gdepw(jpk)+e3t(jpk) ! i.e. the last ocean level thickness cannot exceed e3t(jpkm1)+e3t(jpk) WHERE (bathy(kimin:kimax,kjmin:kjmax) <= 0 ) bathy(kimin:kimax,kjmin:kjmax)=0. ELSEWHERE (bathy(kimin:kimax,kjmin:kjmax) < zmin ) bathy(kimin:kimax,kjmin:kjmax) = zmin ELSEWHERE (bathy(kimin:kimax,kjmin:kjmax) >= zmax ) bathy(kimin:kimax,kjmin:kjmax) = zmax END WHERE ! Compute mbathy for ocean points (i.e. the number of ocean levels) ! find the number of ocean levels such that the last level thickness ! is larger than the minimum of e3zps_min and e3zps_rat * e3t (where ! e3t is the reference level thickness DO jk = npk-1, 1, -1 ! zdepth = gdepw(jk) + MIN( e3zps_min, e3t(jk)*e3zps_rat ) zdepth = gdept(jk) WHERE ( bathy(kimin:kimax,kjmin:kjmax) > 0. .AND. bathy (kimin:kimax,kjmin:kjmax) <= zdepth ) mbathy(kimin:kimax,kjmin:kjmax)=jk-1 e3_bot(kimin:kimax,kjmin:kjmax)= bathy(kimin:kimax,kjmin:kjmax) - gdepw(jk-1) END WHERE END DO DO ji=kimin,kimax DO jj=kjmin,kjmax jk=mbathy(ji,jj) IF (jk /= 0 ) THEN IF (gdepw(jk+1) > rdepmin ) bathy(ji,jj)=gdepw(jk+1)-0.1 ENDIF ENDDO END DO END SUBROUTINE zgr_zps SUBROUTINE zgr_read() !!--------------------------------------------------------------------- !! *** ROUTINE zgr_read *** !! !! ** Purpose : Read zgrbat.txt file (cf_batfile) to set the gdep[tw]_0 !! and e3[tw] !! !! ** Method : Read the ocean output format ( ie, cf_batfile is just !! a copy of the ocean.output concerning zgrbat !! !!---------------------------------------------------------------------- INTEGER(KIND=4) :: inumzgr = 10, il, iostat, idum, ifoo CHARACTER(LEN=256) :: cline, clfile !!---------------------------------------------------------------------- clfile = cf_batfile ! defined in the main program il=0 OPEN(inumzgr, FILE=clfile,IOSTAT=iostat) DO WHILE ( iostat == 0 ) READ(inumzgr,'(a)',IOSTAT=iostat) cline READ(cline,*,IOSTAT=idum )il IF ( idum == 0 ) npk=il END DO ALLOCATE ( gdept(npk), gdepw(npk), e3t(npk), e3w(npk) ) REWIND(inumzgr) il=0 ; iostat=0 DO WHILE ( iostat == 0 ) READ(inumzgr,'(a)', IOSTAT=iostat) cline READ(cline,*,IOSTAT=idum) il IF ( idum == 0 ) READ(cline,*) ifoo, gdept(il), gdepw(il), & & e3t(il), e3w(il) END DO END SUBROUTINE zgr_read SUBROUTINE prlog (ptabold, ptab ,kpi, kpj, ldapp) !!--------------------------------------------------------------------- !! *** ROUTINE prlog *** !! !! ** Purpose : Print a fortran 90 log file describing the modifications !! done to the bathymetry !! !! ** Method : File is append instead of created if ldapp true !! !!---------------------------------------------------------------------- REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: ptabold ! original array REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: ptab ! modified array INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! size of the array LOGICAL, INTENT(in) :: ldapp ! append flag INTEGER(KIND=4) :: ji, jj INTEGER(KIND=4) :: inumlog=10 CHARACTER(LEN=80) :: clfile !!---------------------------------------------------------------------- clfile = cf_log IF (ldapp ) THEN OPEN (inumlog, FILE=clfile, POSITION='append') ELSE OPEN (inumlog, FILE=clfile) ENDIF WRITE(inumlog,'(a,a)') '! modification from original file : ', TRIM(cf_in) WRITE(inumlog,'(a,a)') '! written to : ', TRIM(cwkc) DO ji=1,kpi DO jj=1,kpj IF ( ABS( ptabold(ji,jj) - ptab(ji,jj)) > 0.02 ) THEN ! allow a 2 cm tolerance for rounding purposes WRITE(inumlog,'(a,i4,a,i4,a,f8.2,a,f8.2)') ' bathy(',ji,',',jj,')=',ptab(ji,jj)*scale_factor, & & ' ! instead of ',ptabold(ji,jj)*scale_factor END IF END DO END DO CLOSE(inumlog) END SUBROUTINE prlog SUBROUTINE fillzone(kimin, kimax, kjmin, kjmax) !!--------------------------------------------------------------------- !! *** ROUTINE fillzone *** !! !! ** Purpose : Fill a subarea with 0 up to encounter a coast on the East !! !! ** Method : Assume that first point is sea point. Mask it and do so with !! all points to the east (j=cst) up to a land point. !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows INTEGER(KIND=4) :: jj INTEGER(KIND=4) :: ii !!---------------------------------------------------------------------- DO jj=kjmin,kjmax ii=kimin IF ( bathy(ii,jj) /= 0 ) THEN DO WHILE ( bathy(ii,jj) /= 0 .AND. ii <= kimax ) bathy(ii,jj) = 0. ii=ii+1 END DO END IF END DO END SUBROUTINE fillzone SUBROUTINE raz_zone(kimin, kimax, kjmin, kjmax) !!--------------------------------------------------------------------- !! *** ROUTINE raz_zone *** !! !! ** Purpose : Fill a sub area of a bathy file with 0 !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows !!---------------------------------------------------------------------- bathy(kimin:kimax, kjmin:kjmax) = 0. END SUBROUTINE raz_zone SUBROUTINE raz_below(kimin, kimax, kjmin, kjmax, pdepmin) !!--------------------------------------------------------------------- !! *** ROUTINE raz_below *** !! !! ** Purpose : Fill point (set to 0) that are below pdepmin !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows REAL(KIND=4), INTENT(in) :: pdepmin ! threshold bathy value !!---------------------------------------------------------------------- WHERE ( bathy(kimin:kimax, kjmin:kjmax) <= pdepmin) bathy(kimin:kimax, kjmin:kjmax) = 0. END SUBROUTINE raz_below SUBROUTINE set_below(kimin, kimax, kjmin, kjmax, pdepmin) !!--------------------------------------------------------------------- !! *** ROUTINE set_below *** !! !! ** Purpose : Set bathy points to pdepmin if less than pdepmin in the !! original bathy !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows REAL(KIND=4), INTENT(in) :: pdepmin ! threshold bathy value !!---------------------------------------------------------------------- WHERE ( bathy(kimin:kimax, kjmin:kjmax) <= pdepmin .AND. bathy(kimin:kimax, kjmin:kjmax) > 0 ) & & bathy(kimin:kimax, kjmin:kjmax) = pdepmin END SUBROUTINE set_below SUBROUTINE dumpzone(cdumpf, kimin, kimax, kjmin, kjmax) !!--------------------------------------------------------------------- !! *** ROUTINE dumpzone *** !! !! ** Purpose : Print subarea to cdumpf ascii file !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdumpf ! name of the dump file INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows INTEGER(KIND=4) :: ji, jj INTEGER(KIND=4) :: inumdmp=20 , ini CHARACTER(LEN=256) :: cl_fmtr, cl_fmti !!---------------------------------------------------------------------- ini = kimax - kimin + 1 WRITE(cl_fmtr,99) ini WRITE(cl_fmti,98) ini OPEN(inumdmp,FILE=cdumpf) WRITE(inumdmp,*) kimin, kimax, kjmin, kjmax, TRIM(cl_fmtr) 99 FORMAT('(I5,',i4.4,'f8.2)') 98 FORMAT('(5x,',i4.4,'I8)') WRITE(inumdmp,cl_fmti)(ji,ji=kimin,kimax) DO jj= kjmax,kjmin,-1 WRITE(inumdmp,cl_fmtr) jj, bathy(kimin:kimax,jj) ENDDO CLOSE(inumdmp) END SUBROUTINE dumpzone SUBROUTINE nicedumpzone(cdumpf, kimin, kimax, kjmin, kjmax) !!--------------------------------------------------------------------- !! *** ROUTINE nicedumpzone *** !! !! ** Purpose : Print subarea to cdumpf ascii file with a nice format !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdumpf ! name of the dump file INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows INTEGER(KIND=4) :: ji, jj INTEGER(KIND=4) :: inumdmp=20 , ini CHARACTER(LEN=256) :: cl_fmtr, cl_fmti !!---------------------------------------------------------------------- ini=kimax-kimin+1 WRITE(cl_fmtr,99) ini WRITE(cl_fmti,98) ini OPEN(inumdmp,FILE=cdumpf) WRITE(inumdmp,*) kimin,kimax,kjmin,kjmax, TRIM(cl_fmtr) 99 FORMAT('(I5,',i4.4,'I5)') 98 FORMAT('(5x,',i4.4,'I5)') WRITE(inumdmp,cl_fmti)(ji,ji=kimin,kimax) DO jj= kjmax,kjmin,-1 WRITE(inumdmp,cl_fmtr) jj, INT(bathy(kimin:kimax,jj)) WRITE(inumdmp,*) WRITE(inumdmp,*) ENDDO CLOSE(inumdmp) END SUBROUTINE nicedumpzone SUBROUTINE replacezone(cdreplace) !!--------------------------------------------------------------------- !! *** ROUTINE replacezone *** !! !! ** Purpose : Replace a bathy area by data read from an ascii input file !! formely generated by -dump option (and manualy modified) !! !! ** Method : Read format in the header part of the file !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdreplace INTEGER(KIND=4) :: jj INTEGER(KIND=4) :: iimin, iimax, ijmin, ijmax INTEGER(KIND=4) :: inumrep=20, idum !!---------------------------------------------------------------------- OPEN(inumrep,FILE=cdreplace) READ(inumrep,*) iimin, iimax, ijmin, ijmax READ(inumrep,*) ! skip 1 line DO jj=ijmax,ijmin,-1 READ(inumrep,*) idum, bathy(iimin:iimax,jj) END DO CLOSE(inumrep) END SUBROUTINE replacezone END PROGRAM cdfbathy cdftools-3.0/cdfmoy_weighted.f900000644000175000017500000002304712241227304020007 0ustar amckinstryamckinstryPROGRAM cdfmoy_weighted !!====================================================================== !! *** PROGRAM cdfmoy_weighted *** !!===================================================================== !! ** Purpose : Compute weighted mean values from already processed !! mean files (by cdfmoy) !! !! ** Method : The weight of each file is the number of elements used !! when computing the time average. !! !! History : 2.1 : 11/2009 : J.M. Molines : Original code !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !! function : comments !! setweight : return weight for given variable and file !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! command line INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain INTEGER(KIND=4) :: nvars ! number of variables in a file INTEGER(KIND=4) :: ntags ! number of tags to process INTEGER(KIND=4) :: iweight ! variable weight INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! array of input var id's INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! array of output var levels INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! array of output var id's REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: v2d ! array to read a layer of data REAL(KIND=4), DIMENSION(1) :: timean, tim ! time counter REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dtab ! array for cumulated values REAL(KIND=8) :: dtotal_time, dsumw ! cumulated times and weights CHARACTER(LEN=256) :: cf_in ! current input file name CHARACTER(LEN=256) :: cf_out='cdfmoy_weighted.nc' ! output file name CHARACTER(LEN=256) :: cv_dep ! name of depth variable CHARACTER(LEN=256) :: cldum ! dummy character variable CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for output var attributes LOGICAL :: lold5d ! flag for old5d output !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmoy_weighted list of files [-old5d ]' PRINT *,' PURPOSE :' PRINT *,' Compute weight average of files. The weight for each file is' PRINT *,' read from the iweight attribute. In particular, this attribute' PRINT *,' is set to the number of elements used when computing a time' PRINT *,' average (cdfmoy program). A primary application is thus for' PRINT *,' computing annual mean from monthly means.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' The list of files to be averaged, which are supposed to be of' PRINT *,' the same type and to contain the same variables. This list MUST' PRINT *,' be given before any options' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-old5d ] : This option is used to mimic/replace the cdfmoy_annual' PRINT *,' which is no longer available. With this option, 12 monthly' PRINT *,' files must be given, and it is assumed that the monthly' PRINT *,' means were computed from 5d output of a simulation using' PRINT *,' a noleap calendar ( weights are fixed, predetermined)' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : same as in the input files' STOP ENDIF ! default values lold5d = .FALSE. ! scan command line and check if files exist ijarg = 1 ntags = narg DO WHILE ( ijarg <= narg ) CALL getarg ( ijarg, cldum ) ; ijarg = ijarg +1 SELECT CASE ( cldum ) CASE ( '-old5d' ) lold5d = .TRUE. ntags = ntags - 1 CASE DEFAULT cf_in = cldum IF ( chkfile (cldum ) ) STOP ! missing file END SELECT ENDDO ! additional check in case of old_5d averaged files IF ( lold5d ) THEN IF ( ntags /= 12 ) THEN PRINT *,' ERROR : exactly 12 monthly files are required for -old5d option' STOP ENDIF ENDIF npiglo = getdim (cf_in, cn_x ) npjglo = getdim (cf_in, cn_y ) npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr ) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z',cdtrue=cv_dep, kstatus=ierr ) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'nav_lev',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'levels',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF ENDIF ENDIF PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk ALLOCATE( dtab(npiglo,npjglo), v2d(npiglo,npjglo) ) nvars = getnvar(cf_in) PRINT *,' nvars =', nvars ALLOCATE (cv_names(nvars) ) ALLOCATE (stypvar(nvars) ) ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars) ) ! get list of variable names and collect attributes in stypvar (optional) cv_names(:) = getvarname(cf_in, nvars, stypvar) id_var(:) = (/(jvar, jvar=1,nvars)/) ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk(cf_in, nvars, cdep=cv_dep) WHERE( ipk == 0 ) cv_names='none' stypvar(:)%cname = cv_names ! create output file taking the sizes in cf_in ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep ) ierr = createvar (ncout , stypvar, nvars, ipk, id_varout ) ierr = putheadervar(ncout , cf_in, npiglo, npjglo, npk, cdep=cv_dep ) DO jvar = 1,nvars IF ( cv_names(jvar) == cn_vlon2d .OR. & cv_names(jvar) == cn_vlat2d ) THEN ! skip these variable ELSE PRINT *,' Working with ', TRIM(cv_names(jvar)), ipk(jvar) DO jk = 1, ipk(jvar) PRINT *,'Level ',jk dtab(:,:) = 0.d0 ; dtotal_time = 0.d0 ; dsumw=0.d0 DO jt = 1, ntags CALL getarg (jt, cf_in) iweight = setweight(cf_in, jt, cv_names(jvar)) dsumw = dsumw + iweight v2d(:,:) = getvar(cf_in, cv_names(jvar), jk ,npiglo, npjglo ) dtab(:,:) = dtab(:,:) + iweight * v2d(:,:) IF (jk == 1 .AND. jvar == nvars ) THEN tim = getvar1d(cf_in, cn_vtimec, 1 ) dtotal_time = dtotal_time + tim(1) END IF END DO ! finish with level jk ; compute mean (assume spval is 0 ) ! store variable on outputfile ierr = putvar(ncout, id_varout(jvar), SNGL(dtab(:,:)/dsumw), jk, npiglo, npjglo, kwght=INT(dsumw) ) IF (jk == 1 .AND. jvar == nvars ) THEN timean(1) = dtotal_time/ntags ierr = putvar1d(ncout, timean, 1, 'T') END IF END DO ! loop to next level END IF END DO ! loop to next var in file ierr = closeout(ncout) CONTAINS INTEGER(KIND=4) FUNCTION setweight( cdfile, kt, cdvar ) !!--------------------------------------------------------------------- !! *** FUNCTION setweight *** !! !! ** Purpose : Return the weight of cdvar in cdfile !! !! ** Method : Get attribute iweight from cdfvar in cdfile. !! If lold5d is true, assume weight for 5d build monthly !! means. If iweight not found 1 is return. !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile INTEGER(KIND=4), INTENT(in) :: kt CHARACTER(LEN=*), INTENT(in) :: cdvar INTEGER(KIND=4), DIMENSION(12) :: iweight5d=(/6,5,7,6,6,6,6,6,6,6,6,7/) !!---------------------------------------------------------------------- IF ( lold5d ) THEN setweight = iweight5d(kt) ELSE setweight = getatt( cdfile, cdvar, 'iweight') IF ( setweight == 0 ) setweight = 1 ENDIF END FUNCTION setweight END PROGRAM cdfmoy_weighted cdftools-3.0/cdffracinv.f900000644000175000017500000001256612241227304016757 0ustar amckinstryamckinstryPROGRAM cdffracinv !!====================================================================== !! *** PROGRAM cdffracinv *** !!===================================================================== !! ** Purpose : Computes fraction of inventory for passive tracers !! output. This is the ratio between inventory at a !! grid point and total inventory !! !! History : 2.1 : 07/2010 : C.O. Dufour : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jt ! dummy loop index INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's of output vars REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: trcinvij ! tracer inventory REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: fracinv ! fraction of inventory REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter CHARACTER(LEN=256) :: cf_trc ! tracer file (for inventory) CHARACTER(LEN=256) :: cf_out='fracinv.nc' ! output file name CHARACTER(LEN=256) :: cv_inv='invcfc' ! inventory name CHARACTER(LEN=256) :: cv_out='fracinv' ! output variable name CHARACTER(LEN=256) :: cglobal ! global attribute CHARACTER(LEN=256) :: cldum ! dummy string TYPE(variable), DIMENSION(1) :: stypvar ! structure for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdffracinv TRC-file [-inv INV-name]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the fraction of inventory for passive tracers, which is ' PRINT *,' the ratio between inventory at a grid point and the total inventory.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' TRC-file : netcdf file with tracer inventory.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' -inv INV-name : name of the netcdf name for inventory [ ',TRIM(cv_inv),' ]' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none ... but : horizontal weight to be coded ?' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_out) STOP ENDIF ijarg = 1 CALL getarg (ijarg, cf_trc) ; ijarg = ijarg + 1 IF ( chkfile(cf_trc) ) STOP ! missing file DO WHILE (ijarg <= narg ) CALL getarg(ijarg,cldum ) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-inv' ) ; CALL getarg(ijarg, cv_inv) ; ijarg =ijarg + 1 CASE DEFAULT ; PRINT *, 'option ', TRIM(cldum),' not understood' ; STOP END SELECT END DO npiglo = getdim (cf_trc,cn_x) npjglo = getdim (cf_trc,cn_y) npk = getdim (cf_trc,cn_z) npt = getdim (cf_trc,cn_t) ipk(1) = 1 stypvar(1)%cname = cv_out stypvar(1)%cunits = '' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 10000. stypvar(1)%clong_name = 'Fraction of inventory' stypvar(1)%cshort_name = cv_out stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk ALLOCATE( trcinvij(npiglo,npjglo), fracinv(npiglo,npjglo) ) ALLOCATE( tim(npt) ) WRITE(cglobal,9000) TRIM(cf_trc), TRIM(cv_inv) 9000 FORMAT('cdffracinv ',a,' -inv ',a ) ncout = create (cf_out, cf_trc, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout, cdglobal=cglobal ) ierr = putheadervar(ncout, cf_trc, npiglo, npjglo, 1 ) DO jt=1,npt fracinv( :,:) = 0. trcinvij(:,:) = getvar(cf_trc, cv_inv, 1, npiglo, npjglo, ktime=jt) ! JMM bug ?? : SUM(trcinij) is not the 'total inventory', should be weighted by model metrics ??? ! also assume spval is 0 fracinv( :,:) = trcinvij(:,:) / SUM(trcinvij(:,:)) ierr = putvar(ncout, id_varout(1), fracinv, 1, npiglo, npjglo, ktime=jt) END DO tim = getvar1d(cf_trc, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdffracinv cdftools-3.0/cdfsig0.f900000644000175000017500000001144012241227304016157 0ustar amckinstryamckinstryPROGRAM cdfsig0 !!====================================================================== !! *** PROGRAM cdfsig0 *** !!===================================================================== !! ** Purpose : Compute sigma0 3D field from gridT file !! Store the results on a 'similar' cdf file. !! !! ** Method : Use NEMO equation of state !! !! History : 2.1 : 11/2006 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: narg, iargc ! browse command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp ! temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsal ! salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsig0 ! sigma-0 REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter CHARACTER(LEN=256) :: cf_tfil ! input filename CHARACTER(LEN=256) :: cf_out='sig0.nc' ! output file name TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfsig0 T-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute potential density (sigma-0) refered to the surface.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with temperature and salinity.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cn_vosigma0), ' ( kg/m3 - 1000 )' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfsigi' STOP ENDIF CALL getarg (1, cf_tfil) IF (chkfile(cf_tfil) ) STOP ! missing file npiglo = getdim (cf_tfil, cn_x) npjglo = getdim (cf_tfil, cn_y) npk = getdim (cf_tfil, cn_z) npt = getdim (cf_tfil, cn_t) ipk(:) = npk ! all variables (input and output are 3D) stypvar(1)%cname = cn_vosigma0 stypvar(1)%cunits = 'kg/m3' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0.001 stypvar(1)%valid_max = 40. stypvar(1)%clong_name = 'Potential_density:sigma-0' stypvar(1)%cshort_name = cn_vosigma0 stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE (ztemp(npiglo,npjglo), zsal (npiglo,npjglo) ) ALLOCATE (zsig0(npiglo,npjglo), zmask(npiglo,npjglo) ) ALLOCATE (tim(npt) ) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) tim=getvar1d(cf_tfil, cn_vtimec, npt ) ierr=putvar1d(ncout, tim, npt, 'T') DO jt=1,npt PRINT *,' TIME = ', jt, tim(jt)/86400.,' days' DO jk = 1, npk zmask(:,:)=1. ztemp(:,:)= getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zsal(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) ! assuming spval is 0 WHERE( zsal == 0 ) zmask = 0 zsig0(:,:) = sigma0 (ztemp, zsal, npiglo, npjglo )* zmask(:,:) ierr = putvar(ncout, id_varout(1), zsig0, jk, npiglo, npjglo, ktime=jt) END DO ! loop to next level END DO ! next time frame ierr = closeout(ncout) END PROGRAM cdfsig0 cdftools-3.0/cdfpsi.f900000644000175000017500000004512612241227304016120 0ustar amckinstryamckinstryPROGRAM cdfpsi !!====================================================================== !! *** PROGRAM cdfpsi *** !!===================================================================== !! ** Purpose : Compute Barotropic Stream Function !! !! ** Method : Compute the 2D fields dtrpu, dtrpv as the integral on !! the vertical of u, v on their respective points. !! Then integrate from south to north : ==> dpsiu !! Then integrate from West to East : ==> dpsiv !! (should be almost the same (if no error )) !! Default (appropriate for global model): output dpsiu; !! normalizes the values setting psi (jpi,jpj) = 0 !! If option "V" is given as last argument, output dpsiv, !! normalizes values setting psi(jpi,1) = 0. !! This is appropriate for North Atlantic !! !! History : 2.1 : 05/2005 : J.M. Molines : Original code !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames USE modutils !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: iiref, ijref ! reference i j point INTEGER(KIND=4) :: nvout=1 ! number of output variables INTEGER(KIND=4), DIMENSION(:),ALLOCATABLE :: ipk, id_varout ! levels and id's of output vars REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e3v ! v metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2u, e3u ! u metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, zv ! velocity components REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamf, gphif ! longitude/latitude REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsshu, zsshv ! ssh at u and v point REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zssh ! temporary array for ssh REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! 1d vertical metrics, full step case REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtrpu, dtrpv ! transport working arrays REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtrpsshu ! transport working arrays REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtrpsshv ! transport working arrays REAL(KIND=8), TARGET, DIMENSION(:,:), ALLOCATABLE :: dpsiu ! BSF ( U computation REAL(KIND=8), TARGET, DIMENSION(:,:), ALLOCATABLE :: dpsiv ! BSF (V computation ) REAL(KIND=8), TARGET, DIMENSION(:,:), ALLOCATABLE :: dpsisshu ! BSF ( SSHU computation REAL(KIND=8), TARGET, DIMENSION(:,:), ALLOCATABLE :: dpsisshv ! BSF ( SSHV computation ) REAL(KIND=8), POINTER, DIMENSION(:,:) :: dpsi ! point to dpsiu or dpsiv REAL(KIND=8), POINTER, DIMENSION(:,:) :: dpsissh ! point to dpsisshu or dpsisshv CHARACTER(LEN=256) :: cf_ufil ! gridU netcdf file name CHARACTER(LEN=256) :: cf_vfil ! gridV netcdf file name CHARACTER(LEN=256) :: cf_tfil ! gridT netcdf file name (-ssh option) CHARACTER(LEN=256) :: cf_out='psi.nc' ! output file name CHARACTER(LEN=256) :: cv_out='sobarstf' ! output variable name CHARACTER(LEN=256) :: cv_outssh='sobarstfssh' ! output variable name CHARACTER(LEN=256) :: cv_outotal='sobarstftotal' ! output variable name CHARACTER(LEN=256) :: cldum ! dummy character variable CHARACTER(LEN=256) :: cglobal ! global attribute TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for attributes LOGICAL :: lchk = .FALSE. ! flag for missing files LOGICAL :: ll_u = .TRUE. ! flag for U integration LOGICAL :: ll_v = .FALSE. ! flag for V integration LOGICAL :: lfull = .FALSE. ! flag for full step config LOGICAL :: lmask = .FALSE. ! flag for masking output LOGICAL :: lmean = .FALSE. ! flag for mean U,V calculation LOGICAL :: lopen = .FALSE. ! flag for open calculation LOGICAL :: lssh = .FALSE. ! flag for ssh computation !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfpsi U-file V-file [V] [-full ] [-mask ] [-mean] ...' PRINT *,' ... [-ssh T-file ] [-open ] [-ref iref jref ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Computes the barotropic stream function (a proxy ) as the integral of ' PRINT *,' the transport.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' U-file : netcdf file of zonal velocity.' PRINT *,' V-file : netcdf file of meridional velocity.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [V] : use V field instead of U field for integration.' PRINT *,' [ -full ] : indicates a full step case. Default is partial steps.' PRINT *,' [ -mask ] : mask output fields. Note that the land value is significant.' PRINT *,' It correspond to the potential on this continent.' PRINT *,' [ -mean ] : save the average of the computations done with U and V.' PRINT *,' [ -ssh T-file ] : compute the transport in the ''ssh'' layer, using ' PRINT *,' surface velocities. Take the ssh from T-file specified in ' PRINT *,' this option. This is a experimental option, not certified ...' PRINT *,' [ -open ] : for open domain configuration. See also -ref to set ' PRINT *,' reference point.' PRINT *,' [ -ref iref jref ] : Set the reference point in i,j coordinates.' PRINT *,' BSF at reference point is arbitrarly set to zero.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fhgr),' and ', TRIM(cn_fzgr),'.' PRINT *,' ', TRIM(cn_fmsk),' is required only if -mask option used.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_out),' (m3/s )' PRINT *,' If option -ssh is used, 2 additional variables are added to the file :' PRINT *,' ', TRIM(cv_outssh),' (m3/s ) : contribution of SSH' PRINT *,' ', TRIM(cv_outotal),' (m3/s ) : total BSF' PRINT *,' ' STOP ENDIF CALL SetGlobalAtt (cglobal) iiref = -1 ; ijref= -1 ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg ) CALL getarg( ijarg, cldum ) ; ijarg=ijarg + 1 SELECT CASE ( cldum ) CASE ('-full') ; lfull = .TRUE. CASE ('-mask') ; lmask = .TRUE. CASE ('-mean') ; lmean = .TRUE. ; ll_v=.TRUE. ; ll_u=.TRUE. CASE ('-ssh' ) ; lssh = .TRUE. ; nvout=3 CALL getarg( ijarg, cf_tfil ) ; ijarg=ijarg + 1 CASE ('-open') ; lopen = .TRUE. ; ll_v=.TRUE. ; ll_u=.TRUE. CASE ('-ref') CALL getarg( ijarg, cldum ) ; ijarg=ijarg + 1 ; READ(cldum,*) iiref CALL getarg( ijarg, cldum ) ; ijarg=ijarg + 1 ; READ(cldum,*) ijref CASE DEFAULT ireq = ireq + 1 SELECT CASE ( ireq) CASE ( 1 ) ; cf_ufil = cldum CASE ( 2 ) ; cf_vfil = cldum CASE ( 3 ) ; ll_v = .TRUE. ; ll_u = .FALSE. CASE DEFAULT PRINT *, ' Too many arguments !' ; STOP END SELECT END SELECT ENDDO lchk = lchk .OR. chkfile( cn_fhgr ) lchk = lchk .OR. chkfile( cn_fzgr ) IF ( lmask) lchk = lchk .OR. chkfile( cn_fmsk ) IF ( lssh ) lchk = lchk .OR. chkfile( cf_tfil ) lchk = lchk .OR. chkfile( cf_ufil ) lchk = lchk .OR. chkfile( cf_vfil ) IF ( lchk ) STOP ! missing file npiglo = getdim (cf_ufil, cn_x) npjglo = getdim (cf_ufil, cn_y) npk = getdim (cf_ufil, cn_z) npt = getdim (cf_ufil, cn_t) IF ( iiref == -1 .OR. ijref == -1 ) THEN iiref=npiglo ijref=npjglo ENDIF ALLOCATE (stypvar(nvout), ipk(nvout), id_varout(nvout)) ! define new variables for output ( must update att.txt) ipk(:) = 1 ! 2D ( X, Y , T ) stypvar(:)%cunits = 'm3/s' stypvar(:)%valid_min = -300.e6 stypvar(:)%valid_max = 300.e6 stypvar(:)%conline_operation = 'N/A' stypvar(:)%caxis = 'TYX' stypvar(1)%cname = cv_out stypvar(1)%rmissing_value = 0. stypvar(1)%clong_name = 'Barotropic_Stream_Function' stypvar(1)%cshort_name = cv_out IF ( lssh ) THEN stypvar(2)%cname = cv_outssh stypvar(2)%rmissing_value = 0. stypvar(2)%clong_name = 'Barotropic_Stream_Function SSH contribution' stypvar(2)%cshort_name = cv_outssh stypvar(3)%cname = cv_outotal stypvar(3)%rmissing_value = 0. stypvar(3)%clong_name = 'Barotropic_Stream_Function SSH total' stypvar(3)%cshort_name = cv_outotal ENDIF PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt PRINT *, ' Option is use :' PRINT *, ' -full :', lfull PRINT *, ' -mask :', lmask PRINT *, ' -mean :', lmean PRINT *, ' -ssh :', lssh PRINT *, ' -open :', lopen PRINT *, ' -ref :', iiref, ijref PRINT *, ' U-comp :', ll_u PRINT *, ' V-comp :', ll_v ! Allocate arrays ALLOCATE ( zmask(npiglo,npjglo) ) ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo)) ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo)) ALLOCATE ( zu(npiglo,npjglo),dtrpu(npiglo,npjglo), dpsiu(npiglo,npjglo) ) ALLOCATE ( zv(npiglo,npjglo),dtrpv(npiglo,npjglo), dpsiv(npiglo,npjglo) ) ALLOCATE ( glamf(npiglo,npjglo), gphif(npiglo,npjglo)) ALLOCATE ( tim(npt)) IF ( lfull ) ALLOCATE ( e31d(npk)) IF ( lssh ) ALLOCATE ( zssh(npiglo,npjglo), zsshu(npiglo,npjglo), zsshv(npiglo,npjglo)) IF ( lssh ) ALLOCATE ( dpsisshu(npiglo,npjglo), dpsisshv(npiglo,npjglo) ) IF ( lssh ) ALLOCATE ( dtrpsshu(npiglo,npjglo), dtrpsshv(npiglo,npjglo) ) glamf(:,:) = getvar(cn_fhgr, cn_glamf, 1, npiglo, npjglo) gphif(:,:) = getvar(cn_fhgr, cn_gphif, 1, npiglo, npjglo) ! create output fileset ncout = create (cf_out, cf_ufil, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, nvout, ipk, id_varout, cdglobal=TRIM(cglobal) ) ierr = putheadervar(ncout, cf_ufil, npiglo, npjglo, 1, glamf, gphif) tim = getvar1d(cf_ufil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo) e2u(:,:) = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo) IF ( lmask) THEN zmask(:,:) = getvar(cn_fmsk, 'fmask', 1, npiglo, npjglo) WHERE ( zmask >= 2 ) zmask = 1 ENDIF IF ( lfull) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk ) ! get rid of the free-slip/no-slip condition DO jt = 1, npt dtrpu(:,:)= 0.d0 dtrpv(:,:)= 0.d0 dpsiu(:,:)= 0.d0 dpsiv(:,:)= 0.d0 IF ( lssh ) THEN zsshu(:,:) = 0.0 zsshv(:,:) = 0.0 dpsisshu(:,:) = 0.d0 dpsisshv(:,:) = 0.d0 dtrpsshu(:,:) = 0.d0 dtrpsshv(:,:) = 0.d0 zssh(:,:) = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo, ktime=jt) zsshu(1:npiglo-1, : ) = 0.5*( zssh(2:npiglo,: ) + zssh(1:npiglo-1,: )) zsshv( : ,1:npjglo-1) = 0.5*( zssh(: ,2:npjglo) + zssh(: ,1:npjglo-1)) ENDIF DO jk = 1,npk IF ( ll_v ) THEN zv(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt ) IF ( lfull ) THEN ; e3v(:,:) = e31d(jk) ELSE ; e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF dtrpv(:,:) = dtrpv(:,:) + zv(:,:)*e1v(:,:)*e3v(:,:)*1.d0 ! meridional transport of each grid cell IF ( lssh .AND. (jk == 1 ) ) THEN dtrpsshv(:,:) = dtrpsshv(:,:) + zv(:,:)*e1v(:,:)*zsshv(:,:)*1.d0 ! meridional transport of each grid cell ENDIF ENDIF IF ( ll_u) THEN zu(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jt ) IF ( lfull ) THEN ; e3u(:,:) = e31d(jk) ELSE ; e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF dtrpu(:,:) = dtrpu(:,:) + zu(:,:)*e2u(:,:)*e3u(:,:)*1.d0 ! zonal transport of each grid cell IF ( lssh .AND. (jk == 1 ) ) THEN dtrpsshu(:,:) = dtrpsshu(:,:) + zv(:,:)*e2u(:,:)*zsshu(:,:)*1.d0 ! meridional transport of each grid cell ENDIF ENDIF END DO ! loop to next level IF ( lopen ) THEN ! This case corresponds to arbitrary configuration: we chose to compute the transport ! across a first line ( eg, ji= 2 or jj= npjglo-1 ), assuming that this starting line is ! in the true ocean. If it is on true land, it is not a problem. But it cannot be on ! arbitrary masked points.... IF ( lssh ) THEN dpsisshu(1,npjglo-2) = dtrpsshv(1, npjglo-2) DO ji = 2, npiglo dpsisshu(ji,npjglo-2) = dpsisshu(ji-1,npjglo-2) + dtrpsshv(ji,npjglo-2) END DO ! Then compute the transport with along U starting from this line DO jj= npjglo-3,1,-1 DO ji = 1, npiglo dpsisshu(ji,jj) = dpsisshu(ji,jj+1) + dtrpsshu(ji,jj+1) END DO END DO ENDIF dpsiu(1,npjglo-2) = dtrpv(1, npjglo-2) DO ji = 2, npiglo dpsiu(ji,npjglo-2) = dpsiu(ji-1,npjglo-2) + dtrpv(ji,npjglo-2) END DO ! Then compute the transport with along U starting from this line DO jj= npjglo-3,1,-1 DO ji = 1, npiglo dpsiu(ji,jj) = dpsiu(ji,jj+1) + dtrpu(ji,jj+1) END DO END DO IF ( lmean ) THEN ! we need also the other estimate dpsiv(npiglo-2, npjglo) = dtrpu(npiglo-2, npjglo) DO jj= npjglo - 1, 1, -1 dpsiv(npiglo-2,jj) = dpsiv(npiglo-2, jj+1) + dtrpu(npiglo-2, jj+1) END DO DO jj=npjglo,1,-1 DO ji = npiglo -3,1,-1 dpsiv(ji,jj) = dpsiv(ji+1,jj) - dtrpv(ji+1,jj) END DO END DO dpsiu(:,:) = 0.5*(dpsiu(:,:) + dpsiv(:,:)) IF ( lssh ) THEN dpsisshv(npiglo-2, npjglo) = dtrpsshu(npiglo-2, npjglo) DO jj= npjglo - 1, 1, -1 dpsisshv(npiglo-2,jj) = dpsisshv(npiglo-2, jj+1) + dtrpsshu(npiglo-2, jj+1) END DO DO jj=npjglo,1,-1 DO ji = npiglo -3,1,-1 dpsisshv(ji,jj) = dpsisshv(ji+1,jj) - dtrpsshv(ji+1,jj) END DO END DO dpsisshu(:,:) = 0.5*(dpsisshu(:,:) + dpsisshv(:,:)) ENDIF ENDIF dpsi => dpsiu IF ( lssh ) dpsissh => dpsisshu ELSE ! now perform zonal integration if requested IF ( ll_v ) THEN ! integrate zonally from east to west ! This comfortable with NATL configurations as the eastern most points are land points. dpsiv(npiglo,:)= 0.d0 DO ji=npiglo-1,1,-1 dpsiv(ji,:) = dpsiv(ji+1,:) - dtrpv(ji,:) ! psi at f point END DO dpsi => dpsiv IF ( lssh ) THEN dpsisshv(npiglo,:)= 0.d0 DO ji=npiglo-1,1,-1 dpsisshv(ji,:) = dpsisshv(ji+1,:) - dtrpsshv(ji,:) ! psissh at f point END DO dpsissh => dpsisshv ENDIF ENDIF ! now perform meridional integration if requested IF ( ll_u ) THEN ! integrate from the south to the north with zonal transport ! This is because on global configuration, line jj=1 is always land (Antarctic) dpsiu(:,:) = 0.d0 DO jj = 2, npjglo dpsiu(:,jj) = dpsiu(:,jj-1) - dtrpu(:,jj) ! psi at f point END DO dpsi => dpsiu IF ( lssh ) THEN dpsisshu(:,:) = 0.d0 DO jj = 2, npjglo dpsisshu(:,jj) = dpsisshu(:,jj-1) - dtrpsshu(:,jj) ! psissh at f point END DO dpsissh => dpsisshu ENDIF ENDIF IF ( lmean) THEN dpsiu(:,:) = 0.5 * ( dpsiu(:,:) + dpsiv(:,:) ) dpsi => dpsiu IF ( lssh ) THEN dpsisshu(:,:) = 0.5 * ( dpsisshu(:,:) + dpsisshv(:,:) ) dpsissh => dpsisshu ENDIF ENDIF ENDIF ! output results after normalization dpsi = dpsi - dpsi(iiref,ijref) IF ( lmask ) THEN PRINT *,' Write masked BSF' ierr = putvar(ncout, id_varout(1), SNGL(dpsi)*zmask(:,:), 1, npiglo, npjglo, ktime=jt) IF ( lssh ) THEN ierr = putvar(ncout, id_varout(2), SNGL(dpsissh )*zmask(:,:), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(3), SNGL(dpsissh+dpsi)*zmask(:,:), 1, npiglo, npjglo, ktime=jt) ENDIF ELSE PRINT *,' Write BSF' ierr = putvar(ncout, id_varout(1), SNGL(dpsi) , 1, npiglo, npjglo, ktime=jt) IF ( lssh ) THEN ierr = putvar(ncout, id_varout(2), SNGL(dpsissh ), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(3), SNGL(dpsissh+dpsi), 1, npiglo, npjglo, ktime=jt) ENDIF ENDIF ENDDO ierr = closeout (ncout) END PROGRAM cdfpsi cdftools-3.0/cdffixtime.f900000644000175000017500000004470212241227304016771 0ustar amckinstryamckinstryPROGRAM cdffixtime !!====================================================================== !! *** PROGRAM cdffixtime *** !!===================================================================== !! ** Purpose : Correct time inconsistency in model output file or !! mean fields. !! !! ** Method : Adjust the values of time_counters in order to be !! coherent with the time_origin and units attribute. !! According to drakkar the time in seconds represents !! the time of the model at the moment of output, ie at !! the end of the averaging period. The time origin is !! shifted back half the averaging period in order to !! indicate the center of the averaging period. !! This program is intended to manage both leap year !! and noleap year calendars. !! !! History : 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! jcnes : return the jcnes Julian day from time tag !! julday : return the true Julian day !! caldatjm : Return the calendar date from the input jcnes day !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: narg ! number of arguments INTEGER(KIND=4) :: iargc ! f90 function INTEGER(KIND=4) :: ijarg ! argument counter INTEGER(KIND=4) :: is, ie ! starting and ending position of the tag in file name INTEGER(KIND=4) :: iyr_init ! initial date (year) INTEGER(KIND=4) :: imm_init ! initial date (month) INTEGER(KIND=4) :: idd_init ! initial date (day) INTEGER(KIND=4) :: ihr_init ! ititial time (hour) INTEGER(KIND=4) :: imn_init ! ititial time (minutes) INTEGER(KIND=4) :: isec_init ! ititial time (seconds) INTEGER(KIND=4) :: ierr ! error status for i/o REAL(KIND=4) :: rpp_one_year = 365 ! 365.2425 REAL(KIND=4) :: rdt_obs = 5. ! time interval between file fields (days) REAL(KIND=4) :: rday0 ! CNES julian day corresponding to tag of initial date REAL(KIND=4) :: rday_origin ! CNES julian day corresponding to origin date REAL(KIND=4), DIMENSION(1) :: rdaycnes ! CNES julian day corresponding to current tag REAL(KIND=4), DIMENSION(1) :: rseconds ! seconds since rday0 CHARACTER(LEN=80) :: cf_in ! input file CHARACTER(LEN=80) :: cldum ! dummy character variable CHARACTER(LEN=80) :: ctag='none' ! tag default. Interpreted from file name if possible CHARACTER(LEN=80) :: cldate, ctim ! date and time as string CHARACTER(LEN=80) :: ctag0 ! time tag from input initial date/time CHARACTER(LEN=80) :: ctim_unit ! attribute value for time_counter unit CHARACTER(LEN=80) :: ctim_origin ! attribute value for time_counter time_origin CHARACTER(LEN=3) :: cmm ! month in character LOGICAL :: lnoleap=.true. ! flag for noleap years LOGICAL :: lagrif=.false. ! flag for agrif files LOGICAL :: lkeep=.false. ! flag for agrif files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg=iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdffixtime -f IN-file -i initial date [-t tag] [-dt freq] ... ' PRINT *,' ... [-keep ] [-leap] [ -noleap]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Change time_counter in file to set it according to drakkar rule,' PRINT *,' time_counter attibutes ''units'' and ''time_origin'' are ajusted.' PRINT *,' * units are ''seconds since yyyy-mm-dd hh:mm:ss'' ' PRINT *,' * time_origin is set to ''yyyy-MMM-dd hh:mm:ss'', MMM represents a' PRINT *,' litteral abbreviation for the month (eg: JAN FEB MAR ...)' PRINT *,' Once fixed, the time_counter indicates the middle of the output ' PRINT *,' interval (in case of averaged output, of course).' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' -f IN-file : specify the file whose time_counter need adjustment' PRINT *,' -i inital date : indicate the time origin in a fixed 2 words format' PRINT *,' yyyy-mm-dd hh:mm:ss ( eg: 1956-05-16 04:30:00 )' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -t tag ] : supply a time tag corresponding to the file. If not' PRINT *,' supplied, tag is taken from the name of the input file' PRINT *,' assuming DRAKKAR convention ( CONFIG-CASE_tag_xxxx.nc )' PRINT *,' [ -dt freq] : number of days between model output [ 5d ]' PRINT *,' [-leap ] : assume a calendar with leap years' PRINT *,' [-noleap ] : assume a calendar without leap years (default)' PRINT *,' [-keep ] : keep the actual value of time_counter, adjust time_counter' PRINT *,' attributes only;' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none ' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : Input file is modified (only attributes)' PRINT *,' ' STOP ENDIF ! browse line option ijarg=1 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum) ; ijarg=ijarg + 1 SELECT CASE (cldum) CASE ( '-f' ) CALL getarg(ijarg,cf_in) ;ijarg=ijarg +1 CASE ( '-t' ) CALL getarg(ijarg,ctag) ; ijarg=ijarg +1 CASE ( '-dt' ) CALL getarg(ijarg,cldum) ; ijarg=ijarg +1 READ(cldum,*) rdt_obs CASE ( '-i' ) CALL getarg(ijarg,cldate) ; ijarg=ijarg +1 CALL getarg(ijarg,ctim) ; ijarg=ijarg +1 CASE ( '-leap' ) rpp_one_year=365.2425 lnoleap=.false. CASE ( '-noleap' ) rpp_one_year=365 lnoleap=.true. CASE ( '-keep' ) lkeep=.true. CASE DEFAULT PRINT *,' Option ',TRIM(cldum),' unknown' STOP END SELECT END DO IF ( chkfile(cf_in) ) STOP ! missing file PRINT *,' Changing time on file :', TRIM(cf_in) ! if ctag = none, try to find it from the file name. IF ( TRIM(ctag) == 'none' ) THEN ! no tag given as arguments is = INDEX(cf_in,'_') IF ( is == 2 ) THEN PRINT *,' ASSUME AGRIF file for ', TRIM(cf_in) lagrif = .TRUE. ENDIF IF (lagrif) THEN is=INDEX(cf_in(3:),'_' )+2 ie=INDEX(cf_in(is+1:),'_' ) ctag=cf_in(is+1:is+ie-1) ELSE is=INDEX(cf_in,'_') ie=INDEX(cf_in(is+1:),'_' ) ctag=cf_in(is+1:is+ie-1) ENDIF is=INDEX(ctag,'d') IF ( is == 0 ) THEN ! not a model output but a mean value is=INDEX(ctag,'m') IF ( is == 0 ) THEN ! annual mean set pseudo date to 01/07 ctag=ctag(1:5)//"m07d01" ELSE ! monthly mean set pseudo date to the 15 of month ctag=ctag(1:8)//"d15" ENDIF ENDIF ENDIF PRINT *,' Using tag = ', TRIM(ctag) ! interpret ctim and cldate READ(cldate,'(i4,1x,i2,1x,i2)' ) iyr_init, imm_init, idd_init READ(ctim, '(i2,1x,i2,1x,i2)' ) ihr_init, imn_init, isec_init WRITE(ctag0,'("y",i4.4,"m",i2.2,"d",i2.2)') iyr_init, imm_init, idd_init ! jcnes of initial date including time as fraction of days rday0 = jcnes(ctag0) + ihr_init/24.0 + imn_init/60./24. + isec_init/3600./24. ! compute the pseudo time_origin and set up variable attributes rday_origin = rday0 - rdt_obs/2. ! offset of -1/2 of time interval CALL caldatjm(rday_origin, iyr_init, imm_init, idd_init, ihr_init, imn_init, isec_init) WRITE(cldate,'(i4.4,"-",i2.2,"-",i2.2)') iyr_init, imm_init, idd_init WRITE(ctim, '(i2.2,":",i2.2,":",i2.2)') ihr_init, imn_init, isec_init ! Compute initial julian day SELECT CASE ( imm_init ) CASE ( 1 ) ; cmm='JAN' CASE ( 2 ) ; cmm='FEB' CASE ( 3 ) ; cmm='MAR' CASE ( 4 ) ; cmm='APR' CASE ( 5 ) ; cmm='MAY' CASE ( 6 ) ; cmm='JUN' CASE ( 7 ) ; cmm='JUL' CASE ( 8 ) ; cmm='AUG' CASE ( 9 ) ; cmm='SEP' CASE ( 10 ) ; cmm='OCT' CASE ( 11 ) ; cmm='NOV' CASE ( 12 ) ; cmm='DEC' END SELECT WRITE(ctim_unit, '("seconds since ",a,i3.2,":",i2.2,":",i2.2 )') TRIM(cldate), ihr_init, imn_init, isec_init WRITE(ctim_origin,'(i5,"-",a,"-",i2.2," ",i2.2,":",i2.2,":",i2.2)') iyr_init,cmm, idd_init, ihr_init, imn_init, isec_init PRINT *, " ",TRIM(cn_vtimec)," units set to : ", TRIM(ctim_unit) PRINT *, " ",TRIM(cn_vtimec)," time origin set to : ", TRIM(ctim_origin) ! Compute corresponding jcnes rdaycnes=jcnes(ctag) rseconds=(rdaycnes - rday0 +1 ) * 86400. ! Modify cdfile !! CAUTION : Original file will be modified !! IF ( .NOT. lkeep ) THEN ierr = putvar1d( cf_in, cn_vtimec, rseconds, 1 ) ENDIF ierr = atted ( cf_in, cn_vtimec, 'units', ctim_unit ) ierr = atted ( cf_in, cn_vtimec, 'time_origin', ctim_origin) CONTAINS REAL(KIND=4) FUNCTION jcnes(cdtag) !!--------------------------------------------------------------------- !! *** FUNCTION jcnes *** !! !! ** Purpose : return the JCNES corresponding to time tag. JCNES is a julian !! day refered from 1950-01-01 !! !! ** Method : Interface with function julday !! !!---------------------------------------------------------------------- CHARACTER(LEN=*),INTENT(in) :: cdtag INTEGER(KIND=4) :: iyear, imon, iday REAL(KIND=4) :: zsec = 0. REAL(KIND=4) :: zjuldeb, zjulfin, zjulday READ(cdtag,'(1x,i4.4,1x,i2.2,1x,i2.2)') iyear, imon, iday zsec=0. !--------------------------------------------------------------------- zjulfin = julday(iyear, imon, iday, zsec) zjuldeb = julday(1950, 01, 01, 0.) jcnes = zjulfin - zjuldeb END FUNCTION jcnes REAL(KIND=4) FUNCTION julday(kyear, kmonth, kday, psec) !!--------------------------------------------------------------------- !! *** FUNCTION julday *** !! !! ** Purpose : Converts year, month, day and seconds into a julian day !! !! ** Method : In 1968 in a letter to the editor of Communications of !! the ACM (CACM, volume 11, number 10, October 1968, p.657) !! Henry F. Fliegel and Thomas C. Van Flandern presented !! such an algorithm. !! In the case of the Gregorian calendar we have chosen !! to use the Lilian day numbers. This is the day counter !! which starts on the 15th October 1582. !! This is the day at which Pope Gregory XIII introduced the !! Gregorian calendar. !! Compared to the true Julian calendar, which starts some !! 7980 years ago, the Lilian days are smaller and are dealt !! with easily on 32 bit machines. With the true Julian days !! you can only the fraction of the day in the real part to !! a precision of a 1/4 of a day with 32 bits. !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kyear, kmonth, kday ! input date REAL(KIND=4), INTENT(in) :: psec ! input seconds REAL(KIND=4), PARAMETER :: pp_one_day = 86400.0 INTEGER(KIND=4), PARAMETER :: jp_mon_len(12)=(/31,28,31,30,31,30,31,31,30,31,30,31/) INTEGER(KIND=4) :: in_m, in_y, in_d INTEGER(KIND=4) :: ijd, iml !--------------------------------------------------------------------- in_m = kmonth in_y = kyear in_d = kday !- We deduce the calendar from the length of the year as it !- is faster than an INDEX on the calendar variable. !- !- Gregorian IF ( (rpp_one_year > 365.0) .AND. (rpp_one_year < 366.0) ) THEN ijd = (1461*(in_y+4800+INT(( in_m-14 )/12)))/4 & & +(367*(in_m-2-12*(INT(( in_m-14 )/12))))/12 & & -(3*((in_y+4900+INT((in_m-14)/12))/100))/4 & & +in_d-32075 ijd = ijd-2299160 !- No leap or All leap ELSE IF (ABS(rpp_one_year-365.0) <= EPSILON(rpp_one_year) .OR. & & ABS(rpp_one_year-366.0) <= EPSILON(rpp_one_year)) THEN iml = SUM(jp_mon_len(1:in_m-1)) ijd = in_y*INT(rpp_one_year)+iml+(in_d-1) !- Calendar with regular month ! ELSE ! iml = INT(one_year)/12 ! ijd = y*INT(one_year)+(m-1)*iml+(d-1) ENDIF !- julday = ijd + psec / pp_one_day END FUNCTION julday SUBROUTINE caldatjm( pjcnes, ky, km, kd, kh, kmn, ksec ) !!--------------------------------------------------------------------- !! *** ROUTINE caldatjm *** !! !! ** Purpose : Compute the calendar date from the julian CNES day !! given as input !! !! ** Method : Take care of the leap/noleap calendar. That's why we !! cannot use the standard caldat from numerical recipe !!---------------------------------------------------------------------- REAL(KIND=4), INTENT(in) :: pjcnes INTEGER(KIND=4), INTENT(out) :: ky, km, kd, kh, kmn, ksec INTEGER(KIND=4) :: jd, jm ! dummy loop index INTEGER(KIND=4) :: isec, idays INTEGER(KIND=4), DIMENSION(12) :: indays=(/31,28,31,30,31,30,31,31,30,31,30,31/) INTEGER(KIND=4), DIMENSION(12) :: icumul !!-------------------------------------------------------------------------------- ! initialize the cumulated time icumul(1) = indays(1) DO jm=2,12 icumul(jm) = icumul(jm-1) + indays(jm) ENDDO ! look for time part of pjcnes isec = (pjcnes-INT(pjcnes) ) * 86400. kh = isec/3600 kmn = (isec - kh * 3600 )/60 ksec = isec - kh * 3600 - kmn * 60 ! number of years since 1950 IF ( lnoleap ) THEN ! no leap years ky=1950 + INT(pjcnes)/365 idays= ( INT(pjcnes)/ 365. - INT(pjcnes)/365 )* 365 km=1 ; kd=0 DO jd=1, idays IF ( jd > icumul(km) ) THEN km=km+1 kd=1 ELSE kd=kd+1 ENDIF ENDDO ELSE ! use caldat from Numerical Recipe CALL caldat_nr ( pjcnes, ky, km, kd, kh, kmn, ksec ) ENDIF END SUBROUTINE caldatjm SUBROUTINE caldat_nr( pjcnes, kiyyy, kmm, kid, kh, kmn, ksec ) !!--------------------------------------------------------------------- !! *** ROUTINE caldat_nr *** !! !! ** Purpose : This routine convert a julian day in calendar date. !! !! ** Method : This routine comes directly from the Numerical Recipe Book, !! !! Arguments !! kjulian : input julian day number !! kmm : output, corresponding month !! kid : output, corresponding day !! kiyyy : output, corresponding year, positive IF a.d, negative b.c. !! !! References : Numerical Recipe Book, Press et al., numerical recipes, !! cambridge univ. press, 1986. !!---------------------------------------------------------------------- IMPLICIT NONE REAL(KIND=4), INTENT(in) :: pjcnes INTEGER(KIND=4), INTENT(out) :: kiyyy, kmm, kid, kh, kmn, ksec ! * Local INTEGER(KIND=4), PARAMETER :: jpgreg = 2299161 INTEGER(KIND=4) :: ijulian INTEGER(KIND=4) :: ia, ialpha, ib, ic, id, ie, isec REAL(KIND=4) :: zjul1950 !!---------------------------------------------------------------------- ! look for time part of pjcnes isec = (pjcnes-INT(pjcnes) ) * 86400. kh = isec/3600 kmn = (isec - kh * 3600 )/60 ksec = isec - kh * 3600 - kmn * 60 zjul1950 = julday_nr( 01, 01, 1950) ijulian = INT(pjcnes + zjul1950) ! IF ( ijulian >= jpgreg) THEN ialpha = INT ((( ijulian - 1867216) - 0.25)/36524.25 ) ia = ijulian +1 + ialpha -INT (0.25*ialpha) ELSE ia = ijulian END IF ! ib = ia + 1524 ic = INT (6680. + (( ib -2439870) - 122.1)/365.25 ) id = 365* ic + INT (0.25*ic) ie = INT (( ib - id )/30.6001) ! kid = ib - id - INT (30.6001*ie) kmm = ie -1 IF ( kmm > 12 ) kmm = kmm - 12 kiyyy = ic - 4715 IF ( kmm > 2 ) kiyyy = kiyyy - 1 IF ( kiyyy <= 0 ) kiyyy = kiyyy - 1 END SUBROUTINE caldat_nr INTEGER(KIND=4) FUNCTION julday_nr(kmm,kid,kiyyy) !!--------------------------------------------------------------------- !! *** FUNCTION julday_nr *** !! !! ** Purpose : his routine returns the julian day number which begins at noon !! of the calendar date specified by month kmm, day kid, and year kiyyy. !! positive year signifies a.d.; negative, b.c. (remember that the !! year after 1 b.c. was 1 a.d.) !! routine handles changeover to gregorian calendar on oct. 15, 1582. !! !! ** Method: This routine comes directly from the Numerical Recipe Book, !! !!---------------------------------------------------------------------- INTEGER, INTENT(in) :: kiyyy INTEGER, INTENT(in) :: kmm, kid ! * Local INTEGER, PARAMETER ::jpgreg=15+31*(10+12*1582) INTEGER ::ky, iy, im, ia !!---------------------------------------------------------------------- ky = kiyyy ! ... Year 0 never existed ... IF (ky == 0) STOP 101 ! IF (ky < 0) ky = ky + 1 IF (kmm > 2) THEN iy = ky im = kmm + 1 ELSE iy = ky - 1 im = kmm + 13 END IF ! julday_nr = INT(365.25*iy) + INT(30.6001*im) + kid + 1720995 IF (kid+31*(kmm+12*ky).GE.jpgreg) THEN ia = INT(0.01*iy) julday_nr = julday_nr + 2 - ia + INT(0.25*ia) END IF END FUNCTION julday_nr END PROGRAM cdffixtime cdftools-3.0/cdfmocsig.f900000644000175000017500000004364712241227304016614 0ustar amckinstryamckinstryPROGRAM cdfmocsig !!====================================================================== !! *** PROGRAM cdfmocsig *** !!===================================================================== !! ** Purpose : Compute the Meridional Overturning Cell (MOC) !! using density bins. !! !! ** Method : The MOC is computed from the V velocity field, collected in density bins, !! (reference depth is given as the 3rd argument) and integrated !! throughout the density bins, then zonally averaged with !! eventual masking for oceanic basins. !! In the present version the masking corresponds to the global !! configuration. MOC for Global, Atlantic, Indo-Pacific, Indian,Pacific ocean !! Results are saved on mocsig.nc file with variables name respectively !! zomsfglo, zomsfatl, zomsfinp, zomsfind, zomsfpac. !! If no new_maskglo.nc file found, then the mask.nc file is used and !! only zomsfglo is computed. !! !! History : 2.1 : 11/2005 : A.M. Treguier : Original code from cdfmoc !! : 03/2010 : C. Dufour : Choice of depth reference !! improvements !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames USE modutils !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=2), DIMENSION (:,:,:), ALLOCATABLE :: ibmask ! nbasins x npiglo x npjglo INTEGER(KIND=2), DIMENSION (:,:), ALLOCATABLE :: itmask ! tmask from salinity field INTEGER(KIND=4) :: jbasin, jj, jk ! dummy loop index INTEGER(KIND=4) :: ji, jt, jbin ! dummy loop index INTEGER(KIND=4) :: nbins ! number of density bins INTEGER(KIND=4) :: npglo, npatl, npinp ! basins index (mnemonics) INTEGER(KIND=4) :: npind, nppac ! " " INTEGER(KIND=4) :: nbasins ! number of basins INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, iarg ! command line browsing INTEGER(KIND=4) :: ijarg, ii ! " " INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(2) :: iloc ! working array INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! output variable levels and id INTEGER(KIND=4), DIMENSION (:,:), ALLOCATABLE :: ibin ! remaping density in bin number REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, gphiv ! horizontal metrics, latitude REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zt, zs ! temperature, salinity REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zv, zveiv ! velocity and bolus velocity REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3v ! vertical metrics REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: rdumlon ! dummy longitude = 0. REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: rdumlat ! latitude for i = north pole REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zttmp ! arrays to call sigmai and mask it REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: sigma ! density coordinate REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: e31d ! vertical level (full step) REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: tim ! time counter REAL(KIND=4) :: pref=0. ! depth reference for pot. density REAL(KIND=4) :: sigmin ! minimum density for bining REAL(KIND=4) :: sigstp ! density step for bining REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc ! nbasins x npjglo x npk REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dens ! density REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmoc_tmp ! temporary transport array CHARACTER(LEN=256) :: cf_vfil ! meridional velocity file CHARACTER(LEN=256) :: cf_tfil ! temperature/salinity file CHARACTER(LEN=256) :: cf_moc='mocsig.nc' ! output file CHARACTER(LEN=255) :: cglobal ! Global attribute CHARACTER(LEN=256) :: cldum ! dummy char variable TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! output var properties LOGICAL, DIMENSION(3) :: lbin ! flag for bin specifications LOGICAL :: lbas = .FALSE. ! flag for basins file LOGICAL :: lprint = .FALSE. ! flag for extra print LOGICAL :: leiv = .FALSE. ! flag for Eddy Induced Velocity (GM) LOGICAL :: lfull = .FALSE. ! flag for full step LOGICAL :: lchk = .FALSE. ! flag for missing file !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmocsig V_file T_file depth_ref [-eiv] [-full] ... ' PRINT *,' ... [-sigmin sigmin] [-sigstp sigstp] [-nbins nbins] [-v] ' PRINT *,' PURPOSE : ' PRINT *,' Computes the MOC in density-latitude coordinates. The global value' PRINT *,' is always computed. Values for oceanic sub-basins are calculated' PRINT *,' if the file ', TRIM(cn_fbasins), ' is provided.' PRINT *,' Last arguments is the reference depth for potential density, in m.' PRINT *,' Actually only 0 1000 or 2000 are available with standard values for' PRINT *,' density bins. If you specify another reference depth, you must also' PRINT *,' specify the minimum density, the bin size and the number of bins,' PRINT *,' with the options -sigmin, -sigstp, -nbins' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' V_file : Netcdf gridV file' PRINT *,' T_file : Netcdf gridT file' PRINT *,' depth_ref : reference depth for density ' PRINT *,' for depth values of 0 1000 or 2000, pre-defined limits for' PRINT *,' minimum density, number of density bins and width of density' PRINT *,' bins are provided. For other reference depth, you must use' PRINT *,' -sigmin, -sigstp and -nbins options (see below).' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-eiv ] : takes into account VEIV Meridional eddy induced velocity' PRINT *,' -> To be used only if Gent and McWilliams parameterization ' PRINT *,' has been used ' PRINT *,' [ -full ] : Works with full step instead of standard partial steps' PRINT *,' [ -sigmin ] : Specify minimum of density for bining' PRINT *,' [ -sigstp ] : Specify density step for bining' PRINT *,' [ -nbins ] : Specify the number of density bins you want' PRINT *,' [ -v ] : Verbose option for more info during execution' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' Files ', TRIM(cn_fzgr),', ',TRIM(cn_fhgr),', ', TRIM(cn_fmsk) PRINT *,' File ', TRIM(cn_fbasins),' is optional [sub basins masks]' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_moc) PRINT *,' variables ',TRIM( cn_zomsfglo),' : Global ocean ' PRINT *,' variables ',TRIM( cn_zomsfatl),' : Atlantic Ocean ' PRINT *,' variables ',TRIM( cn_zomsfinp),' : Indo Pacific ' PRINT *,' variables ',TRIM( cn_zomsfind),' : Indian Ocean alone' PRINT *,' variables ',TRIM( cn_zomsfpac),' : Pacific Ocean alone' PRINT *,' If file ',TRIM(cn_fbasins),' is not present, ',TRIM(cn_fmsk),' file' PRINT *,' is used and only ',TRIM( cn_zomsfglo),' is produced.' STOP ENDIF cglobal = 'Partial step computation' lbin=(/.TRUE.,.TRUE.,.TRUE./) ijarg = 1 ; ii = 0 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE ('-full') lfull = .TRUE. cglobal = 'Full step computation' CASE ('-eiv') leiv = .TRUE. CASE ('-sigmin') CALL getarg (ijarg, cldum) ; ijarg=ijarg+1 ; READ(cldum,*) sigmin lbin(1) = .FALSE. CASE ('-nbins') CALL getarg (ijarg, cldum) ; ijarg=ijarg+1 ; READ(cldum,*) nbins lbin(2) = .FALSE. CASE ('-sigstp') CALL getarg (ijarg, cldum) ; ijarg=ijarg+1 ; READ(cldum,*) sigstp lbin(3) = .FALSE. CASE ('-v') lprint = .TRUE. CASE DEFAULT ii=ii+1 SELECT CASE (ii) CASE ( 1 ) ; cf_vfil = cldum CASE ( 2 ) ; cf_tfil = cldum CASE ( 3 ) ; READ(cldum,*) pref CASE DEFAULT STOP 'ERROR : Too many arguments ...' END SELECT END SELECT END DO ! check file existence lchk = lchk .OR. chkfile ( cn_fhgr ) lchk = lchk .OR. chkfile ( cn_fzgr ) lchk = lchk .OR. chkfile ( cn_fmsk ) lchk = lchk .OR. chkfile ( cf_vfil ) lchk = lchk .OR. chkfile ( cf_tfil ) IF ( lchk ) STOP ! missing file(s) ! re-use lchk for binning control : TRUE if no particular binning specified lchk = lbin(1) .OR. lbin(2) .OR. lbin(3) npiglo = getdim (cf_vfil,cn_x) npjglo = getdim (cf_vfil,cn_y) npk = getdim (cf_vfil,cn_z) npt = getdim (cf_vfil,cn_t) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt !setting up the building command in global attribute CALL SetGlobalAtt(cglobal, 'A') ! append command name to global attribute ! Detects newmaskglo file lbas = .NOT. chkfile (cn_fbasins ) IF (lbas) THEN nbasins = 5 ELSE nbasins = 1 ENDIF ALLOCATE ( stypvar(nbasins), ipk(nbasins), id_varout(nbasins) ) IF ( lchk ) THEN ! use default bins definition according to pref ! Define density parameters SELECT CASE ( INT(pref) ) CASE ( 0 ) nbins = 52 sigmin = 23. sigstp = 0.1 CASE ( 1000 ) nbins = 88 sigmin = 24. sigstp = 0.1 CASE ( 2000) nbins = 158 sigmin = 30. sigstp = 0.05 CASE DEFAULT PRINT *,' This value of depth_ref (',pref,') is not implemented as standard' PRINT *,' You must use the -sigmin, -sigstp and -nbins options to precise' PRINT *,' the density bining you want to use.' STOP END SELECT ENDIF PRINT '(a,f6.1,a)', ' For reference depth ', pref, ' m, ' PRINT '(a,f5.2,a,f5.2,a,i3)', ' You are using -sigmin ', sigmin,' -sigstp ', sigstp,' -nbins ', nbins ALLOCATE ( sigma(nbins) ) ! define densities at middle of bins DO ji=1,nbins sigma(ji) = sigmin +(ji-0.5)*sigstp ENDDO IF (lprint) PRINT *, ' min density:',sigma(1), ' max density:', sigma(nbins) !global ; Atlantic ; Indo-Pacif ; Indian ; Pacif npglo= 1 ; npatl=2 ; npinp=3 ; npind=4 ; nppac=5 ! Common to all variables : stypvar%cunits = 'Sverdrup' stypvar%rmissing_value = 99999. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%scale_factor = 1. stypvar%add_offset = 0. stypvar%savelog10 = 0. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TZY' ipk(:) = npk ! Global basin stypvar(npglo)%cname = cn_zomsfglo stypvar(npglo)%clong_name = 'Meridional_Overt.Cell_Global' stypvar(npglo)%cshort_name = cn_zomsfglo IF (lbas) THEN stypvar(npatl)%cname = cn_zomsfatl stypvar(npatl)%clong_name = 'Meridional_Overt.Cell_Atlantic' stypvar(npatl)%cshort_name = cn_zomsfatl stypvar(npinp)%cname = cn_zomsfinp stypvar(npinp)%clong_name = 'Meridional_Overt.Cell_IndoPacif' stypvar(npinp)%cshort_name = cn_zomsfinp stypvar(npind)%cname = cn_zomsfind stypvar(npind)%clong_name = 'Meridional_Overt.Cell_Indian' stypvar(npind)%cshort_name = cn_zomsfind stypvar(nppac)%cname = cn_zomsfpac stypvar(nppac)%clong_name = 'Meridional_Overt.Cell_pacif' stypvar(nppac)%cshort_name = cn_zomsfpac ENDIF ! Allocate arrays ALLOCATE ( ibmask(nbasins,npiglo,npjglo) ) ALLOCATE ( zv (npiglo,npjglo), zt(npiglo,npjglo), zs(npiglo,npjglo)) ALLOCATE ( e3v(npiglo,npjglo) ) ALLOCATE ( ibin(npiglo, npjglo) ) ALLOCATE ( e1v(npiglo,npjglo), gphiv(npiglo,npjglo) ) ALLOCATE ( dmoc(nbasins, npjglo, nbins) ) ALLOCATE ( dmoc_tmp(nbins,npiglo) ) ALLOCATE ( rdumlon(1,npjglo) , rdumlat(1,npjglo)) ALLOCATE ( dens(npiglo,npjglo)) ALLOCATE ( itmask(npiglo,npjglo), zttmp(npiglo,npjglo)) ALLOCATE ( tim(npt), e31d(npk) ) IF ( leiv ) THEN ALLOCATE ( zveiv (npiglo,npjglo)) END IF e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo) gphiv(:,:) = getvar(cn_fhgr, cn_gphiv, 1, npiglo, npjglo) IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk) iloc = MAXLOC(gphiv) rdumlat(1,:) = gphiv(iloc(1),:) rdumlon(:,:) = 0. ! set the dummy longitude to 0 ! create output fileset ! ncout = create (cf_moc, cf_vfil, 1, npjglo, nbins, cdep='sigma') ncout = create (cf_moc, 'none', 1, npjglo, nbins, cdep='sigma') ierr = createvar (ncout, stypvar, nbasins, ipk ,id_varout, cdglobal=cglobal) ierr = putheadervar(ncout, cf_vfil, 1, npjglo, nbins, pnavlon=rdumlon, pnavlat=rdumlat, pdep=sigma) tim = getvar1d(cf_vfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ! reading the masks ibmask(npglo,:,:) = getvar(cn_fmsk, 'vmask', 1, npiglo, npjglo) IF ( lbas ) THEN ibmask(npatl,:,:) = getvar(cn_fbasins, 'tmaskatl', 1, npiglo, npjglo) ibmask(npind,:,:) = getvar(cn_fbasins, 'tmaskind', 1, npiglo, npjglo) ibmask(nppac,:,:) = getvar(cn_fbasins, 'tmaskpac', 1, npiglo, npjglo) ibmask(npinp,:,:) = ibmask(nppac,:,:) + ibmask(npind,:,:) ! ensure that there are no overlapping on the masks WHERE(ibmask(npinp,:,:) > 0 ) ibmask(npinp,:,:) = 1 ! change global mask for GLOBAL periodic condition ibmask(1,1, :) = 0. ibmask(1,npiglo,:) = 0. ENDIF DO jt=1, npt ! initialize moc to 0 dmoc(:,:,:) = 0.d0 DO jk=1,npk-1 ! for testing purposes only loop from 2 to 400 IF (lprint) PRINT *,' working at depth ',jk ! Get velocities v at jj zv(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo) IF ( leiv ) THEN zveiv(:,:) = getvar(cf_vfil, cn_vomeeivv, jk, npiglo,npjglo) zv(:,:) = zv(:,:) + zveiv(:,:) END IF zt(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo) zs(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo) ! get e3v at latitude jj IF ( lfull ) THEN e3v(:,:) = e31d(jk) ELSE e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF ! ! finds density itmask = 1 WHERE ( zs == 0 ) itmask = 0 dens = sigmai(zt, zs, pref, npiglo, npjglo) zttmp = dens* itmask ! convert to single precision ! find bin numbers ibin(:,:) = INT( (zttmp-sigmin)/sigstp ) ibin(:,:) = MAX( ibin(:,:), 1 ) ibin(:,:) = MIN( ibin(:,:), nbins) DO jj=2,npjglo-1 dmoc_tmp = 0 ! converts transport in "k" to transport in "sigma" ! indirect adresssing - do it once and not for each basin! DO ji=2,npiglo-1 dmoc_tmp(ibin(ji,jj),ji)=dmoc_tmp(ibin(ji,jj),ji) - e1v(ji,jj)*e3v(ji,jj)*zv(ji,jj) END DO ! integrates 'zonally' (along i-coordinate) ! add to dmoc the contributions from level jk at all densities jbin DO jbin =1,nbins DO ji=2,npiglo-1 DO jbasin= 1, nbasins ! For all basins dmoc(jbasin,jj,jbin)=dmoc(jbasin,jj,jbin ) + dmoc_tmp(jbin,ji) * ibmask(jbasin,ji,jj) ENDDO END DO END DO ! end of loop on latitude for filling dmoc END DO ! end of loop on depths for calculating transports END DO ! integrates across bins from highest to lowest density dmoc(:,:,nbins) = dmoc(:,:,nbins)/1.e6 DO jk=nbins-1, 1, -1 dmoc(:,:,jk) = dmoc(:,:,jk+1) + dmoc(:,:,jk)/1.e6 END DO ! loop to next bin ! netcdf output DO jbasin = 1, nbasins DO jk = 1, nbins ierr = putvar (ncout, id_varout(jbasin), REAL(dmoc(jbasin,:,jk)), jk, 1, npjglo) END DO END DO ENDDO ! time loop ierr = closeout(ncout) END PROGRAM cdfmocsig cdftools-3.0/cdfnamelist.f900000644000175000017500000001040612241227304017132 0ustar amckinstryamckinstryPROGRAM cdfnamelist !!====================================================================== !! *** PROGRAM cdfnamelist *** !!===================================================================== !! ** Purpose : Give informations on the namelist mechanism implemented !! in CDFTOOLS_3. !! Write a template namelist for CDFTOOLS_3.0, usefull !! to change default file names, variable or dimension !! names. !! !! ** Method : !! !! History : 3.0 : 01/2011 : J.M. Molines : Original code !!---------------------------------------------------------------------- USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: narg, iargc, ijarg CHARACTER(LEN=80) :: cldum !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfnamelist [-i] [-p]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Give information [-i option] on the namelist mechanism implemented' PRINT *,' in CDFTOOLS v3. Write a namelist template [-p option ] to initialize' PRINT *,' the mechanism.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' none' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -i ] : print informations ' PRINT *,' [ -p ] : write a template namelist.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' with option -p, print a template namelist : PrintCdfNames.namlist' PRINT *,' ' STOP ENDIF ijarg = 1 DO WHILE ( ijarg <= narg ) CALL getarg( ijarg, cldum ) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-i' ) CALL InfoUseNamelist() CASE ( '-p' ) CALL PrintCdfNames() CASE DEFAULT PRINT *, TRIM(cldum),' : unknown option in cdfnamelist ' END SELECT END DO CONTAINS SUBROUTINE InfoUseNamelist() !!--------------------------------------------------------------------- !! *** ROUTINE InfoUseNamelist *** !! !! ** Purpose : Print detailed info on the use of namelist in !! CDFTOOLS_3.0 !! !!---------------------------------------------------------------------- PRINT *,' In CDFTOOLS_3 the variable names, dimension names, mesh_mask' PRINT *,' file names can be customized via a system of namelist.' PRINT *,' A call to ReadCdfNames at the begining of the program allows' PRINT *,' the update of the names used in the program.' PRINT *,' If there is no need for changing names, then it is not necessary' PRINT *,' to give a namelist, the default values are OK.' PRINT *,' ' PRINT *,' If you need to change any of the default values, then you can' PRINT *,' use the namelist system to make this change effective. Doing do' PRINT *,' some rules are to be followed for proper use.' PRINT *,' ' PRINT *,'NAMELIST EDITING' PRINT *,' To have a template of a CDFTOOLS_3 namelist, use the statement' PRINT *,' cdfnamelist -p ' PRINT *,' This will give you a template namelist (PrintCdfNames.namlist)' PRINT *,' that you have to customized for your application.' PRINT *,' Some comments are made within this namelist for particular blocks.' PRINT *,' ' PRINT *,'NAME AND LOCATION OF THE NAMELIST' PRINT *,' The default name of the namelist read by ReadCdfNames is ' PRINT *,' nam_cdf_names' PRINT *,' ReadCdfNames look for the namelist in the current directory (./)' PRINT *,' and, if not found there, in the $HOME/CDFTOOLS_cfg/ directory' PRINT *,' The name of the namelist can be changed setting the environment' PRINT *,' variable NAM_CDF_NAMES to the desired value.' PRINT *,' ' END SUBROUTINE InfoUseNamelist END PROGRAM cdfnamelist cdftools-3.0/cdfmxlhcsc.f900000644000175000017500000003234612241227304016766 0ustar amckinstryamckinstryPROGRAM cdfmxlhcsc !!====================================================================== !! *** PROGRAM cdfmxlhcsc *** !!===================================================================== !! ** Purpose : Compute mixed layer depth and the heat and salt contents !! in the mixed layer. There is an option to limit this !! computation between hmin and ml depth. For that, hmin is !! given as last argument (>0) with no arguments, hmin is !! supposed to be 0. !! !! ** Method : This program is a merge of cdfmxl, cdfmxlheatc and !! cdfmxlsaltc. !! MXL computation: !! - compute surface properties !! - initialize depths and model levels number !! - from bottom to top compute rho and !! check if rho > rho_surf +rho_c, where rho_c is a !! density criteria given as argument !! Heat Content and Salt Content: !! HC = sum ( rho cp T * e1 * e2 * e3 * tmask ) !! SC = sum ( rho S * e1 * e2 * e3 * tmask ) !! where the sum is limited to the MXL, between hmin and !! MLD !! !! History : 2.1 : 04/2007 : M. Juza : Merging of the programs !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: ik ! level indirect index INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: npiglo, npjglo ! domain size INTEGER(KIND=4) :: npk, npt ! domaine size INTEGER(KIND=4) :: ncout, ierr ! ncid of output file an error status INTEGER(KIND=4), DIMENSION(3) :: ipk, id_varout ! levels and varid's of output vars INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mbathy ! number of w levels in water <= npk INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmln ! last level where rho > rho + val_crit ! or rtem > rtem + val_crit REAL(KIND=4), PARAMETER :: rprho0=1020. ! reference density REAL(KIND=4), PARAMETER :: rpcp=4000. ! specific heat of water REAL(KIND=4) :: val ! criteria value REAL(KIND=4) :: hmin = 0. ! minimum depth for vertical integration REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth output REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of w points REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics (full step) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rtem ! temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rsal ! salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rho ! density (sigma-0) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rho_surf ! surface density REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tem_surf ! surface temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmld ! mixed layer depth REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask_surf ! surface tmask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! land sea mask of temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! vertical metrics REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmxlheatc ! mxl heat content REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmxlsaltc ! mxl salt content TYPE(variable), DIMENSION(3) :: stypvar ! output attributes CHARACTER(LEN=256) :: cf_tfil ! input file CHARACTER(LEN=256) :: cf_out='mxlhcsc.nc' ! output file CHARACTER(LEN=256) :: criteria ! type of criteria used for mld CHARACTER(LEN=256) :: cldum ! dummy string LOGICAL :: lchk ! flag for missing files LOGICAL :: lfull=.FALSE. ! flag for full step !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmxlhcsc T-file criteria value [hmin]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the mixed layer depth, the heat content and salt content.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf input file for temperature and salinity (gridT).' PRINT *,' criteria : one of temperature, t, T for temperature criteria.' PRINT *,' or density, d, D for density criteria.' PRINT *,' value : value of the criteria (eg: 0.2 for temp, 0.01 or 0.03 for dens)' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ hmin ] : limit the vertical integral from hmin to mld. By default, ' PRINT *,' hmin is set to 0 so that the integral is performed on the' PRINT *,' whole mixed layer.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),' ',TRIM(cn_fzgr),' and ',TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : - somxl010 (mld based on density criterium 0.01)' PRINT *,' (2D) or somxl030 (mld on density criterium 0.03)' PRINT *,' or somxlt02 (mld on temperature criterium -0.2)' PRINT *,' - somxlheatc (heat content computed in the MLD)' PRINT *,' - somxlsaltc (salt content computed in the MLD)' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfmxl, cdfmxlheatc and cdfmxlsaltc.' PRINT *,' ' STOP ENDIF CALL getarg (1, cf_tfil ) CALL getarg (2, criteria ) CALL getarg (3, cldum ) ; READ(cldum,*) val IF ( narg == 4 ) THEN ; CALL getarg (4, cldum) ; READ(cldum,*) hmin ; ENDIF lchk = chkfile (cn_fhgr) lchk = chkfile (cn_fzgr) .OR. lchk lchk = chkfile (cn_fmsk) .OR. lchk lchk = chkfile (cf_tfil) .OR. lchk IF ( lchk ) STOP ! missing files ! read dimensions npiglo = getdim (cf_tfil, cn_x) npjglo = getdim (cf_tfil, cn_y) npk = getdim (cf_tfil, cn_z) npt = getdim (cf_tfil, cn_t) rdep(1) = 0. ipk(:) = 1 ! Variable Mixed Layer Depth SELECT CASE ( criteria) ! CASE ( 'Temperature', 'temperature', 't', 'T' ) WRITE(cldum,'(a,i2.2)' ) 'somxlt', INT(ABS(val)*10) ! CASE ( 'Density', 'density', 'd', 'D' ) WRITE(cldum,'(a,i3.3)' ) 'somxl', INT((val)*1000) ! CASE DEFAULT PRINT *,TRIM(criteria),' : criteria not understood' STOP END SELECT stypvar(1)%cname = TRIM(cldum) stypvar(1)%cshort_name = TRIM(cldum) stypvar(1)%cunits = 'm' stypvar(1)%clong_name = 'Mixed Layer Depth' ! Variable Heat Content stypvar(2)%cname = 'somxlheatc' stypvar(2)%cunits = '10^9 J/m2' stypvar(2)%clong_name = 'Mixed_Layer_Heat_Content' stypvar(2)%cshort_name = 'somxlheatc' ! Variable Salt Content stypvar(3)%cname = 'somxlsaltc' stypvar(3)%cunits = '10^6 kg/m2' stypvar(3)%clong_name = 'Mixed_Layer_Salt_Content' stypvar(3)%cshort_name = 'somxlsaltc' ! Allocate arrays ALLOCATE (rtem(npiglo,npjglo),rsal(npiglo,npjglo) ) ALLOCATE (tmask(npiglo,npjglo),tmask_surf(npiglo,npjglo) ) ALLOCATE (mbathy(npiglo,npjglo) ) ALLOCATE (nmln(npiglo,npjglo),hmld(npiglo,npjglo) ) ALLOCATE (dmxlheatc(npiglo,npjglo),dmxlsaltc(npiglo,npjglo)) ALLOCATE (e3(npiglo,npjglo) ) ALLOCATE (gdepw(0:npk), tim(npt) ) ! read mbathy and gdepw use real rtem(:,:) as template (getvar is used for real only) INQUIRE (FILE=cn_fbathylev, EXIST=lfull) IF ( lfull ) THEN rtem(:,:) = getvar(cn_fbathylev, cn_bathylev, 1, npiglo, npjglo) ALLOCATE ( e31d(npk) ) ELSE rtem(:,:) = getvar(cn_fzgr, 'mbathy', 1, npiglo, npjglo) ENDIF mbathy(:,:) = rtem(:,:) gdepw(0) = 999999. ! dummy values normaly always masked gdepw(1:npk) = getvare3(cn_fzgr, cn_gdepw, npk) IF ( lfull ) e31d = getvare3(cn_fzgr, cn_ve3t, npk ) ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, 3, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=rdep) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jt = 1, npt ! major time loop ! MXL computation !--------------- ! Initialization to the number of w ocean point mbathy nmln(:,:) = mbathy(:,:) ! read surface tmask tmask_surf(:,:) = getvar(cn_fmsk, 'tmask', 1, npiglo, npjglo) SELECT CASE ( criteria ) ! CASE ( 'temperature', 'Temperature', 'T', 't' ) ! Temperature criteria ! temp_surf IF (.NOT. ALLOCATED ( tem_surf) ) ALLOCATE (tem_surf(npiglo,npjglo)) tem_surf(:,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt ) ! Last w-level at which ABS(rtem-tem_surf)>=ABS(val) (starting from jpk-1) ! (rtem defined at t-point, thus jk-1 for w-level just above) DO jk = npk-1, 2, -1 rtem(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) WHERE ( ABS(rtem - tem_surf) > ABS(val) ) nmln = jk ENDDO ! CASE ( 'density', 'Density', 'D', 'd' ) ! Density criteria ! compute rho_surf IF ( .NOT. ALLOCATED( rho_surf ) ) ALLOCATE (rho_surf(npiglo,npjglo) ) IF ( .NOT. ALLOCATED( rho ) ) ALLOCATE (rho (npiglo,npjglo) ) rtem(:,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt) rsal(:,:) = getvar(cf_tfil, cn_vosaline, 1, npiglo, npjglo, ktime=jt) rho_surf(:,:) = sigma0 (rtem, rsal, npiglo, npjglo )* tmask_surf(:,:) ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1) ! (rhop defined at t-point, thus jk-1 for w-level just above) DO jk = npk-1, 2, -1 rtem( :,:) = getvar(cf_tfil, cn_votemper, jk ,npiglo, npjglo, ktime=jt) rsal( :,:) = getvar(cf_tfil, cn_vosaline, jk ,npiglo, npjglo, ktime=jt) tmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo ) rho( :,:) = sigma0 (rtem, rsal, npiglo, npjglo ) * tmask(:,:) WHERE ( rho > rho_surf + val ) nmln = jk ENDDO ! CASE DEFAULT PRINT *,' ERROR: Criterium on ', TRIM(criteria),' not suported' ; STOP ! END SELECT !! Determine mixed layer depth DO jj = 1, npjglo DO ji = 1, npiglo ik = nmln(ji,jj) hmld (ji,jj) = gdepw(ik) * tmask_surf(ji,jj) ENDDO ENDDO !!Compute heat and salt contents in the mixed layer depth !!------------------------------------------------------- !! dmxlheatc(:,:) = 0.d0 dmxlsaltc(:,:) = 0.d0 DO jk = 1,npk ! Get temperature and salinity at jk rtem(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) rsal(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) tmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo ) IF ( lfull ) THEN e3(:,:) = e31d(jk) ELSE ! Get e3 at level jk (ps...) e3(:,:) = getvar(cn_fzgr, 'e3t_ps', jk ,npiglo, npjglo, ldiom=.TRUE.) ENDIF ! e3 is used as a flag for the mixed layer; it is 0 outside the mixed layer e3(:,:) = MAX(0., MIN(e3, hmld-gdepw(jk) ) + MIN(e3, gdepw(jk)+ e3-hmin) - e3) ! Heat and salt contents dmxlheatc(:,:) = dmxlheatc(:,:) + rtem * e3 * tmask *1.d0 dmxlsaltc(:,:) = dmxlsaltc(:,:) + rsal * e3 * tmask *1.d0 END DO !! Heat and salt contents (10^9.J/m2 and 10^6.kg/m2) dmxlheatc = dmxlheatc *rprho0 *rpcp * 1.d-9 dmxlsaltc = dmxlsaltc *rprho0 * 1.d-6 ierr = putvar(ncout, id_varout(1), hmld, 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(2), REAL(dmxlheatc), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(3), REAL(dmxlsaltc), 1, npiglo, npjglo, ktime=jt) END DO ! time loop ierr = closeout(ncout) END PROGRAM cdfmxlhcsc cdftools-3.0/cdfpsi_level.f900000644000175000017500000001443412241227304017305 0ustar amckinstryamckinstryPROGRAM cdfpsi_level !!------------------------------------------------------------------- !! *** PROGRAM cdfpsi_level *** !! !! ** Purpose : Compute Stream Function for each level !! PARTIAL STEPS !! !! ** Method : Compute the 3D fields ztrpu, ztrpv !! as the integral on the vertical of u, v on their !! respective points. !! Then integrate from south to north : ==> psiu !! Then integrate from West to East : ==> psiv !! (should be almost the same (if no error )) !! Default (appropriate for global model): output psiu; !! normalizes the values setting psi (jpi,jpj) = 0 !! If option "V" is given as last argument, output psiv, !! normalizes values setting psi(jpi,1) = 0. !! This is appropriate for North Atlantic !! !! history ; !! Original : J.M. Molines (May 2005 ) !!------------------------------------------------------------------- !! $Rev: 256 $ !! $Date: 2009-07-21 17:49:27 +0200 (mar. 21 juil. 2009) $ !! $Id$ !!-------------------------------------------------------------- !! * Modules used USE cdfio !! * Local variables IMPLICIT NONE INTEGER :: ji,jj,jk !: dummy loop index INTEGER :: ierr !: working integer INTEGER :: narg, iargc !: command line INTEGER :: npiglo,npjglo, npk !: size of the domain INTEGER :: ncout INTEGER, DIMENSION(1) :: ipk, id_varout ! REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e1v, e3v , zv !: mask, metrics REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u , zu !: mask, metrics REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamf, gphif REAL(KIND=4) ,DIMENSION(1) :: tim REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrpu, ztrpv, psiu, psiv CHARACTER(LEN=256) :: cfileu ,cfilev, cfileoutnc='psi_level.nc' CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cmask='mask.nc' CHARACTER(LEN=1) :: coption CHARACTER(LEN=256) :: cdep TYPE(variable), DIMENSION(1) :: typvar !: structure for attributes INTEGER :: istatus ! constants !! Read command line and output usage message if not compliant. narg= iargc() IF ( narg == 0 ) THEN PRINT *,' Usage : cdfpsi_level Ufile Vfile (optional argument)' PRINT *,' Computes the barotropic stream function as the integral of the transport' PRINT *,' PARTIAL CELLS VERSION' PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc must be in te current directory' PRINT *,' Output on psi_level.nc, variables sobarstf on f-points' PRINT *,' Default works well for a global ORCA grid. use V 3rdargument for North Atlantic' STOP ENDIF CALL getarg (1, cfileu ) CALL getarg (2, cfilev ) CALL getarg (3, coption ) npiglo= getdim (cfileu,'x') npjglo= getdim (cfileu,'y') npk = getdim (cfileu,'depth') ! define new variables for output ( must update att.txt) typvar(1)%cname= 'sobarstf' typvar(1)%cunits='m3/s' typvar(1)%rmissing_value=0. typvar(1)%valid_min= -300.e6 typvar(1)%valid_max= 300.e6 typvar(1)%clong_name='Barotropic_Stream_Function' typvar(1)%cshort_name='sobarstf' typvar(1)%conline_operation='N/A' typvar(1)%caxis='TZYX' ipk(1) = npk ! 3D ( X, Y , Z, T ) PRINT *, 'npiglo=', npiglo PRINT *, 'npjglo=', npjglo PRINT *, 'npk =', npk IF ( coption == 'V') PRINT *, ' Use psiv (ex. North Atlantic case)' ! Allocate arrays ALLOCATE ( zmask(npiglo,npjglo) ) ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo)) ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo)) ALLOCATE ( zu(npiglo,npjglo),ztrpu(npiglo,npjglo), psiu(npiglo,npjglo) ) ALLOCATE ( zv(npiglo,npjglo),ztrpv(npiglo,npjglo), psiv(npiglo,npjglo)) ALLOCATE ( glamf(npiglo,npjglo), gphif(npiglo,npjglo)) glamf(:,:) = getvar(coordhgr, 'glamf',1,npiglo,npjglo) gphif(:,:) = getvar(coordhgr, 'gphif',1,npiglo,npjglo) ! create output fileset ncout =create(cfileoutnc, cfileu, npiglo,npjglo,npk) ierr= createvar(ncout ,typvar,1, ipk,id_varout ) ierr= putheadervar(ncout , cfileu, npiglo, npjglo, npk) ! ierr= putheadervar(ncout , cfileu, npiglo, npjglo, npk,cdep=cdep) ! ierr= putheadervar(ncout, cfileu,npiglo, npjglo,1,glamf, gphif) tim=getvar1d(cfileu,'time_counter',1) ierr=putvar1d(ncout,tim,1,'T') e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo) e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo) ztrpu(:,:)= 0.d0 ztrpv(:,:)= 0.d0 DO jk = 1,npk zmask(:,:) = getvar(cmask, 'fmask', jk,npiglo,npjglo) ! get rid of the free-slip/no-slip condition WHERE ( zmask >= 2 ) zmask = 1 PRINT *,'level ',jk IF ( coption == 'V' ) THEN zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo) e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.) ztrpv(:,:) = zv(:,:)*e1v(:,:)*e3v(:,:)*1.d0 ! meridional transport of each grid cell ELSE ! Get zonal velocity at jk zu(:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo) ! get e3v at level jk e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.) ! integrates vertically ztrpu(:,:) = zu(:,:)*e2u(:,:)*e3u(:,:)*1.d0 ! zonal transport of each grid cell ENDIF IF (coption == 'V' ) THEN ! integrate zonally from east to west psiv(npiglo,:)= 0.0 DO ji=npiglo-1,1,-1 psiv(ji,:) = psiv(ji+1,:) - ztrpv(ji,:) ! psi at f point END DO psiv(:,:) = psiv(:,:) *zmask(:,:) ierr = putvar(ncout, id_varout(1) ,REAL(psiv), jk, npiglo, npjglo) !ierr = putvar(ncout, id_varout(1) ,REAL(ztrpv), jk, npiglo, npjglo) ELSE ! integrate from the south to the north with zonal transport psiu(:,:) = 0.d0 DO jj = 2, npjglo psiu(:,jj) = psiu(:,jj-1) - ztrpu(:,jj) ! psi at f point END DO psiu(:,:) = (psiu(:,:) -psiu(npiglo,npjglo) ) * zmask(:,:) ierr = putvar(ncout, id_varout(1) ,REAL(psiu), jk, npiglo, npjglo) !ierr = putvar(ncout, id_varout(1) ,REAL(ztrpu), jk, npiglo, npjglo) ENDIF END DO ! loop to next level istatus = closeout (ncout) END PROGRAM cdfpsi_level cdftools-3.0/cdftools-begin.pod0000644000175000017500000000101412241227304017717 0ustar amckinstryamckinstry=head1 NAME cdftools - diagnostics in Fortran 90 for NEMO model outputs =head1 SYNOPSIS cdf* option... =head1 DESCRIPTION C is a diagnostic package written in fortran 90 for the analysis of NEMO model output in the frame of the DRAKKAR project. This software is a computer program for analysis of NEMO model output produced in the frame of the DRAKKAR project. It is designed for the treatment of the NetCdf files produced by NEMO-DRAKKAR. C web site : http://www.nemo-ocean.eu/ =head1 COMMAND cdftools-3.0/cdfeke.f900000644000175000017500000001453712241227304016073 0ustar amckinstryamckinstryPROGRAM cdfeke !!====================================================================== !! *** PROGRAM cdfeke *** !!===================================================================== !! ** Purpose : Compute Eddy Kinetic Energy !! !! ** Method : Use gridU gridU2, gridV gridV2 files produced by !! cdfmoy. Velocities are interpolated both on T points !! and the variance is computed !! !! History : pre : 11/2004 : J.M. Molines : Original code !! 2.1 : 04/2005 : J.M. Molines : use modules !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! command line browsing INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain (horiz) INTEGER(KIND=4) :: npk, npt ! size of the domain vert and time INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr ! Error status INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! REAL(KIND=4) :: ua, va ! working arrays REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time variable REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: uc, vc, u2, v2 ! velocities etc... REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: eke ! velocities etc... CHARACTER(LEN=256) :: cf_out='eke.nc' ! file name CHARACTER(LEN=256) :: cf_ufil, cf_u2fil ! file name CHARACTER(LEN=256) :: cf_vfil, cf_v2fil ! CHARACTER(LEN=256) :: cf_tfil ! TYPE(variable), DIMENSION(1) :: stypvar ! LOGICAL :: lchk ! checking files existence LOGICAL :: lperio=.FALSE. ! checking E-W periodicity !!---------------------------------------------------------------------- CALL ReadCdfNames() !! Read command line narg= iargc() IF ( narg /= 5 ) THEN PRINT *,' usage : cdfeke U-file U2-file V-file V2-file T2-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the Eddy Kinetic Energy from previously computed' PRINT *,' mean values and mean squared values of velocity components.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' U-file : gridU type file with mean U component.' PRINT *,' U2-file : gridU2 type file with mean U2 component.' PRINT *,' V-file : gridV type file with mean V component.' PRINT *,' V2-file : gridV2 type file with mean V2 component.' PRINT *,' T2-file : any gridT or gridT2 (smaller) file, used for EKE header.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : voeke (m2/s)' STOP ENDIF !! !! Initialisation from 1st file (all file are assume to have the same geometry) CALL getarg (1, cf_ufil ) CALL getarg (2, cf_u2fil) CALL getarg (3, cf_vfil ) CALL getarg (4, cf_v2fil) CALL getarg (5, cf_tfil ) lchk = chkfile (cf_ufil ) lchk = lchk .OR. chkfile (cf_u2fil) lchk = lchk .OR. chkfile (cf_vfil ) lchk = lchk .OR. chkfile (cf_v2fil) lchk = lchk .OR. chkfile (cf_tfil ) IF ( lchk ) STOP ! missing files npiglo = getdim (cf_ufil,cn_x) npjglo = getdim (cf_ufil,cn_y) npk = getdim (cf_ufil,cn_z) npt = getdim (cf_ufil,cn_t) ipk(1) = npk stypvar(1)%cname = 'voeke' stypvar(1)%cunits = 'm2/s2' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 10000. stypvar(1)%clong_name = 'Eddy_Kinetic_Energy' stypvar(1)%cshort_name = 'voeke' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE( uc(npiglo,npjglo), u2(npiglo,npjglo), vc(npiglo,npjglo), v2(npiglo,npjglo) ) ALLOCATE( eke(npiglo,npjglo) , tim(npt) ) ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) ! check for E_W periodicity uc(:,:) = getvar(cf_tfil, cn_vlon2d, 1, npiglo, npjglo ) IF ( uc(1,1) == uc(npiglo-1,1) ) THEN lperio = .TRUE. PRINT *,' E-W periodicity detected ' ENDIF DO jt = 1, npt ! input file is likely to contain only one time frame but who knows ... DO jk = 1, npk uc(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jt ) vc(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt ) u2(:,:) = getvar(cf_u2fil, TRIM(cn_vozocrtx)//'_sqd', jk ,npiglo, npjglo, ktime=jt ) v2(:,:) = getvar(cf_v2fil, TRIM(cn_vomecrty)//'_sqd', jk ,npiglo, npjglo, ktime=jt ) ua = 0. ; va = 0. ; eke(:,:) = 0. DO ji=2, npiglo DO jj=2,npjglo ua = 0.5* ((u2(ji,jj)-uc(ji,jj)*uc(ji,jj))+ (u2(ji-1,jj)-uc(ji-1,jj)*uc(ji-1,jj))) va = 0.5* ((v2(ji,jj)-vc(ji,jj)*vc(ji,jj))+ (v2(ji,jj-1)-vc(ji,jj-1)*vc(ji,jj-1))) eke(ji,jj) = 0.5 * ( ua + va ) END DO END DO IF ( lperio ) eke(1,:) = eke(npiglo-1,:) ierr=putvar(ncout,id_varout(1), eke, jk ,npiglo, npjglo, ktime=jt ) END DO END DO ! time loop tim = getvar1d(cf_ufil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdfeke cdftools-3.0/cdfmoc.f900000644000175000017500000017336712241227304016114 0ustar amckinstryamckinstryPROGRAM cdfmoc !!====================================================================== !! *** PROGRAM cdfmoc *** !!===================================================================== !! ** Purpose : Compute the Meridional Overturning Cell (MOC) !! !! ** Method : The MOC is computed from the V velocity field, integrated !! from the bottom to the surface, then zonally averaged with !! eventual masking for oceanic basins. !! The program looks for the file "new_maskglo.nc". If it !! does not exist, only the calculation over all the domain !! is performed (this is adequate for a basin configuration). !! In new_maskglo.nc the masking corresponds to the global !! configuration. MOC for Global, Atlantic, Indo-Pacific, !! Indian, Pacific ocean, inp0=Global-Atlantic !! Results are saved on moc.nc file with variables name !! respectively zomsfglo, zomsfatl, zomsfinp, zomsfind, zomsfpac, zomsinp0 !! !! History : 2.1 : 07/2005 : J.M. Molines : Original code !! : 04/2006 : A.M. Treguier : Adaptation to NATL4 case !! : 09/2007 : G. Smith : MOC decomposition !! : 01/2008 : A. Lecointre : MOC decomposition adaptation !! 3.0 : 03/2011 : J.M. Molines : Merge all MOC prog, Doctor norm + Lic. !! : 10/2012 : M.A. Balmaseda: it adds basin INP0=GLOBAL-ATL, different from INP. : Avoid 3d variables in e3v !! !! !! References : For MOC decomposition : Lee & Marotzke (1998), !! Baehr, Hirschi, Beismann & Marotzke (2004), !! Cabanes, Lee, & Fu (2007), Koehl & Stammer (2007). !! See also the powerpoint presentation by Tony Lee at the third !! CLIVAR-GSOP intercomparison available at : !! http://www.clivar.org/organization/gsop/synthesis/mit/talks/lee_MOC_comparison.ppt !! See : AMOC Metrics guidelines availablke on: !! https://www.godae-oceanview.org/documents/q/action-edit/ref-264/parent-261/ !!---------------------------------------------------------------------- USE cdfio USE modcdfnames USE eos !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=2), DIMENSION(:,:,:), ALLOCATABLE :: ibmask ! nbasins x npiglo x npjglo INTEGER(KIND=2), DIMENSION(:,:), ALLOCATABLE :: ivmask ! ivmask (used to mask e3v) INTEGER(KIND=4) :: npglo, npatl, npinp, npinp0 INTEGER(KIND=4) :: npind, nppac INTEGER(KIND=4) :: jbasin, jj, jk ! dummy loop index INTEGER(KIND=4) :: ji, jt ! dummy loop index INTEGER(KIND=4) :: nbasins, ibasin ! number of sub basins INTEGER(KIND=4) :: nbasinso ! number of sub output basins nbasins+1 to include INDP0 INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line browser INTEGER(KIND=4) :: ijarg, ii ! " " INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! out put file id INTEGER(KIND=4) :: nvarout ! number of output variables INTEGER(KIND=4) :: ijvar ! index for output variable INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! output variables info INTEGER(KIND=4), DIMENSION(2) :: iloc ! working integer array REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: e3v ! Vertical e3v masked by vmask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, gphiv ! metrics, velocity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zv ! meridional velocity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon ! dummy longitude = 0. REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlat ! latitude for i = north pole REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depthw REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! deptht REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! e3 1D : used if full step REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter array REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc ! nbasins x npjglo x npk CHARACTER(LEN=256) :: cf_vfil ! meridional velocity file CHARACTER(LEN=256) :: cf_moc = 'moc.nc' ! output file name CHARACTER(LEN=256) :: cglobal ! Global attribute for output file CHARACTER(LEN=256) :: cldum ! dummy char variable TYPE(variable) ,DIMENSION(:), ALLOCATABLE :: stypvar ! structure for attribute LOGICAL :: lbas = .FALSE. ! new_maskglo.nc file flag LOGICAL :: lfull = .FALSE. ! full step flag LOGICAL :: lchk = .FALSE. ! check for missing files LOGICAL :: ldec = .FALSE. ! flag for decomposition option LOGICAL :: lrap = .FALSE. ! flag for rapid option ! Variables used only when MOC decomposition is requested INTEGER(KIND=2), DIMENSION(:,:), ALLOCATABLE :: iumask ! iumask (used if decomposition) INTEGER(KIND=2), DIMENSION(:,:), ALLOCATABLE :: itmask ! itmask (used if decomposition) INTEGER(KIND=4) :: itmp, iup, ido ! up and down index for work REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1u ! used if ldec REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hdep ! total depth at v point REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zcoef ! coefficient for geostrophic calc REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp ! temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsal ! salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsig0 ! density REAL(KIND=4) :: zmsv REAL(KIND=4) :: rpi ! pi REAL(KIND=4) :: grav = 9.81 ! gravity REAL(KIND=4) :: rau0 = 1025. ! mean density REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc_sh ! nbasins x npjglo x npk REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc_bt ! nbasins x npjglo x npk REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc_btw ! nbasins x npjglo x npk REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc_ag ! nbasins x npjglo x npk REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dvgeo ! npiglo x npjglo x 2 REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dvbt ! Barotropic velocity REAL(KIND=8) :: dgeo ! Barotropic velocity CHARACTER(LEN=256) :: cf_tfil ! Grid T file (case of decomposition) CHARACTER(LEN=256) :: cf_ufil ! Grid U file (case Rapid) CHARACTER(LEN=256) :: cf_sfil ! Grid S file (case Rapid) !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmoc V_file [-full] [-decomp ] [T_file] [S_file] [U_file] [-rapid] ' PRINT *,' PURPOSE :' PRINT *,' Computes the MOC for oceanic sub basins as described ' PRINT *,' in ',TRIM(cn_fbasins) PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' V_file : file with meridional velocity component (mandatory).' PRINT *,' T_file : file with temperature and salinity' PRINT *,' (required only for -decomp option).' PRINT *,' S_file (required only for -rapid option --might be the same as T_file-- ).' PRINT *,' U_file (required only for -rapid option).' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-full ] : use full step instead of default partial step' PRINT *,' [-decomp ] : decompose MOC in 3 components: Geostrophic,' PRINT *,' Barotropic, Ageostrophic). For this option a ' PRINT *,' gridT file is required.' PRINT *,' [-rapid ] : Compute the AMOC at 26.5 N in the same waay than the' PRINT *,' RAPID MOCHA array, separating the Gulfstream transport,' PRINT *,' and the contribution of different water masses :' PRINT *,' - 0-800m : Thermocline recirculation' PRINT *,' - 800-1100m : AIW recirculation' PRINT *,' - 1100-3000m : upper-NADW recirculation' PRINT *,' - 3000-5000m : lower-NADW recirculation' PRINT *,' - 5000-bottom : AABW recirculation' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' Files ',TRIM(cn_fhgr),' ', TRIM(cn_fhgr),' and ', TRIM(cn_fmsk) PRINT *,' File ',TRIM(cn_fbasins),'. If this latter file is not available ' PRINT *,' only the MOC for the global domain is computed' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_moc) PRINT *,' variables ',TRIM( cn_zomsfglo),' : Global ocean ' PRINT *,' variables ',TRIM( cn_zomsfatl),' : Atlantic Ocean ' PRINT *,' variables ',TRIM( cn_zomsfinp),' : Indo Pacific ' PRINT *,' variables ',TRIM( cn_zomsfind),' : Indian Ocean alone' PRINT *,' variables ',TRIM( cn_zomsfpac),' : Pacific Ocean alone' PRINT *,' variables ',TRIM( cn_zomsfinp0),' : Indo Pacific Net' PRINT *,' ' PRINT *,' If decomposition is required , ( option -decomp ) add 3 additional' PRINT *,' variables per basin with suffixes _sh, _bt, _ag.' PRINT *,' ' PRINT *,' If option -rapid in use the output file (rapid_moc.nc)is degenerated ' PRINT *,' into 6 scalar values : tr_gs, tr_THERM, tr_AIW, tr_UNADW, tr_LNADW, ' PRINT *,' tr_BW and a vertical profile of the AMOC at 26.5N, as computed traditionally.' PRINT *,' Additional variables are also computed following CLIVAR-GODAE ' PRINT *,' reanalysis intercomparison project recommendations. ' STOP ENDIF cglobal = 'Partial step computation' ijarg = 1 ; ii = 0 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE ('-full') lfull = .TRUE. cglobal = 'Full step computation' CASE ('-decomp') ldec = .TRUE. CASE ('-rapid') lrap = .TRUE. CASE DEFAULT ii=ii+1 SELECT CASE (ii) CASE ( 1 ) ; cf_vfil = cldum CASE ( 2 ) ; cf_tfil = cldum CASE ( 3 ) ; cf_sfil = cldum CASE ( 4 ) ; cf_ufil = cldum CASE DEFAULT PRINT*, 'ERROR : Too many arguments ...' STOP END SELECT END SELECT END DO lchk = lchk .OR. chkfile ( cn_fhgr ) lchk = lchk .OR. chkfile ( cn_fzgr ) lchk = lchk .OR. chkfile ( cn_fmsk ) lchk = lchk .OR. chkfile ( cf_vfil ) IF ( ldec ) lchk = lchk .OR. chkfile ( TRIM(cf_tfil) ) IF ( lchk ) STOP ! missing file(s) IF ( lrap ) THEN ! all the work will be done in a separated routine for RAPID-MOCHA section CALL rapid_amoc STOP ! program stops here in this case ENDIF npiglo = getdim (cf_vfil,cn_x) npjglo = getdim (cf_vfil,cn_y) npk = getdim (cf_vfil,cn_z) npt = getdim (cf_vfil,cn_t) PRINT *, 'Working with cdfmoc ...' PRINT *, ' npiglo =', npiglo PRINT *, ' npjglo =', npjglo PRINT *, ' npk =', npk PRINT *, ' npt =', npt ! Detects newmaskglo file lbas = .NOT. chkfile (cn_fbasins ) IF (lbas) THEN nbasins = 5 nbasinso= 6 ELSE nbasins = 1 nbasinso= 1 ENDIF IF ( ldec ) THEN nvarout=nbasinso * 4 ! total, _sh, _bt, _ag ELSE nvarout=nbasinso ! total ENDIF ALLOCATE ( stypvar(nvarout), ipk(nvarout), id_varout(nvarout) ) ! define new variables for output ! all variables stypvar%cunits = 'Sverdrup' stypvar%rmissing_value = 99999. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%scale_factor = 1. stypvar%add_offset = 0. stypvar%savelog10 = 0. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TZY' ipk(:) = npk ! All variables are vertical slices 1 x npjglo x npk ii=1 ; ibasin=1 PRINT *, 'Variable ',ii,' is zomsfglo' npglo=ibasin ; ibasin = ibasin + 1 stypvar(ii)%cname = TRIM(cn_zomsfglo) stypvar(ii)%clong_name = 'Meridional_Overt.Cell_Global' stypvar(ii)%cshort_name = TRIM(cn_zomsfglo) ii=ii+1 IF ( ldec ) THEN PRINT *, 'Variable ',ii,' is zomsfglo_sh' stypvar(ii)%cname = TRIM(cn_zomsfglo)//'_sh' stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction' stypvar(ii)%cshort_name = TRIM(cn_zomsfglo)//'_sh' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfglo_bt' stypvar(ii)%cname = TRIM(cn_zomsfglo)//'_bt' stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction' stypvar(ii)%cshort_name = TRIM(cn_zomsfglo)//'_bt' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfglo_ag' stypvar(ii)%cname = TRIM(cn_zomsfglo)//'_ag' stypvar(ii)%clong_name = 'Ageostoph_Merid_StreamFunction' stypvar(ii)%cshort_name = TRIM(cn_zomsfglo)//'_ag' ii= ii+1 ENDIF IF (lbas) THEN npatl=ibasin ; ibasin = ibasin + 1 PRINT *, 'Variable ',ii,' is zomsfatl' stypvar(ii)%cname = TRIM(cn_zomsfatl) stypvar(ii)%clong_name = 'Meridional_Overt.Cell_Atlantic' stypvar(ii)%cshort_name = TRIM(cn_zomsfatl) ii= ii+1 IF ( ldec ) THEN PRINT *, 'Variable ',ii,' is zomsfatl_sh' stypvar(ii)%cname = TRIM(cn_zomsfatl)//'_sh' stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction_Atlantic' stypvar(ii)%cshort_name = TRIM(cn_zomsfatl)//'_sh' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfatl_bt' stypvar(ii)%cname = TRIM(cn_zomsfatl)//'_bt' stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction_Atlantic' stypvar(ii)%cshort_name = TRIM(cn_zomsfatl)//'_bt' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfatl_ag' stypvar(ii)%cname = TRIM(cn_zomsfatl)//'_ag' stypvar(ii)%clong_name = 'Ageostroph_Merid_StreamFunction_Atlantic' stypvar(ii)%cshort_name = TRIM(cn_zomsfatl)//'_ag' ii= ii+1 ENDIF npinp=ibasin ; ibasin = ibasin + 1 PRINT *, 'Variable ',ii,' is zomsfinp' stypvar(ii)%cname = TRIM(cn_zomsfinp) stypvar(ii)%clong_name = 'Meridional_Overt.Cell_IndoPacif' stypvar(ii)%cshort_name = TRIM(cn_zomsfinp) ii= ii+1 IF ( ldec ) THEN PRINT *, 'Variable ',ii,' is zomsfinp_sh' stypvar(ii)%cname = TRIM(cn_zomsfinp)//'_sh' stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction_IndoPacif' stypvar(ii)%cshort_name = TRIM(cn_zomsfinp)//'_sh' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfinp_bt' stypvar(ii)%cname = TRIM(cn_zomsfinp)//'_bt' stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction_IndoPacif' stypvar(ii)%cshort_name = TRIM(cn_zomsfinp)//'_bt' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfinp_ag' stypvar(ii)%cname = TRIM(cn_zomsfinp)//'_ag' stypvar(ii)%clong_name = 'Ageostroph_Merid_StreamFunction_IndoPacif' stypvar(ii)%cshort_name = TRIM(cn_zomsfinp)//'_ag' ii= ii+1 ENDIF npind=ibasin ; ibasin = ibasin + 1 PRINT *, 'Variable ',ii,' is zomsfind' stypvar(ii)%cname = TRIM(cn_zomsfind) stypvar(ii)%clong_name = 'Meridional_Overt.Cell_Indian' stypvar(ii)%cshort_name = TRIM(cn_zomsfind) ii= ii+1 IF ( ldec ) THEN PRINT *, 'Variable ',ii,' is zomsfind_sh' stypvar(ii)%cname = TRIM(cn_zomsfind)//'_sh' stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction_Indian' stypvar(ii)%cshort_name = TRIM(cn_zomsfind)//'_sh' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfind_bt' stypvar(ii)%cname = TRIM(cn_zomsfind)//'_bt' stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction_Indian' stypvar(ii)%cshort_name = TRIM(cn_zomsfind)//'_bt' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfind_ag' stypvar(ii)%cname = TRIM(cn_zomsfind)//'_ag' stypvar(ii)%clong_name = 'Ageostroph_Merid_StreamFunction_Indian' stypvar(ii)%cshort_name = TRIM(cn_zomsfind)//'_ag' ii= ii+1 ENDIF nppac=ibasin ; ibasin = ibasin + 1 PRINT *, 'Variable ',ii,' is zomsfpac' stypvar(ii)%cname = TRIM(cn_zomsfpac) stypvar(ii)%clong_name = 'Meridional_Overt.Cell_pacif' stypvar(ii)%cshort_name = TRIM(cn_zomsfpac) ii= ii+1 IF ( ldec ) THEN PRINT *, 'Variable ',ii,' is zomsfpac_sh' stypvar(ii)%cname = TRIM(cn_zomsfpac)//'_sh' stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction_Pacif' stypvar(ii)%cshort_name = TRIM(cn_zomsfpac)//'_sh' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfpac_bt' stypvar(ii)%cname = TRIM(cn_zomsfpac)//'_bt' stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction_Pacif' stypvar(ii)%cshort_name = TRIM(cn_zomsfpac)//'_bt' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfpac_ag' stypvar(ii)%cname = TRIM(cn_zomsfpac)//'_ag' stypvar(ii)%clong_name = 'Ageostroph_Merid_StreamFunction_Pacif' stypvar(ii)%cshort_name = TRIM(cn_zomsfpac)//'_ag' ii=ii+1 ENDIF npinp0=ibasin ; ibasin = ibasin + 1 PRINT *, 'Variable ',ii,' is zomsfinp0' stypvar(ii)%cname = TRIM(cn_zomsfinp0) stypvar(ii)%clong_name = 'Meridional_Overt.Cell_IndPac0' stypvar(ii)%cshort_name = TRIM(cn_zomsfinp0) ii= ii+1 IF ( ldec ) THEN PRINT *, 'Variable ',ii,' is zomsfinp0_sh' stypvar(ii)%cname = TRIM(cn_zomsfinp0)//'_sh' stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction_IndPac0' stypvar(ii)%cshort_name = TRIM(cn_zomsfinp0)//'_sh' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfinp0_bt' stypvar(ii)%cname = TRIM(cn_zomsfinp0)//'_bt' stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction_IndPac0' stypvar(ii)%cshort_name = TRIM(cn_zomsfinp0)//'_bt' ii= ii+1 PRINT *, 'Variable ',ii,' is zomsfinp0_ag' stypvar(ii)%cname = TRIM(cn_zomsfinp0)//'_ag' stypvar(ii)%clong_name = 'Ageostroph_Merid_StreamFunction_IndPac0' stypvar(ii)%cshort_name = TRIM(cn_zomsfinp0)//'_ag' ENDIF ENDIF ! Allocate arrays ALLOCATE ( ibmask(nbasins, npiglo, npjglo) ) ALLOCATE ( zv(npiglo, npjglo), e1v(npiglo,npjglo), e3v(npiglo,npjglo,npk) ) ALLOCATE ( gphiv(npiglo,npjglo) ) ALLOCATE ( rdumlon(1,npjglo), rdumlat(1,npjglo)) ALLOCATE ( gdepw(npk), gdept(npk), e31d(npk) ) ALLOCATE ( tim(npt) ) ALLOCATE ( dmoc( nbasins, npjglo, npk ) ) ALLOCATE ( ivmask(npiglo, npjglo) ) IF ( ldec ) THEN ALLOCATE ( iumask(npiglo, npjglo) ) ALLOCATE ( itmask(npiglo, npjglo) ) ALLOCATE ( ztemp(npiglo, npjglo) ) ALLOCATE ( zsal(npiglo, npjglo) ) ALLOCATE ( zsig0(npiglo, npjglo) ) ALLOCATE ( e1u(npiglo, npjglo) ) ALLOCATE ( zcoef(npiglo, npjglo) ) ALLOCATE ( dvbt(npiglo, npjglo), hdep(npiglo,npjglo) ) ALLOCATE ( dmoc_sh(nbasins, npjglo, npk) ) ALLOCATE ( dmoc_bt(nbasins, npjglo, npk) ) ALLOCATE ( dmoc_btw(nbasins, npjglo, npk) ) ALLOCATE ( dmoc_ag(nbasins, npjglo, npk) ) ALLOCATE ( dvgeo(npiglo, npjglo, 2 ) ) ENDIF e1v(:,:) = getvar (cn_fhgr, cn_ve1v, 1, npiglo,npjglo) gphiv(:,:) = getvar (cn_fhgr, cn_gphiv, 1, npiglo,npjglo) gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk ) gdepw(:) = -1.* gdepw(:) DO jk= 1, npk ! save e3v masked with vmask as 3d array e3v(:,:,jk) = get_e3v(jk) END DO IF ( ldec ) gdept(:) = getvare3(cn_fzgr, cn_gdept, npk ) IF ( ldec ) e1u(:,:) = getvar (cn_fhgr, cn_ve1u, 1, npiglo,npjglo) IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk) iloc=MAXLOC(gphiv) rdumlat(1,:) = gphiv(iloc(1),:) rdumlon(:,:) = 0. ! set the dummy longitude to 0 ! create output fileset ncout = create ( cf_moc, 'none', 1, npjglo, npk, cdep=cn_vdepthw ) ierr = createvar ( ncout, stypvar, nvarout, ipk, id_varout, cdglobal=TRIM(cglobal) ) ierr = putheadervar( ncout, cf_vfil, 1, npjglo, npk, pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdepw) tim = getvar1d ( cf_vfil, cn_vtimec, npt ) ierr = putvar1d ( ncout, tim, npt, 'T') ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif ibmask(npglo,:,:) = getvar(cn_fmsk, 'vmask', 1, npiglo, npjglo) IF ( lbas ) THEN ibmask(npatl,:,:) = getvar(cn_fbasins, 'tmaskatl', 1, npiglo, npjglo) ibmask(npind,:,:) = getvar(cn_fbasins, 'tmaskind', 1, npiglo, npjglo) ibmask(nppac,:,:) = getvar(cn_fbasins, 'tmaskpac', 1, npiglo, npjglo) ibmask(npinp,:,:) = ibmask(nppac,:,:) + ibmask(npind,:,:) ! indo pacific mask ! ensure that there are no overlapping on the masks WHERE(ibmask(npinp,:,:) > 0 ) ibmask(npinp,:,:) = 1 ! change global mask for GLOBAL periodic condition ibmask(1,1, :) = 0. ibmask(1,npiglo,:) = 0. ENDIF DO jt = 1, npt ! -------------------------- ! 1) Compute total MOC: dmoc ! -------------------------- dmoc(:,:,:) = 0.d0 ! initialize moc to 0 IF ( ldec) THEN ; dvbt=0.d0 ; hdep=0.0 ; dmoc_bt=0.d0 ; ENDIF DO jk = 1, npk-1 ! Get velocities v at jk, time = jt zv(:,:)= getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt) IF ( ldec ) THEN ! compute barotropic component when requested ! this contribution is computed here in order to use zv(jk) dvbt(:,:) = dvbt(:,:) + e3v(:,:,jk)*zv(:,:)*1.d0 hdep(:,:) = hdep(:,:) + e3v(:,:,jk) ENDIF ! integrates 'zonally' (along i-coordinate) DO ji=1,npiglo ! For all basins DO jbasin = 1, nbasins DO jj=1,npjglo dmoc(jbasin,jj,jk)=dmoc(jbasin,jj,jk) - & & e1v(ji,jj)*e3v(ji,jj,jk)* ibmask(jbasin,ji,jj)*zv(ji,jj)*1.d0 ENDDO END DO END DO END DO ! integrates vertically from bottom to surface DO jk = npk-1, 1, -1 dmoc(:,:,jk) = dmoc(:,:,jk+1) + dmoc(:,:,jk)/1.d6 END DO IF ( ldec ) THEN !-------------------------------------------------- ! 2) compute extra term if decomposition requested !-------------------------------------------------- ! 2.1 : Barotropic MOC : dmoc_bt ! """""""""""""""""""" ! compute vertical mean of the meridional velocity WHERE ( hdep /= 0 ) dvbt(:,:) = dvbt(:,:) / hdep(:,:) ELSEWHERE dvbt(:,:) = 0.d0 ENDWHERE DO jk=1, npk-1 ! integrates 'zonally' (along i-coordinate) DO ji=1,npiglo ! For all basins DO jbasin = 1, nbasins DO jj=1,npjglo dmoc_bt(jbasin,jj,jk)=dmoc_bt(jbasin,jj,jk) - & & e1v(ji,jj)*e3v(ji,jj,jk)* ibmask(jbasin,ji,jj)*dvbt(ji,jj) ENDDO END DO END DO END DO ! integrates vertically from bottom to surface DO jk = npk-1, 1, -1 dmoc_bt(:,:,jk) = dmoc_bt(:,:,jk+1) + dmoc_bt(:,:,jk)/1.d6 END DO ! 2.2 : Geostrophic Shear MOC : dmoc_sh ! """"""""""""""""""""""""""""" ! using equation 2.7 of Lecointre (2008 ! f. Dv/Dz = -g/rau0. Drho/Dx rau0 = 1025.0 grav = 9.81 rpi = ACOS( -1.) zcoef(:,:) = 2*2*rpi/( 24.0 * 3600. )* SIN ( rpi * gphiv(:,:) /180.0) ! f at v point WHERE ( zcoef /= 0 ) zcoef(:,:) = -grav/ rau0 / zcoef(:,:) ELSEWHERE zcoef(:,:) = 0. END WHERE dvgeo(:,:,:) = 0.0 dvbt(:,:) = 0.d0 iup = 1 ; ido = 2 DO jk=npk-1, 1, -1 iumask(:,:) = getvar(cn_fmsk, 'umask', jk, npiglo, npjglo) itmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo) ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt ) zsal(:,:) = getvar(cf_sfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt ) zsig0(:,:) = sigmai (ztemp, zsal, gdept(jk), npiglo, npjglo )* itmask(:,:) ! dgeo is Drho/dx at V point ( average on the 4 neighbours U points) ! thus, dgeo is -f.rau0/g. Dv/Dz DO jj = 2, npjglo -1 DO ji = 2, npiglo -1 zmsv = 1. / MAX (1_2, iumask(ji-1,jj+1)+iumask(ji,jj+1)+iumask(ji-1,jj)+iumask(ji,jj) ) dgeo = ( ( zsig0(ji, jj+1) - zsig0(ji-1,jj+1) ) * iumask(ji-1, jj+1) / e1u(ji-1, jj+1) & & +( zsig0(ji+1,jj+1) - zsig0(ji ,jj+1) ) * iumask(ji, jj+1) / e1u(ji, jj+1) & & +( zsig0(ji, jj ) - zsig0(ji-1,jj ) ) * iumask(ji-1, jj ) / e1u(ji-1, jj ) & & +( zsig0(ji+1,jj ) - zsig0(ji, jj ) ) * iumask(ji, jj ) / e1u(ji, jj ) )*1.d0 ! ! dvgeo is the geostrophic velocity at w point(jk) obtained by vertical integration of Dv/Dz ! between bottom and jk dvgeo(ji,jj,iup) = dvgeo(ji,jj,ido) + zcoef(ji,jj) * dgeo * zmsv * ibmask(npglo,ji,jj) *e3v(ji,jj,jk) ! zv is the geostrophic velocity located at v-level (jk) zv(ji,jj) = 0.5 *( dvgeo(ji,jj,iup) + dvgeo(ji,jj,ido) ) ENDDO ENDDO ! compute the vertical mean of geostrophic velocity ! for memory management purpose we re-use dvbt which is not used any longer. dvbt(:,:) = dvbt(:,:) + e3v(:,:,jk)*zv(:,:)*1.d0 ! integrates 'zonally' (along i-coordinate) DO ji=1,npiglo ! For all basins DO jbasin = 1, nbasins DO jj=1,npjglo dmoc_sh(jbasin,jj,jk)=dmoc_sh(jbasin,jj,jk) - & & e1v(ji,jj)*e3v(ji,jj,jk)* ibmask(jbasin,ji,jj)*zv(ji,jj)*1.d0 ENDDO END DO END DO ! swap up and down for next level computation itmp=iup ; iup = ido ; ido = itmp ENDDO ! end of level loop WHERE ( hdep /=0 ) dvbt(:,:) = dvbt(:,:) / hdep(:,:) ELSEWHERE dvbt(:,:) = 0.d0 END WHERE ! 2.2.1 : Barotropic Geostrophic Shear MOC : dmoc_btw ! """""""""""""""""""""""""""""""""""""""""" ! compute corresponding MOC for this unwanted pseudo barotropic contribution dmoc_btw(:,:,:) = 0.d0 DO jk=1, npk-1 ! integrates 'zonally' (along i-coordinate) DO ji=1,npiglo ! For all basins DO jbasin = 1, nbasins DO jj=1,npjglo dmoc_btw(jbasin,jj,jk)=dmoc_btw(jbasin,jj,jk) - & & e1v(ji,jj)*e3v(ji,jj,jk)* ibmask(jbasin,ji,jj)*dvbt(ji,jj) ENDDO END DO END DO END DO ! apply correction to dmoc_sh dmoc_sh(:,:,:) = dmoc_sh(:,:,:) - dmoc_btw(:,:,:) ! integrates vertically from bottom to surface DO jk = npk-1, 1, -1 dmoc_sh(:,:,jk) = dmoc_sh(:,:,jk+1) + dmoc_sh(:,:,jk)/1.e6 END DO ! ! 2.3 : Barotropic Geostrophic Shear MOC : dmoc_ag ! ---------------------------------------- ! compute ageostrophic component ! AGEO = MOC total Geo-Shear Barotropic dmoc_ag(:,:,:) = dmoc(:,:,:) - dmoc_sh(:,:,:) - dmoc_bt(:,:,:) ENDIF ! netcdf output ijvar=1 DO jbasin = 1, nbasins DO jk = 1, npk ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc(jbasin,:,jk)), jk, 1, npjglo, ktime=jt) END DO ijvar = ijvar + 1 IF ( ldec ) THEN ! print *, dmoc_sh(jbasin,60,10) DO jk = 1, npk ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc_sh(jbasin,:,jk)), jk, 1, npjglo, ktime=jt) END DO ! print *, dmoc_bt(jbasin,60,10) ijvar = ijvar + 1 DO jk = 1, npk ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc_bt(jbasin,:,jk)), jk, 1, npjglo, ktime=jt) END DO ! print *, dmoc_ag(jbasin,60,10) ijvar = ijvar + 1 DO jk = 1, npk ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc_ag(jbasin,:,jk)), jk, 1, npjglo, ktime=jt) END DO ijvar = ijvar + 1 ENDIF END DO jbasin=nbasinso DO jk = 1, npk ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc(npglo,:,jk)-dmoc(npatl,:,jk)), jk, 1, npjglo, ktime=jt) END DO ijvar = ijvar + 1 IF ( ldec ) THEN DO jk = 1, npk ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc_sh(npglo,:,jk)-dmoc_sh(npatl,:,jk)), jk, 1, npjglo, ktime=jt) END DO ijvar = ijvar + 1 DO jk = 1, npk ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc_bt(npglo,:,jk)-dmoc_bt(npatl,:,jk)), jk, 1, npjglo, ktime=jt) END DO ijvar = ijvar + 1 DO jk = 1, npk ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc_ag(npglo,:,jk)-dmoc_ag(npatl,:,jk)), jk, 1, npjglo, ktime=jt) END DO ijvar = ijvar + 1 ENDIF ENDDO ! time loop ierr = closeout(ncout) CONTAINS FUNCTION get_e3v(kk) !!--------------------------------------------------------------------- !! *** FUNCTION get_e3 *** !! !! ** Purpose : Send back e3v at level kk selecting !! full step or partial step case !! !! ** Method : check for global flag lfull !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kk ! level to work with REAL(KIND=4), DIMENSION(npiglo,npjglo) :: get_e3v ivmask(:,:) = getvar(cn_fmsk, 'vmask', jk, npiglo, npjglo) IF ( lfull ) THEN get_e3v(:,:) = e31d(jk) ELSE get_e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF get_e3v(:,:) = get_e3v(:,:) * ivmask(:,:) END FUNCTION get_e3v SUBROUTINE rapid_amoc !!--------------------------------------------------------------------- !! *** ROUTINE rapid_amoc *** !! !! ** Purpose : Decompose AMOC at 26.5N (Rapid-Mocha array) the same way !! it is done with observations. !! !! ** Method : Use code provided by N. Ferry (Mercator-ocean) for the !! choice of the components. !! !! References : RAPID-MOCHA paper ... !! !! Upadted : 2012-08 : N. Ferry additional quantities are calculated !! See Keith Haines and Vladimir Stepanov document : !! (CLIVAR-GODAE reanalysis intercomparison) !! See : AMOC Metrics guidelines availablke on: !! https://www.godae-oceanview.org/documents/q/action-edit/ref-264/parent-261/ !! !!---------------------------------------------------------------------- USE cdftools ! for cdf_findij ! Geographical settings for Rapid/Mocha Array REAL(KIND=4), PARAMETER :: rp_lat_rapid = 26.5 ! latitude of Rapid array REAL(KIND=4), PARAMETER :: rp_lonw_rapid = -80.1 ! longitude of the western most point REAL(KIND=4), PARAMETER :: rp_lone_rapid = 12.7 ! longitude of the eastern most point REAL(KIND=4), PARAMETER :: rp_lon_gs = -77.4 ! Gulf Stream limit (eastward from the US coast). INTEGER(KIND=4), PARAMETER :: jp_class = 5 ! number of depth range classes REAL(KIND=4), PARAMETER, DIMENSION(jp_class+1) :: rp_zlim = (/0.,800.,1100.,3000.,5000., 10000./) ! limit of depth classes ! INTEGER(KIND=4) :: ijrapid ! J-index of the rapid section INTEGER(KIND=4) :: iiw ! I-index of the western limit of the section INTEGER(KIND=4) :: iie ! I-index of the eastern limit of the section INTEGER(KIND=4) :: iigs ! I-index of the eastern limit of the gulfstream INTEGER(KIND=4), DIMENSION(jp_class+1) :: iklim ! K-index of the vertical limits for the depth classes INTEGER(KIND=4) :: idum ! dummy integer value INTEGER(KIND=4) :: npigs ! number of point in the Gulf-stream band INTEGER(KIND=4) :: ndiag ! number of diagnostics INTEGER(KIND=4) :: jclass , jv , jk100 ! dummy loop index INTEGER(KIND=4) :: idvar ! id of the netcdf variable INTEGER(KIND=4), DIMENSION (:,:), ALLOCATABLE :: itmaskrapid ! tmask rapid section ! REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: damocrapid ! (1,1,npk) REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: dtrp ! (1,1,1) REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dtaux ! zonal wind stress REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: de1rapid ! e1 metrics alonf rapid REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: dmv, dmt ! mean velocity and tracer (T/S) on verticak REAL(KIND=8) :: ds, ds0, dtrek, dmv0, dmt0, dms0 REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: vrapid, trapid, srapid ! (i,k) vertical slab REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3vrapid, var2d ! (i,k) vertical slab REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zwk ! REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdept ! deptht REAL(KIND=4) :: zmin, zmax, zbot, zalpha, rho REAL(KIND=4) :: zpi, f, zval CHARACTER(LEN=1), DIMENSION (3) :: cvarname !!---------------------------------------------------------------------- npk = getdim (cf_vfil,cn_z) PRINT*, 'cf_vfil = ', cf_vfil PRINT*, 'cf_tfil = ', cf_tfil PRINT*, 'cf_sfil = ', cf_sfil PRINT*, 'cf_ufil = ', cf_ufil npt = getdim (cf_vfil,cn_t) ! 1) look for integer indices corresponding to the section characteristics CALL cdf_findij ( rp_lonw_rapid, rp_lone_rapid, rp_lat_rapid, rp_lat_rapid, & & iiw , iie , ijrapid, idum , & & cd_coord=cn_fhgr, cd_point='F') CALL cdf_findij ( rp_lonw_rapid, rp_lon_gs, rp_lat_rapid, rp_lat_rapid, & & idum , iigs , idum, idum, & & cd_coord=cn_fhgr, cd_point='F') ! ORCA2 fails to cdf_findij ( Med sea ... ) ! iiw = 99 ! iie = 138 ! iigs = 103 ! ijrapid = 98 npiglo = iie -iiw+1 ! size of the rapid section npigs = iigs-iiw+1 ! size of the rapid section ! 1.1 ) read vertical slabs corresponding to ijrapid ALLOCATE ( vrapid(npiglo , npk), e3vrapid(npiglo, npk) , var2d(npiglo , npk)) ALLOCATE ( trapid(npiglo , npk), srapid(npiglo, npk) ) ALLOCATE ( itmaskrapid(npiglo , npk) ) ALLOCATE ( gdept(npk) ) ALLOCATE ( zwk(npiglo, 1), de1rapid(npiglo), dmv(npiglo), dmt(npiglo), dtaux(npiglo,1) ) ALLOCATE ( damocrapid(1,1,npk), gdepw(npk), e31d(npk) ) ALLOCATE ( dtrp(1,1,1) ) ALLOCATE ( rdumlon(1,1), rdumlat(1,1), tim(npt) ) zwk(:,:) = getvar (cn_fhgr, cn_gphiv, 1, npiglo, 1, kimin=iiw,kjmin=ijrapid ) rdumlon(:,:) = 0.0 rdumlat(:,:) = zwk(1,1) IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk ) DO jk = 1, npk IF ( lfull ) THEN e3vrapid(:,jk) = e31d(jk) ELSE zwk(:,:) = getvar(cn_fzgr,'e3v_ps',jk,npiglo,1,kimin=iiw,kjmin=ijrapid,ldiom=.TRUE.) e3vrapid(:,jk) = zwk(:,1) ENDIF ENDDO zwk(:,:) = getvar (cn_fhgr, cn_ve1v, 1, npiglo, 1, kimin=iiw,kjmin=ijrapid ) de1rapid(:) = zwk(:,1) gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk ) DO jk = 1, npk zwk(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, 1, kimin=iiw,kjmin=ijrapid ) itmaskrapid(:,jk) = zwk(:,1) ENDDO gdept(:) = getvare3(cn_fzgr, cn_gdept, npk ) ! prepare output dataset: 7 variables ! add 12 new variables for CLIVAR GSOP-GODAE intercomparison cf_moc = 'rapid_moc.nc' nvarout = 33 ALLOCATE ( stypvar(nvarout), ipk(nvarout), id_varout(nvarout) ) stypvar%cunits = 'Sverdrup' stypvar%rmissing_value = 99999. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%scale_factor = 1. stypvar%add_offset = 0. stypvar%savelog10 = 0. stypvar%conline_operation = 'N/A' stypvar%caxis = 'T' ipk(:) = 1 ! only amoc_rapid has ipk=npk ! overturning classical way stypvar(1)%cname = 'amoc_rapid' stypvar(1)%clong_name = 'Rapid Overturning ' stypvar(1)%cshort_name = 'amoc_rapid' ipk(1) = npk stypvar(2)%cname = 'tr_GS' stypvar(2)%clong_name = 'Gulf Stream Contribution (Q2)' stypvar(2)%cshort_name = 'tr_GS' stypvar(3)%cname = 'tr_THERM' stypvar(3)%clong_name = 'Overturning contrib of Thermocline waters' stypvar(3)%cshort_name = 'tr_THERM' stypvar(4)%cname = 'tr_AIW' stypvar(4)%clong_name = 'Overturning contrib of intermediate waters' stypvar(4)%cshort_name = 'tr_AIW' stypvar(5)%cname = 'tr_UNADW' stypvar(5)%clong_name = 'Overturning contrib of Upper NADW ' stypvar(5)%cshort_name = 'tr_UNADW' stypvar(6)%cname = 'tr_LNADW' stypvar(6)%clong_name = 'Overturning contrib of Lower NADW ' stypvar(6)%cshort_name = 'tr_LNADW' stypvar(7)%cname = 'tr_BW' stypvar(7)%clong_name = 'Overturning contrib of Bottom Waters' stypvar(7)%cshort_name = 'tr_BW' ! additional new variables: ! # 1 in Keith Haines document stypvar(8)%cname = 'Total_max_amoc_rapid' stypvar(8)%clong_name = 'Total Max Rapid Overturning (Q1)' stypvar(8)%cshort_name = 'Total_max_amoc_rapid' ! # 2 is tr_GS: see stypvar(2) (Q2) ! # 3 in Keith Haines document stypvar(9)%cname = 'tr_EKMAN' stypvar(9)%clong_name = 'Total Ekman transport (Q3)' stypvar(9)%cshort_name = 'tr_EKMAN' ! # 4 in Keith Haines document stypvar(10)%cname = 'tr_TOTAL' stypvar(10)%clong_name = 'Total transport at 26.5N (Q4)' stypvar(10)%cshort_name = 'tr_TOTAL' ! # 5.1 in Keith Haines document ! Total section V idvar = 11 stypvar(idvar)%cunits = 'm.s**-1' stypvar(idvar)%cname = 'mean_v_total_section' stypvar(idvar)%clong_name = 'Total section mean meridional velocity at 26.5N (Q5)' stypvar(idvar)%cshort_name = 'mean_V_total_section' ! Florida section V idvar = 12 stypvar(idvar)%cunits = 'm.s**-1' stypvar(idvar)%cname = 'mean_v_Florida_section' stypvar(idvar)%clong_name = 'Florida section mean meridional velocity at 26.5N (Q5)' stypvar(idvar)%cshort_name = 'mean_V_Florida_section' ! MidOcean section V idvar = 13 stypvar(idvar)%cunits = 'm.s**-1' stypvar(idvar)%cname = 'mean_v_MidOcean_section' stypvar(idvar)%clong_name = 'MidOcean section mean meridional velocity at 26.5N (Q5)' stypvar(idvar)%cshort_name = 'mean_V_MidOcean_section' ! Total section T idvar = 14 stypvar(idvar)%cunits = 'deg. Celsius' stypvar(idvar)%cname = 'mean_T_total_section' stypvar(idvar)%clong_name = 'Total section mean Temperature at 26.5N (Q5)' stypvar(idvar)%cshort_name = 'mean_T_total_section' ! Florida section T idvar = 15 stypvar(idvar)%cunits = 'deg. Celsius' stypvar(idvar)%cname = 'mean_T_Florida_section' stypvar(idvar)%clong_name = 'Florida section mean Temperature at 26.5N (Q5)' stypvar(idvar)%cshort_name = 'mean_T_Florida_section' ! MidOcean section T idvar = 16 stypvar(idvar)%cunits = 'deg. Celsius' stypvar(idvar)%cname = 'mean_T_MidOcean_section' stypvar(idvar)%clong_name = 'MidOcean section mean Temperature at 26.5N (Q5)' stypvar(idvar)%cshort_name = 'mean_T_MidOcean_section' ! Total section S idvar = 17 stypvar(idvar)%cunits = 'PSU' stypvar(idvar)%cname = 'mean_S_total_section' stypvar(idvar)%clong_name = 'Total section mean Salinity at 26.5N (Q5)' stypvar(idvar)%cshort_name = 'mean_S_total_section' ! Florida section S idvar = 18 stypvar(idvar)%cunits = 'PSU' stypvar(idvar)%cname = 'mean_S_Florida_section' stypvar(idvar)%clong_name = 'Florida section mean Salinity at 26.5N (Q5)' stypvar(idvar)%cshort_name = 'mean_S_Florida_section' ! MidOcean section S idvar = 19 stypvar(idvar)%cunits = 'PSU' stypvar(idvar)%cname = 'mean_S_MidOcean_section' stypvar(idvar)%clong_name = 'MidOcean section mean Salinity at 26.5N (Q5)' stypvar(idvar)%cshort_name = 'mean_S_MidOcean_section' ! # 6 in Keith Haines document idvar = 20 stypvar(idvar)%cunits = 'Sv*deg. Celsius' stypvar(idvar)%cname = 'MO_meanVtimesmeanT' stypvar(idvar)%clong_name = 'Mid Ocean mean V x mean T at 26.5N (Q6)' stypvar(idvar)%cshort_name = 'MO_meanVtimesmeanT' ! # 6 in Keith Haines document idvar = 21 stypvar(idvar)%cunits = 'Sv*deg. Celsius' stypvar(idvar)%cname = 'MO_meanVtimesmeanS' stypvar(idvar)%clong_name = 'Mid Ocean mean V x mean S at 26.5N (Q6)' stypvar(idvar)%cshort_name = 'MO_meanVtimesmeanS' ! # 7.1 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*deg. Celsius' stypvar(idvar)%cname = 'Total_temp_transport' stypvar(idvar)%clong_name = 'Total temperature transport V x T at 26.5N (Q7)' stypvar(idvar)%cshort_name = 'Total_temp_transport' ! # 7.2 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*deg. Celsius' stypvar(idvar)%cname = 'Florida_temp_transport' stypvar(idvar)%clong_name = 'Florida section temperature transport V x T at 26.5N (Q7)' stypvar(idvar)%cshort_name = 'Florida_temp_transport' ! # 7.3 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*deg. Celsius' stypvar(idvar)%cname = 'MidOcean_temp_transport' stypvar(idvar)%clong_name = 'MidOcean section temperature transport V x T at 26.5N (Q7)' stypvar(idvar)%cshort_name = 'MidOcean_temp_transport' ! # 8.1 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*deg. Celsius' stypvar(idvar)%cname = 'Ekman_temp_transport_SST' stypvar(idvar)%clong_name = 'Ekman temperature transport based on SST at 26.5N (Q8.1)' stypvar(idvar)%cshort_name = 'Total_temp_transport_SST' ! # 8.2 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*deg. Celsius' stypvar(idvar)%cname = 'Ekman_temp_transport_T100' stypvar(idvar)%clong_name = 'Ekman temperature transport based on T100m at 26.5N (Q8.2)' stypvar(idvar)%cshort_name = 'Total_temp_transport_T100' ! # 7.1 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*PSU' stypvar(idvar)%cname = 'Total_salt_transport' stypvar(idvar)%clong_name = 'Total salinity transport V x S at 26.5N (Q7)' stypvar(idvar)%cshort_name = 'Total_salt_transport' ! # 7.2 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*PSU' stypvar(idvar)%cname = 'Florida_salt_transport' stypvar(idvar)%clong_name = 'Florida section salinity transport V x S at 26.5N (Q7)' stypvar(idvar)%cshort_name = 'Florida_salt_transport' ! # 7.3 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*PSU' stypvar(idvar)%cname = 'MidOcean_salt_transport' stypvar(idvar)%clong_name = 'MidOcean section salinity transport V x S at 26.5N (Q7)' stypvar(idvar)%cshort_name = 'MidOcean_salt_transport' ! # 8.1 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*PSU' stypvar(idvar)%cname = 'Ekman_salt_transport_SSS' stypvar(idvar)%clong_name = 'Ekman salinity transport based on SSS at 26.5N (Q8.1)' stypvar(idvar)%cshort_name = 'Total_salt_transport_SSS' ! # 8.2 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*PSU' stypvar(idvar)%cname = 'Ekman_salt_transport_S100' stypvar(idvar)%clong_name = 'Ekman salinity transport based on S100m at 26.5N (Q8.2)' stypvar(idvar)%cshort_name = 'Total_salt_transport_S100' ! # 9 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*deg. Celsius' stypvar(idvar)%cname = 'Total_meanVtimesmeanT' stypvar(idvar)%clong_name = 'Throughflow temperature transport = mean V x mean T 26.5N (Q9)' stypvar(idvar)%cshort_name = 'Total_meanVtimesmeanT' ! # 9 in Keith Haines document idvar = idvar + 1 stypvar(idvar)%cunits = 'Sv*PSU' stypvar(idvar)%cname = 'Total_meanVtimesmeanS' stypvar(idvar)%clong_name = 'Throughflow salinity transport = mean V x mean S 26.5N (Q9)' stypvar(idvar)%cshort_name = 'Total_meanVtimesmeanS' PRINT*, 'idvar = ', idvar ncout = create ( cf_moc, 'none', 1, 1, npk, cdep=cn_vdepthw ) ierr = createvar ( ncout, stypvar, nvarout, ipk, id_varout ) ierr = putheadervar( ncout, cf_vfil, 1, 1, npk, pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdepw) DO jt = 1, npt ! Get variables V,dtaux,T,S DO jk = 1 , npk zwk(:,:) = getvar(cf_vfil,cn_vomecrty,jk,npiglo,1,kimin=iiw,kjmin=ijrapid, ktime = jt ) vrapid(:,jk) = zwk(:,1) ENDDO dtaux(:,:) = getvar(cf_ufil,cn_sozotaux,1, npiglo,1,kimin=iiw,kjmin=ijrapid, ktime = jt ) DO jk = 1 , npk zwk(:,:) = getvar(cf_tfil,cn_votemper,jk,npiglo,1,kimin=iiw,kjmin=ijrapid, ktime = jt ) trapid(:,jk) = zwk(:,1) ENDDO DO jk = 1 , npk zwk(:,:) = getvar(cf_sfil,cn_vosaline,jk,npiglo,1,kimin=iiw,kjmin=ijrapid, ktime = jt ) srapid(:,jk) = zwk(:,1) ENDDO ! mask missing values: vrapid(:,:) = vrapid(:,:) * itmaskrapid(:,:) ! vmask = tmask here dtaux(:,1) = dtaux (:,1) * itmaskrapid(:,1) ! APPROXIMATIF !! trapid(:,:) = trapid(:,:) * itmaskrapid(:,:) ! srapid(:,:) = srapid(:,:) * itmaskrapid(:,:) ! PRINT*, 'max vrapid ',MAXVAL(vrapid) PRINT*, 'max trapid ',MAXVAL(trapid) PRINT*, 'max srapid ',MAXVAL(srapid) PRINT*, 'max dtaux ',MAXVAL(ABS(dtaux)) ! 2) compute the amoc at 26.5 N, traditional way ( from top to bottom as in MOCHA) damocrapid(:,:,1) = 0.d0 dtrp(:,:,1) = 0.d0 ierr = putvar (ncout, id_varout(1), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) DO jk = 2, npk damocrapid(1,1,jk) = damocrapid(1,1,jk-1) DO ji = 1, npiglo ! remember : this is a local index damocrapid(1,1,jk) = damocrapid(1,1,jk) + vrapid(ji,jk-1) * de1rapid(ji) * e3vrapid(ji,jk-1)*1.d0 ENDDO dtrp(:,:,1) = damocrapid(:,:,jk) ierr = putvar (ncout, id_varout(1), REAL(dtrp(:,:,1)/1.d6), jk, 1, 1, ktime=jt) ENDDO ! 2.1) Total maximum AMOC (Q1) dtrp(1,1,1) = MAXVAL(damocrapid(:,:,:)) ierr = putvar (ncout, id_varout(8), REAL(dtrp(:,:,1)/1.d6) , 1, 1, 1, ktime=jt) PRINT *, 'JT = ', jt ,' Total maximum AMOC = ', REAL(dtrp(:,:,1)/1.d6) ! 3) compute the Gulf-stream transport (western most part of the section) dtrp(:,:,:) = 0.d0 DO ji = 1, npigs DO jk = 1, npk dtrp(1,1,1) = dtrp(1,1,1) + vrapid(ji,jk) * de1rapid(ji) * e3vrapid(ji,jk)*1.d0 ENDDO ENDDO ierr = putvar (ncout, id_varout(2), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) PRINT *, 'JT = ', jt ,' GS = ', dtrp(:,:,1)/1.d6,' Sv' ! 4) compute the contributions of the eastern part of the section, sorted by depth range DO jclass = 1, jp_class zmin = rp_zlim(jclass ) zmax = rp_zlim(jclass+1 ) dtrp(:,:,:) = 0.d0 DO ji = npigs+1 , npiglo DO jk = 1, npk ! use Nicolas Ferry code ( can be improved ) zbot = gdepw(jk) + e3vrapid(ji,jk) IF ( gdepw(jk) >= zmin .AND. zbot <= zmax ) zalpha=1.0 IF ( gdepw(jk) >= zmax .OR. zbot <= zmin ) zalpha=0.0 IF ( gdepw(jk) <= zmin .AND. zbot >= zmin ) & & zalpha = ( zbot - zmin ) / e3vrapid ( ji,jk) IF ( gdepw(jk) <= zmax .AND. zbot >= zmax ) & & zalpha = ( zmax - gdepw(jk)) / e3vrapid ( ji,jk) dtrp(1,1,1) = dtrp(1,1,1) + vrapid(ji,jk) * de1rapid(ji) * e3vrapid(ji,jk)*1.d0 * zalpha ENDDO ENDDO ierr = putvar (ncout, id_varout(jclass+2), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) PRINT *, 'JT = ', jt ,' trp_class:', zmin, zmax, dtrp(:,:,1)/1.d6,' Sv' END DO ! 5) compute the Total Ekman transport (#3) dtrp(:,:,:) = 0.d0 rho = 1020 zpi = 4.*ATAN(1.) f = 2.* 2.*zpi/86400.*SIN(rp_lat_rapid*zpi/180.) DO ji = 1, npiglo dtrp(1,1,1) = dtrp(1,1,1) - dtaux(ji,1) * de1rapid(ji) / (rho*f) *1.d0 ENDDO dtrek = dtrp(1,1,1)/1.d6 ! for future use ierr = putvar (ncout, id_varout(9), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) PRINT *, 'JT = ', jt ,' Total Ekman transport = ', dtrp(:,:,1)/1.d6,' Sv' ! 6) compute the Total transport (Florida to Africa) (#4) dtrp(:,:,:) = 0.d0 DO ji = 1, npiglo DO jk = 1, npk dtrp(1,1,1) = dtrp(1,1,1) + vrapid(ji,jk) * de1rapid(ji) * e3vrapid(ji,jk)*1.d0 ENDDO ENDDO ierr = putvar (ncout, id_varout(10), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) PRINT *, 'JT = ', jt ,' Total Transport = ', dtrp(:,:,1)/1.d6,' Sv' ! 7) Florida, MidOcean and Total section , area mean V, T, S (#5) cvarname = (/ 'V', 'T', 'S' /) DO jv = 1,3 IF ( jv == 1 ) var2d(:,:) = vrapid(:,:) ! V IF ( jv == 2 ) var2d(:,:) = trapid(:,:) ! T IF ( jv == 3 ) var2d(:,:) = srapid(:,:) ! S ! Total idvar=11+(jv-1)*3 ds = 0. ; dtrp(1,1,1) = 0.d0 DO ji = 1, npiglo DO jk = 1, npk ds0 = de1rapid(ji) * e3vrapid(ji,jk)*itmaskrapid(ji,jk)*1.d0 ds = ds + ds0 dtrp(1,1,1) = dtrp(1,1,1) + var2d(ji,jk) * ds0 *1.d0 ENDDO ENDDO ierr = putvar (ncout, id_varout(idvar), REAL(dtrp(:,:,1)/ds*1.d0), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' Mean '//cvarname(jv)//' Total section = ', dtrp(:,:,1)/ds,' u.S.I' ! Florida Straight idvar=11+(jv-1)*3+1 ds = 0. ; dtrp(1,1,1) = 0.d0 DO ji = 1, npigs DO jk = 1, npk ds0 = de1rapid(ji) * e3vrapid(ji,jk)*itmaskrapid(ji,jk)*1.d0 ds = ds + ds0 dtrp(1,1,1) = dtrp(1,1,1) + var2d(ji,jk) * ds0 *1.d0 ENDDO ENDDO ierr = putvar (ncout, id_varout(idvar), REAL(dtrp(:,:,1)/ds*1.d0), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' Mean '//cvarname(jv)//' Florida section = ', dtrp(:,:,1)/ds,' u.S.I' ! MidOcean idvar=11+(jv-1)*3+2 ds = 0. ; dtrp(1,1,1) = 0.d0 DO ji = npigs+1, npiglo DO jk = 1, npk ds0 = de1rapid(ji) * e3vrapid(ji,jk)*itmaskrapid(ji,jk)*1.d0 ds = ds + ds0 dtrp(1,1,1) = dtrp(1,1,1) + var2d(ji,jk) * ds0 *1.d0 ENDDO ENDDO ierr = putvar (ncout, id_varout(idvar), REAL(dtrp(:,:,1)/ds*1.d0), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' Mean '//cvarname(jv)//' MidOcean section = ', dtrp(:,:,1)/ds,' u.S.I' ENDDO ! jv ! 8) compute MidOcean mean V x mean T (#6) ! Compute zonal mean v(z) profile (East of Bahamas) ! Compute zonal mean T(z) profile (East of Bahamas) ! Compute vertical integral of v(z)*T(z) to get Sv x deg C cvarname = (/ 'T', 'S', ' ' /) DO jv = 1,2 IF ( jv == 1 ) var2d(:,:) = trapid(:,:) ! T IF ( jv == 2 ) var2d(:,:) = srapid(:,:) ! S dmv(:) = 0.d0 dmt(:) = 0.d0 DO jk = 1, npk ds = 0. DO ji = npigs+1, npiglo dmv(jk) = dmv(jk) + vrapid(ji,jk) * de1rapid(ji) *1.d0 dmt(jk) = dmt(jk) + var2d (ji,jk) * de1rapid(ji) *1.d0 ds = ds + de1rapid(ji) * itmaskrapid(ji,jk) *1.d0 ENDDO IF ( ds /= 0. ) dmv(jk) = dmv(jk) / ds IF ( ds /= 0. ) dmt(jk) = dmt(jk) / ds ENDDO ! vertical integral of dmv(jk)*dmt(jk) dtrp(1,1,1) = 0.d0 DO jk = 1, npk DO ji = npigs+1, npiglo dtrp(1,1,1) = dtrp(1,1,1) + dmv(jk) * dmt(jk) * de1rapid(ji) * e3vrapid(ji,jk)*1.d0 ENDDO ENDDO ierr = putvar (ncout, id_varout(20-1+jv), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' Total Transport of mean V x mean '//cvarname(jv)//'= ', & dtrp(:,:,1)/1.d6,' Sv.uSI' ENDDO ! 8) T / S Transports cvarname = (/ 'T', 'S', ' ' /) ndiag = 5 DO jv = 1,2 ! compute Total/Florida/MidOcean transport based on V and T/S at each grid point IF ( jv == 1 ) var2d(:,:) = trapid(:,:) ! T IF ( jv == 2 ) var2d(:,:) = srapid(:,:) ! S ! # 7.1 Total dtrp(:,:,:) = 0.d0 idvar=22+(jv-1)*ndiag DO ji = 1, npiglo DO jk = 1, npk !computation done at T points, fields already masked: dtrp(1,1,1) = dtrp(1,1,1) + vrapid(ji,jk) * var2d(ji,jk) * de1rapid(ji) * e3vrapid(ji,jk)*1.d0 ENDDO ENDDO ierr = putvar (ncout, id_varout(idvar), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' Total '//cvarname(jv)//' Transport = ', dtrp(:,:,1)/1.d6,' u.S.I' ! # 7.2 Florida dtrp(:,:,:) = 0.d0 idvar=23+(jv-1)*ndiag DO ji = 1, npigs DO jk = 1, npk dtrp(1,1,1) = dtrp(1,1,1) + vrapid(ji,jk) * var2d(ji,jk) * de1rapid(ji) * e3vrapid(ji,jk)*1.d0 ENDDO ENDDO ierr = putvar (ncout, id_varout(idvar), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' Florida '//cvarname(jv)//' Transport = ', dtrp(:,:,1)/1.d6,' u.S.I' ! # 7.3 MidOcean dtrp(:,:,:) = 0.d0 idvar=24+(jv-1)*ndiag DO ji = npigs+1, npiglo DO jk = 1, npk dtrp(1,1,1) = dtrp(1,1,1) + vrapid(ji,jk) * var2d(ji,jk) * de1rapid(ji) * e3vrapid(ji,jk)*1.d0 ENDDO ENDDO ierr = putvar (ncout, id_varout(idvar), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' MidOcean '//cvarname(jv)//' Transport = ', dtrp(:,:,1)/1.d6,' u.S.I' ! # 8.1 Ekman T/S transport based on SST/SSS dtrp(:,:,:) = 0.d0 idvar=25+(jv-1)*ndiag ds = 0.d0 jk = 1 DO ji = 1, npiglo dtrp(1,1,1) = dtrp(1,1,1) + var2d(ji,jk) * de1rapid(ji) * e3vrapid(ji,jk)*1.d0 ds = ds + de1rapid(ji) * e3vrapid(ji,jk)*itmaskrapid(ji,jk)*1.d0 ENDDO ierr = putvar (ncout, id_varout(idvar), REAL(dtrek*dtrp(:,:,1)/ds), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' Ekman '//cvarname(jv)//' Transport based on SST/S = ', dtrek*dtrp(:,:,1)/ds,' u.S.I' ! # 8.2 Ekman T/S transport based on T100/Syy100 dtrp(:,:,:) = 0.d0 idvar=26+(jv-1)*ndiag ds = 0.d0 ; jk100 = 0 DO jk = npk,1,-1 IF ( gdept(jk) >= 100. ) jk100 = jk ! to determine 100m depth index ENDDO PRINT *, gdept(jk100) ,' ~= 100 m for index jk = ',jk100 DO ji = 1, npiglo DO jk = 1, jk100 dtrp(1,1,1) = dtrp(1,1,1) + var2d(ji,jk) * de1rapid(ji) * e3vrapid(ji,jk)*1.d0 ds = ds + de1rapid(ji) * e3vrapid(ji,jk)*itmaskrapid(ji,jk)* 1.d0 ENDDO ENDDO ierr = putvar (ncout, id_varout(idvar), REAL(dtrek*dtrp(:,:,1)/ds), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' Total Ekman '//cvarname(jv)//' Transport based on T/S100= ', dtrek*dtrp(:,:,1)/ds,' u.S.I' ENDDO ! jv ! # 9 meanV x meanT Transport dtrp(:,:,:) = 0.d0 idvar=32 ds = 0.d0 ; dmv0 = 0.d0 ; dmt0 = 0.d0 ; dms0 = 0.d0 DO ji = 1, npiglo DO jk = 1, jk100 ds0 = de1rapid(ji) * e3vrapid(ji,jk)*itmaskrapid(ji,jk)*1.d0 ds = ds + ds0 dmv0 = dmv0 + vrapid(ji,jk)*ds0*1.d0 dmt0 = dmt0 + trapid(ji,jk)*ds0*1.d0 dms0 = dms0 + srapid(ji,jk)*ds0*1.d0 ENDDO ENDDO dtrp(1,1,1) = dmv0 * dmt0 / ds *1.d0 ierr = putvar (ncout, id_varout(idvar), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' Total throughflow temperature transport = ', REAL(dtrp(1,1,1)/1.d6),' Sv.deg C.' dtrp(1,1,1) = dmv0 * dms0 / ds *1.d0 idvar=33 ierr = putvar (ncout, id_varout(idvar), REAL(dtrp(:,:,1)/1.d6), 1, 1, 1, ktime=jt) PRINT *, TRIM(stypvar(idvar)%cname),' :' PRINT *, 'JT = ', jt ,' Total throughflow salinity transport = ', REAL(dtrp(1,1,1)/1.d6),' Sv.PSU' END DO ! time loop tim = getvar1d( cf_vfil, cn_vtimec, npt ) ierr = putvar1d( ncout, tim, npt, 'T') ierr = closeout( ncout ) END SUBROUTINE rapid_amoc END PROGRAM cdfmoc cdftools-3.0/cdfflxconv.f900000644000175000017500000005657112241227304017012 0ustar amckinstryamckinstryPROGRAM cdfflxconv !!------------------------------------------------------------------- !! PROGRAM CDFFLXCONV !! ****************** !! !! ** Purpose: Convert a set of fluxes dimgfile (Clipper like) !! to a set of CDF files (Drakkar like ) !! !! ** Method: takes the current year as input, and config name !! automatically read !! ECMWF.Y${year}.M??.FLUX.${config}.dimg (daily, 1 file per month) !! ECMWF.Y${year}.M??.STRESS.${config}.dimg (daily, 1 file per month) !! REYNOLDS.Y${year}.SST.${config}.dimg ( weekly, 1 file per year ) ! Danger ! !! creates 6 netcdf daily files : !! ECMWF_emp_1d_${year}.${config}.nc !! ECMWF_qnet_1d_${year}.${config}.nc !! ECMWF_qsr_1d_${year}.${config}.nc !! ECMWF_sst_1d_${year}.${config}.nc !! ECMWF_taux_1d_${year}.${config}.nc !! ECMWF_tauy_1d_${year}.${config}.nc !! Requires coordinates.diags file (to be input consistent) !! !! history: !! Original: J.M. Molines (Feb. 2007 ) !!------------------------------------------------------------------- !! $Rev$ !! $Date$ !! $Id$ !!-------------------------------------------------------------- !! !! * Modules used USE cdfio !! * Local variables IMPLICIT NONE INTEGER :: ji,jj,jk, jvar, jmonth, jdim, jday, jt INTEGER :: narg, iargc, nvar INTEGER :: npiglo,npjglo, npk !: size of the domain INTEGER :: iyear, icurrday, jul, jul1, jul2 INTEGER :: id1, id2, ii1, ii2, ntime, ntp, ntn, itt INTEGER :: january1, december31 INTEGER, DIMENSION(:), ALLOCATABLE :: itime REAL(KIND=4) , DIMENSION (:,:,:), ALLOCATABLE :: v2d REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glam, gphi, z2d, v2daily REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamu, gphiu REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamv, gphiv REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: dep, timetab REAL(KIND=8) , DIMENSION (:), ALLOCATABLE :: timetag, timetagp,timetagn REAL(KIND=4) ,DIMENSION(1) :: timean CHARACTER(LEN=256) :: ctag, confcase ! Dimg stuff INTEGER :: irecl, ii, nt, ndim, irec INTEGER :: numflx=10, numcoo=11, numtau=12, numsst=14, numsstp=15, numsstn=16 CHARACTER(LEN=256) :: cflux, ctau, csstr,csstrp, csstrn CHARACTER(LEN=256) :: coord='coordinates.diags' CHARACTER(LEN=256) :: cheader, cdum, config CHARACTER(LEN=4) :: cver REAL(KIND=4) :: x1,y1, dx,dy, spval ! coordinates.diags INTEGER :: nrecl8 REAL(KIND=8) :: zrecl8, zpiglo,zpjglo REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: dzvar CHARACTER(LEN=256) :: cltextco LOGICAL :: lexist ! Netcdf Stuff CHARACTER(LEN=256) :: cemp, cqnet, cqsr, ctaux, ctauy, csst TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvaremp,typvarqnet,typvarqsr TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvartaux,typvartauy,typvarsst INTEGER, DIMENSION(:), ALLOCATABLE :: ipkemp, ipkqnet, ipkqsr, id_varoutemp,id_varoutqnet, id_varoutqsr INTEGER, DIMENSION(:), ALLOCATABLE :: ipktaux, ipktauy, ipksst, id_varouttaux,id_varouttauy, id_varoutsst INTEGER :: ncoutemp, ncoutqnet, ncoutqsr, ncouttaux, ncouttauy, ncoutsst INTEGER :: istatus !! Read command line narg= iargc() IF ( narg /= 2 ) THEN PRINT *,' Usage : cdfflxconv YEAR config ' PRINT *,' Output 6 cdf files : for emp, qnet, qsr, sst, taux, tauy with standard var name :' PRINT *,' sowaflup, sohefldo, soshfldo, sst, sozotaux, sometauy ' PRINT *,' coordinates.diags ( clipper like) is required in current dir ' STOP ENDIF !! CALL getarg (1, cdum) READ(cdum,*) iyear CALL getarg (2, config) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! ..... FLUXES FLUXES FLUXES ..... !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT *, 'Doing fluxes ... ' !! read glam gphi in the coordinates file for T point (fluxes) nrecl8=200 OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8) READ(numcoo,rec=1) cltextco,zrecl8,zpiglo,zpjglo CLOSE(numcoo) nrecl8=zrecl8 ; npiglo=zpiglo ; npjglo=zpjglo ALLOCATE ( glam(npiglo,npjglo), gphi(npiglo,npjglo) ,dzvar(npiglo,npjglo) ) OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8) READ(numcoo,REC=2)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glam(:,:) = dzvar(:,:) READ(numcoo,REC=6)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphi(:,:) = dzvar(:,:) DEALLOCATE ( dzvar ) CLOSE(numcoo) !! build nc output files WRITE(cemp,'(a,I4.4,a)') 'ECMWF_emp_1d_',iyear,'.'//TRIM(config)//'.nc' WRITE(cqnet,'(a,I4.4,a)') 'ECMWF_qnet_1d_',iyear,'.'//TRIM(config)//'.nc' WRITE(cqsr,'(a,I4.4,a)') 'ECMWF_qsr_1d_',iyear,'.'//TRIM(config)//'.nc' jmonth=1 !! Build dimg file names WRITE(cflux,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.FLUX.'//TRIM(config)//'.dimg' ! WRITE(ctau ,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',imonth,'.STRESS.'//TRIM(config)//'.dimg' ! WRITE(csst ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg' ! open (and check ?? if they exists ) irecl=isdirect(cflux) ; OPEN( numflx,FILE=cflux, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk ALLOCATE (v2d(npiglo, npjglo,4), dep(npk) ) ALLOCATE (z2d(npiglo, npjglo) ) READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & timean(1) CLOSE(numflx) ! Build cdf files output nvar = 1 ! 1 var but many files ... (OK ... 3 actually ) ALLOCATE ( typvaremp(nvar), ipkemp(nvar), id_varoutemp(nvar) ) ALLOCATE ( typvarqnet(nvar), ipkqnet(nvar), id_varoutqnet(nvar) ) ALLOCATE ( typvarqsr(nvar), ipkqsr(nvar), id_varoutqsr(nvar) ) jvar=1 ipkemp(jvar) = 1 typvaremp(jvar)%cname='sowaflup' ! E - P = dim 3 - dim 4 dimgfile typvaremp(jvar)%cunits='kg/m2/s' typvaremp(jvar)%rmissing_value=0. typvaremp(jvar)%valid_min= -0.002 typvaremp(jvar)%valid_max= 0.002 typvaremp(jvar)%clong_name='E-P Upward water flux' typvaremp(jvar)%cshort_name='sowaflup' typvaremp(jvar)%conline_operation='N/A' typvaremp(jvar)%caxis='TYX' ipkqnet(jvar) = 1 typvarqnet(jvar)%cname='sohefldo' ! QNET = dim 1 dimgfile typvarqnet(jvar)%cunits='W/m2' typvarqnet(jvar)%rmissing_value=0. typvarqnet(jvar)%valid_min= -1000. typvarqnet(jvar)%valid_max= 1000. typvarqnet(jvar)%clong_name='Net_Downward_Heat_Flux' typvarqnet(jvar)%cshort_name='sohefldo' typvarqnet(jvar)%conline_operation='N/A' typvarqnet(jvar)%caxis='TYX' ipkqsr(jvar) = 1 typvarqsr(jvar)%cname='soshfldo' ! QSR = dim 2 dimgfile typvarqsr(jvar)%cunits='W/m2' typvarqsr(jvar)%rmissing_value=0. typvarqsr(jvar)%valid_min= -1000. typvarqsr(jvar)%valid_max= 1000. typvarqsr(jvar)%clong_name='Short_Wave_Radiation' typvarqsr(jvar)%cshort_name='soshfldo' typvarqsr(jvar)%conline_operation='N/A' typvarqsr(jvar)%caxis='TYX' ncoutemp =create(cemp, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncoutemp ,typvaremp,nvar, ipkemp,id_varoutemp ) istatus= putheadervar(ncoutemp, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ncoutqnet =create(cqnet, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncoutqnet ,typvarqnet,nvar, ipkqnet,id_varoutqnet ) istatus= putheadervar(ncoutqnet, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ncoutqsr =create(cqsr, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncoutqsr ,typvarqsr,nvar, ipkqsr,id_varoutqsr ) istatus= putheadervar(ncoutqsr, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ! Ready for time loop on month icurrday=0 DO jmonth = 1, 12 WRITE(cflux,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.FLUX.'//TRIM(config)//'.dimg' irecl=isdirect(cflux) ; OPEN( numflx,FILE=cflux, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim ! loop for days in files DO jday=1,nt icurrday=icurrday +1 DO jdim=1,ndim irec=1+(jday-1)*ndim +jdim READ(numflx,REC=irec) (( v2d(ji,jj,jdim),ji=1,npiglo),jj=1,npjglo) END DO ! emp z2d=(v2d(:,:,3) - v2d(:,:,4) )/ 86400. ! scaling from mm/d to kg/m2/s istatus = putvar(ncoutemp,id_varoutemp(1),z2d,icurrday,npiglo,npjglo) ! qnet istatus = putvar(ncoutqnet,id_varoutqnet(1),v2d(:,:,1),icurrday,npiglo,npjglo) ! qsr istatus = putvar(ncoutqsr,id_varoutqsr(1),v2d(:,:,2),icurrday,npiglo,npjglo) END DO ! loop on days CLOSE(numflx) END DO ! loop on month ! update time_counter ALLOCATE( timetab (icurrday) ) timetab=(/(jt,jt=1,icurrday)/) istatus=putvar1d(ncoutemp,timetab,icurrday,'T') istatus=putvar1d(ncoutqnet,timetab,icurrday,'T') istatus=putvar1d(ncoutqsr,timetab,icurrday,'T') ! close fluxes files istatus=closeout(ncoutemp) istatus=closeout(ncoutqnet) istatus=closeout(ncoutqsr) DEALLOCATE (v2d , dep, z2d , timetab ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! ..... STRESSES STRESSES STRESSES ...... !!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT *,' Doing Stresses ...' !! read glam gphi in the coordinates file for U point (fluxes) nrecl8=200 OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8) READ(numcoo,rec=1) cltextco,zrecl8,zpiglo,zpjglo CLOSE(numcoo) nrecl8=zrecl8 ; npiglo=zpiglo ; npjglo=zpjglo ALLOCATE ( glamu(npiglo,npjglo), gphiu(npiglo,npjglo) ,dzvar(npiglo,npjglo) ) ALLOCATE ( glamv(npiglo,npjglo), gphiv(npiglo,npjglo) ) OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8) READ(numcoo,REC=3)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamu(:,:) = dzvar(:,:) READ(numcoo,REC=7)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiu(:,:) = dzvar(:,:) READ(numcoo,REC=4)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamv(:,:) = dzvar(:,:) READ(numcoo,REC=8)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiv(:,:) = dzvar(:,:) DEALLOCATE ( dzvar ) CLOSE(numcoo) !! build nc output files WRITE(ctaux,'(a,I4.4,a)') 'ECMWF_taux_1d_',iyear,'.'//TRIM(config)//'.nc' WRITE(ctauy,'(a,I4.4,a)') 'ECMWF_tauy_1d_',iyear,'.'//TRIM(config)//'.nc' jmonth=1 !! Build dimg file names WRITE(ctau ,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg' ! WRITE(csst ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg' ! open (and check ?? if they exists ) irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk ALLOCATE (v2d(npiglo, npjglo,2), dep(npk) ) ALLOCATE (z2d(npiglo, npjglo) ) READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & timean(1) CLOSE(numtau) ! Build cdf files output nvar = 1 ! 1 var but many files ... (OK ... 3 actually ) ALLOCATE ( typvartaux(nvar), ipktaux(nvar), id_varouttaux(nvar) ) ALLOCATE ( typvartauy(nvar), ipktauy(nvar), id_varouttauy(nvar) ) jvar=1 ipktaux(jvar) = 1 typvartaux(jvar)%cname='sozotaux' ! taux dim 1 of dimgfile typvartaux(jvar)%cunits='N/m2' typvartaux(jvar)%rmissing_value=0. typvartaux(jvar)%valid_min= -0.1 typvartaux(jvar)%valid_max= 0.1 typvartaux(jvar)%clong_name='Zonal Wind Stress' typvartaux(jvar)%cshort_name='sozotaux' typvartaux(jvar)%conline_operation='N/A' typvartaux(jvar)%caxis='TYX' ipktauy(jvar) = 1 typvartauy(jvar)%cname='sometauy' ! tauy dim 2 of dimgfile typvartauy(jvar)%cunits='N/m2' typvartauy(jvar)%rmissing_value=0. typvartauy(jvar)%valid_min= -0.1 typvartauy(jvar)%valid_max= 0.1 typvartauy(jvar)%clong_name='Meridional Wind Stress' typvartauy(jvar)%cshort_name='sometauy' typvartauy(jvar)%conline_operation='N/A' typvartauy(jvar)%caxis='TYX' ncouttaux =create(ctaux, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncouttaux ,typvartaux,nvar, ipktaux,id_varouttaux ) istatus= putheadervar(ncouttaux, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ncouttauy =create(ctauy, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncouttauy ,typvartauy,nvar, ipktauy,id_varouttauy ) istatus= putheadervar(ncouttauy, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ! Ready for time loop on month icurrday=0 DO jmonth = 1, 12 WRITE(ctau,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg' irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim ! loop for days in files DO jday=1,nt icurrday=icurrday +1 DO jdim=1,ndim irec=1+(jday-1)*ndim +jdim READ(numtau,REC=irec) (( v2d(ji,jj,jdim),ji=1,npiglo),jj=1,npjglo) END DO ! taux istatus = putvar(ncouttaux,id_varouttaux(1),v2d(:,:,1),icurrday,npiglo,npjglo) ! tauy istatus = putvar(ncouttauy,id_varouttauy(1),v2d(:,:,2),icurrday,npiglo,npjglo) END DO ! loop on days CLOSE(numtau) END DO ! loop on month ! update time_counter ALLOCATE( timetab (icurrday) ) timetab=(/(jt,jt=1,icurrday)/) istatus=putvar1d(ncouttaux,timetab,icurrday,'T') istatus=putvar1d(ncouttauy,timetab,icurrday,'T') ! close fluxes files istatus=closeout(ncouttaux) istatus=closeout(ncouttauy) DEALLOCATE (v2d , dep, z2d , timetab) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! ..... SST SST SST ..... !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT *,' Doing SST ...' !! glam gphi are already read ( T point) !! build nc output files WRITE(csst,'(a,I4.4,a)') 'REYNOLDS_sst_1d_',iyear,'.'//TRIM(config)//'.nc' !! Build dimg file names WRITE(csstr ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg' ! open (and check ?? if they exists ) irecl=isdirect(csstr) ; OPEN( numsst,FILE=csstr, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numsst,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt ALLOCATE (v2d(npiglo, npjglo,nt+2),itime(nt+2), dep(npk) ,timetab(nt), timetag(nt) ) ALLOCATE (z2d(npiglo, npjglo) ,v2daily(npiglo,npjglo) ) READ(numsst,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & (timetab(jt), jt=1,nt) timetag=timetab ! convert to dble precision DEALLOCATE(timetab) ! Build cdf files output nvar = 1 ! 1 var but many files ... (OK ... 3 actually ) ALLOCATE ( typvarsst(nvar), ipksst(nvar), id_varoutsst(nvar) ) jvar=1 ipksst(jvar) = 1 typvarsst(jvar)%cname='sst' ! sst dim 1 of dimgfile typvarsst(jvar)%cunits='C' typvarsst(jvar)%rmissing_value=0. typvarsst(jvar)%valid_min= -10. typvarsst(jvar)%valid_max= 50. typvarsst(jvar)%clong_name='Reynolds SST' typvarsst(jvar)%cshort_name='SST' typvarsst(jvar)%conline_operation='N/A' typvarsst(jvar)%caxis='TYX' ncoutsst =create(csst, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncoutsst ,typvarsst,nvar, ipksst,id_varoutsst ) istatus= putheadervar(ncoutsst, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ! We want to interpolate the data for every day. (weekly in the file) ! if first day of the file is not 01/01, needs to read previous year ! Clipper SST files are not y2k compliant ... IF (timetag (1) < 10000 ) THEN timetag(:)=timetag(:)+20000000. ELSE timetag(:)=timetag(:)+19000000. ENDIF january1=iyear*10000+01*100+01 december31=iyear*10000+12*100+31 jul1=julday(january1) jul2=julday(december31) itt=0 IF (jul1 < julday(INT(timetag(1))) ) THEN ! need to read previous year WRITE(csstrp ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear-1,'.SST.'//TRIM(config)//'.dimg' irecl=isdirect(csstrp) ; OPEN( numsstp,FILE=csstrp, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numsstp,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntp ALLOCATE (timetagp (ntp) ,timetab(ntp)) READ(numsstp,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntp, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & (timetab(jt), jt=1,ntp) timetagp=timetab DEALLOCATE(timetab) IF (timetagp (1) < 10000 ) THEN timetagp(:)=timetagp(:)+20000000. ELSE timetagp(:)=timetagp(:)+19000000. ENDIF IF ( julday(INT(timetagp (ntp))) <= jul1 ) THEN !read ntp sst as 1 data itt = itt +1 READ(numsstp,REC=ntp+1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday( INT(timetagp(ntp)) ) ELSE IF ( julday(INT(timetagp (ntp-1)) ) <= jul1 ) THEN itt = itt +1 READ(numsstp,REC=ntp) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT(timetagp(ntp-1)) ) ELSE IF ( julday(INT(timetagp (ntp-2) )) <= jul1 ) THEN itt = itt +1 READ(numsstp,REC=ntp-1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT(timetagp(ntp-2)) ) ELSE PRINT *,' Something is wrong in previous file SST ' ; STOP ENDIF ENDIF DO jt=1,nt itt = itt +1 READ(numsst,REC=jt+1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT(timetag(jt)) ) END DO IF ( jul2 > julday(INT(timetag(nt))) ) THEN ! need to read next year IF ( iyear == 2000 ) THEN ! persistance ... itt=itt+1 ; v2d(:,:,itt)= v2d(:,:,itt-1) ; itime(itt)=jul2 ELSE WRITE(csstrn ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear+1,'.SST.'//TRIM(config)//'.dimg' irecl=isdirect(csstrn) ; OPEN( numsstn,FILE=csstrn, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numsstn,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntn ALLOCATE (timetagn (ntn) ,timetab(ntn)) READ(numsstn,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntn, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & (timetab(jt), jt=1,ntn) timetagn=timetab DEALLOCATE( timetab) IF (timetagn (1) < 10000 ) THEN timetagn(:)=INT(timetagn(:))+20000000 ELSE timetagn(:)=INT(timetagn(:))+19000000 ENDIF IF ( julday(INT(timetagn (1) )) >= jul2 ) THEN !read 1 sst as 1 data itt = itt +1 READ(numsstn,REC=2) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT(timetagn(1)) ) ELSE IF ( julday(INT(timetagn (2)) ) >= jul2 ) THEN itt = itt +1 READ(numsstn,REC=3) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT( timetagn(2)) ) ELSE IF ( julday(INT(timetagn (3))) >= jul2 ) THEN itt = itt +1 READ(numsstn,REC=4) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT(timetagn(3)) ) ELSE PRINT *,' Something is wrong in next file SST ' ; STOP ENDIF ENDIF ENDIF ntime=itt icurrday=0 ii1=1 ; ii2 = 2 ; id1=itime(ii1) ; id2=itime(ii2) DO jul = jul1, jul2 icurrday=icurrday + 1 IF ( jul > id2 ) THEN ii1=ii1+1 ; ii2=ii2+1 ; id1=itime(ii1) ; id2=itime(ii2) ENDIF v2daily(:,:)=FLOAT((jul - id1 ))/(FLOAT(id2-id1))*(v2d(:,:,ii2) - v2d(:,:,ii1) ) + v2d(:,:,ii1) istatus = putvar(ncoutsst,id_varoutsst(1),v2daily(:,:),icurrday,npiglo,npjglo) END DO ! update time_counter ALLOCATE( timetab (icurrday) ) timetab=(/(jt,jt=1,icurrday)/) istatus=putvar1d(ncoutsst,timetab,icurrday,'T') ! close fluxes files istatus=closeout(ncoutsst) istatus=closeout(ncoutsst) DEALLOCATE (v2d , dep, z2d ) CONTAINS INTEGER FUNCTION isdirect(clname) !!! FUNCTION ISDIRECT !!! ***************** !!! !!! PURPOSE : This integer function returns the record length if clname !!! is a valid dimg file, it returns 0 either. !!! !!! METHOD : Open the file and look for the key characters (@!01) for !!! identification. !!! !!! AUTHOR : Jean-Marc Molines (Apr. 1998) !!! ------------------------------------------------------------------------- IMPLICIT NONE CHARACTER(LEN=*), INTENT(in) :: clname CHARACTER(LEN=4) :: cver CHARACTER(LEN=256) :: clheader ! INTEGER :: irecl ! OPEN(100,FILE=clname, FORM ='UNFORMATTED', ACCESS ='DIRECT', RECL =88) READ(100,REC=1) cver ,clheader,irecl CLOSE(100) ! IF (cver == '@!01' ) THEN isdirect=irecl ELSE isdirect=0 END IF ! END FUNCTION isdirect FUNCTION julday(kdastp) !! ------------------------------------------------------------------ !! *** FUNCTION JULDAY *** !! !! Purpose: This routine returns the julian day number which begins at noon !! of the calendar date specified by month kmm, day kid, and year kiyyy. !! positive year signifies a.d.; negative, b.c. (remember that the !! year after 1 b.c. was 1 a.d.) !! routine handles changeover to gregorian calendar on oct. 15, 1582. !! !! Method: This routine comes directly from the Numerical Recipe Book, !! press et al., numerical recipes, cambridge univ. press, 1986. !! !! Arguments: !! kdastp : OPA date yyyymmdd (instead of kmm kid kiyyy) !! kmm : input, corresponding month !! kid : input, corresponding day !! kiyyy : input, corresponding year, positive IF a.d, negative b.c. !! !! !! history !! 1998: J.M. Molines for the Doctor form. !! 2007 : J.M. Molines in F90 !! ----------------------------------------------------------------- ! * Declarations ! INTEGER :: julday, kiyyy,kid,kmm INTEGER, INTENT(in) ::kdastp ! * Local INTEGER, PARAMETER ::jpgreg=15+31*(10+12*1582) INTEGER :: iy, im, ia ! ... Year 0 never existed ... kiyyy=kdastp/10000 kmm=(kdastp - kiyyy*10000)/100 kid= kdastp - kiyyy*10000 - kmm*100 IF (kiyyy == 0) STOP 101 ! IF (kiyyy < 0) kiyyy = kiyyy + 1 IF (kmm > 2) THEN iy = kiyyy im = kmm + 1 ELSE iy = kiyyy - 1 im = kmm + 13 END IF ! julday = INT(365.25*iy) + INT(30.6001*im) + kid + 1720995 IF (kid+31*(kmm+12*kiyyy).GE.jpgreg) THEN ia = INT(0.01*iy) julday = julday + 2 - ia + INT(0.25*ia) END IF END FUNCTION JULDAY END PROGRAM cdfflxconv cdftools-3.0/modcdfnames.f900000644000175000017500000003157112241227304017127 0ustar amckinstryamckinstryMODULE modCdfNames !!====================================================================== !! *** MODULE modCdfNames *** !! Declare all dimension name, variable name, attribute name as variable !! This will ease the generalization of CDFTOOLS !!===================================================================== !! History : 3.0 ! 12/2010 ! J.M. Molines : Original code !! Modified: 3.0 ! 08/2010 ! P. Mathiot : Add LIM3 variables !!---------------------------------------------------------------------- IMPLICIT NONE PUBLIC ! Dimension name : cn_. [ 1 letter only ] CHARACTER(LEN=20) :: cn_x='x' !: longitude, I dimension CHARACTER(LEN=20) :: cn_y='y' !: latitude, J dimension CHARACTER(LEN=20) :: cn_z='depth' !: depth, z dimension CHARACTER(LEN=20) :: cn_t='time_counter' !: time dimension ! Dimension variable CHARACTER(LEN=20) :: cn_vlon2d = 'nav_lon' !: longitude CHARACTER(LEN=20) :: cn_vlat2d = 'nav_lat' !: latitude CHARACTER(LEN=20) :: cn_vdeptht = 'deptht' !: depth CHARACTER(LEN=20) :: cn_vdepthu = 'depthu' !: depth CHARACTER(LEN=20) :: cn_vdepthv = 'depthv' !: depth CHARACTER(LEN=20) :: cn_vdepthw = 'depthw' !: depth CHARACTER(LEN=20) :: cn_vtimec = 'time_counter' !: time ! Attribute of a variable CHARACTER(LEN=20) :: cn_missing_value = '_FillValue' !: missing value (to be replaced bby _Fill_Value) ! Metrics CHARACTER(LEN=20) :: cn_ve1t='e1t', cn_ve2t='e2t' !: e.t CHARACTER(LEN=20) :: cn_ve1u='e1u', cn_ve2u='e2u' !: e.u CHARACTER(LEN=20) :: cn_ve1v='e1v', cn_ve2v='e2v' !: e.v CHARACTER(LEN=20) :: cn_ve1f='e1f', cn_ve2f='e2f' !: e.v CHARACTER(LEN=20) :: cn_ve3t='e3t', cn_ve3w='e3w' !: e3. CHARACTER(LEN=20) :: cn_vff='ff' CHARACTER(LEN=20) :: cn_gdept='gdept', cn_gdepw='gdepw' !: 1d dep variable CHARACTER(LEN=20) :: cn_hdept='hdept', cn_hdepw='hdepw' !: 2d dep variable CHARACTER(LEN=20) :: cn_glamt='glamt', cn_gphit='gphit' !: glam gphi CHARACTER(LEN=20) :: cn_glamu='glamu', cn_gphiu='gphiu' !: glam gphi CHARACTER(LEN=20) :: cn_glamv='glamv', cn_gphiv='gphiv' !: glam gphi CHARACTER(LEN=20) :: cn_glamf='glamf', cn_gphif='gphif' !: glam gphi ! Generic mesh-mask file names cn_f... CHARACTER(LEN=20) :: cn_fzgr='mesh_zgr.nc' CHARACTER(LEN=20) :: cn_fhgr='mesh_hgr.nc' CHARACTER(LEN=20) :: cn_fmsk='mask.nc' CHARACTER(LEN=20) :: cn_fcoo='coordinates.nc' CHARACTER(LEN=20) :: cn_fbasins='new_maskglo.nc' ! Variable name : cn_v... [ starts with cn_v ] CHARACTER(LEN=20) :: cn_votemper='votemper' !: temperature CHARACTER(LEN=20) :: cn_vosaline='vosaline' !: salinity CHARACTER(LEN=20) :: cn_vozocrtx='vozocrtx' !: zonal velocity CHARACTER(LEN=20) :: cn_vomecrty='vomecrty' !: meridional velocity CHARACTER(LEN=20) :: cn_vomeeivv='vomeeivv' !: meridional Eddy Induced Velocity CHARACTER(LEN=20) :: cn_vovecrtz='vovecrtz' !: vertical velocity CHARACTER(LEN=20) :: cn_sossheig='sossheig' !: Sea Surface Height CHARACTER(LEN=20) :: cn_somxl010='somxl010' !: Mixed layer depth (density criterium) CHARACTER(LEN=20) :: cn_somxlt02='somxlt02' !: Mixed layer depth (temperature criterium) CHARACTER(LEN=20) :: cn_sozotaux='sozotaux' !: Zonal wind stress CHARACTER(LEN=20) :: cn_sohefldo='sohefldo' !: Total Heat FLux CHARACTER(LEN=20) :: cn_solhflup='solhflup' !: Latent Heat FLux CHARACTER(LEN=20) :: cn_sosbhfup='sosbhfup' !: Sensible heat Flux CHARACTER(LEN=20) :: cn_solwfldo='solwfldo' !: Long Wave downward Heat Flux CHARACTER(LEN=20) :: cn_soshfldo='soshfldo' !: Solar Heat FLux CHARACTER(LEN=20) :: cn_sowaflup='sowaflup' !: Fresh Water Flux CHARACTER(LEN=20) :: cn_sowaflcd='sowaflcd' !: Concentration Dilution water flux CHARACTER(LEN=20) :: cn_sowafldp='sowafldp' !: SSS damping water Flux CHARACTER(LEN=20) :: cn_iowaflup='iowaflup' !: Ice Ocean Water flux ( + = freezing, - = melting) CHARACTER(LEN=20) :: cn_soicecov='soicecov' !: Ice cover ! MOC variables CHARACTER(LEN=20) :: cn_zomsfatl='zomsfatl' !: moc in the Atlantic CHARACTER(LEN=20) :: cn_zomsfglo='zomsfglo' !: moc in the Global ocean CHARACTER(LEN=20) :: cn_zomsfpac='zomsfpac' !: moc in the Pacific CHARACTER(LEN=20) :: cn_zomsfinp='zomsfinp' !: moc in the Indo-Pacific CHARACTER(LEN=20) :: cn_zomsfind='zomsfind' !: moc in the Indian ocean CHARACTER(LEN=20) :: cn_zomsfinp0='zomsfinp0' !: moc in the Indo-Pacific Net ! transport variables CHARACTER(LEN=20) :: cn_vozout='vozout' !: product U x T at U point CHARACTER(LEN=20) :: cn_vomevt='vomevt' !: product V x T at V point CHARACTER(LEN=20) :: cn_vozous='vozous' !: product U x S at U point CHARACTER(LEN=20) :: cn_vomevs='vomevs' !: product V x S at V point CHARACTER(LEN=20) :: cn_sozout='sozout' !: product U x T at U point CHARACTER(LEN=20) :: cn_somevt='somevt' !: product V x T at V point CHARACTER(LEN=20) :: cn_sozous='sozous' !: product U x S at U point CHARACTER(LEN=20) :: cn_somevs='somevs' !: product V x S at V point CHARACTER(LEN=20) :: cn_sozoutrp='sozoutrp' !: vertically integrated trp at U point CHARACTER(LEN=20) :: cn_somevtrp='somevtrp' !: vertically integrated trp at V point ! density, isopycnal diagnostics CHARACTER(LEN=20) :: cn_vosigma0='vosigma0' !: potential density refered to surface CHARACTER(LEN=20) :: cn_vosigmai='vosigmai' !: potential density refered to a partiular depth CHARACTER(LEN=20) :: cn_vodepiso='vodepiso' !: depth of isopycnal CHARACTER(LEN=20) :: cn_isothick='isothick' !: isopycnal tickness (from cdfsigintegr) ! Passive tracer variable CHARACTER(LEN=20) :: cn_invcfc='invcfc' !: CFC inventory CHARACTER(LEN=20) :: cn_cfc11='cfc11' !: CFC concentration CHARACTER(LEN=20) :: cn_pendep='pendep' !: CFC penetration depth (from cdfpendep) ! ice variable names CHARACTER(LEN=20) :: cn_iicethic='iicethic' !: ice thickness CHARACTER(LEN=20) :: cn_ileadfra='ileadfra' !: ice concentration CHARACTER(LEN=20) :: cn_iicethic3='iicethic'!: ice thickness (LIM3) CHARACTER(LEN=20) :: cn_ileadfra3='iiceconc'!: ice concentration (LIM3) ! Bathymetry CHARACTER(LEN=20) :: cn_fbathymet='bathy_meter.nc' !: file Bathymetry in meters CHARACTER(LEN=20) :: cn_fbathylev='bathy_level.nc' !: file Bathymetry in levels CHARACTER(LEN=20) :: cn_bathymet='Bathymetry' !: variable Bathymetry in meters CHARACTER(LEN=20) :: cn_bathylev='bathy_level'!: variable Bathymetry in levels ! variables to be squared when performing cdfmoy INTEGER(KIND=4), PARAMETER :: jp_sqdvarmax=10 INTEGER(KIND=4) :: nn_sqdvar = 4 INTEGER(KIND=4), PRIVATE :: ji CHARACTER(LEN=15), DIMENSION(jp_sqdvarmax) :: cn_sqdvar = & & (/'vozocrtx','vomecrty','vovecrtz','sossheig',(' ', ji=jp_sqdvarmax-5,jp_sqdvarmax) /) ! variables eligible for 3rd moment computation when performing cdfmoy INTEGER(KIND=4), PARAMETER :: jp_cubvarmax=10 INTEGER(KIND=4) :: nn_cubvar = 2 CHARACTER(LEN=15), DIMENSION(jp_cubvarmax) :: cn_cubvar = & & (/'sossheig','votemper',(' ', ji=3,jp_cubvarmax) /) ! INTERFACE ! SUBROUTINE fdate( cldate) ! CHARACTER(LEN=24) :: cldate ! END SUBROUTINE fdate ! END INTERFACE PUBLIC :: ReadCdfNames PUBLIC :: PrintCdfNames !! NAMELIST STATEMENTS ! dimensions NAMELIST/namdim/ cn_x, cn_y, cn_z, cn_t ! dimensions ! dimension variables NAMELIST/namdimvar/ cn_vlon2d, cn_vlat2d NAMELIST/namdimvar/ cn_vdeptht, cn_vdepthu, cn_vdepthv, cn_vdepthw NAMELIST/namdimvar/ cn_vtimec ! attributes NAMELIST/namdimvar/ cn_missing_value ! metrics in coordinates, mesh_hgr NAMELIST/nammetrics/ cn_ve1t, cn_ve1u, cn_ve1v, cn_ve1f NAMELIST/nammetrics/ cn_ve2t, cn_ve2u, cn_ve2v, cn_ve2f NAMELIST/nammetrics/ cn_ve3t, cn_ve3w NAMELIST/nammetrics/ cn_vff NAMELIST/nammetrics/ cn_glamt, cn_glamu, cn_glamv, cn_glamf NAMELIST/nammetrics/ cn_gphit, cn_gphiu, cn_gphiv, cn_gphif ! mesh_zgr NAMELIST/nammetrics/ cn_gdept, cn_gdepw NAMELIST/nammetrics/ cn_hdept, cn_hdepw ! variables NAMELIST/namvars/ cn_votemper, cn_vosaline NAMELIST/namvars/ cn_vozocrtx, cn_vomecrty, cn_vomeeivv, cn_vovecrtz NAMELIST/namvars/ cn_sossheig, cn_somxl010, cn_somxlt02 NAMELIST/namvars/ cn_sohefldo, cn_solhflup, cn_sosbhfup NAMELIST/namvars/ cn_solwfldo, cn_soshfldo NAMELIST/namvars/ cn_sowaflup, cn_sowaflcd, cn_sowafldp, cn_iowaflup NAMELIST/namvars/ cn_zomsfatl, cn_zomsfglo, cn_zomsfpac, cn_zomsfinp, cn_zomsfind NAMELIST/namvars/ cn_vozout, cn_vomevt, cn_vozous, cn_vomevs NAMELIST/namvars/ cn_sozout, cn_somevt, cn_sozous, cn_somevs NAMELIST/namvars/ cn_sozoutrp, cn_somevtrp NAMELIST/namvars/ cn_soicecov NAMELIST/namvars/ cn_vosigma0, cn_vosigmai, cn_vodepiso, cn_isothick NAMELIST/namvars/ cn_iicethic, cn_ileadfra NAMELIST/namvars/ cn_invcfc, cn_cfc11, cn_pendep ! list of variable to be squared by cdfmoy NAMELIST/namsqdvar/ nn_sqdvar, cn_sqdvar ! list of variable to be cubed by cdfmoy ( option ) NAMELIST/namcubvar/ nn_cubvar, cn_cubvar ! name of mesh_mask files NAMELIST/nammeshmask/ cn_fzgr, cn_fhgr, cn_fmsk, cn_fcoo, cn_fbasins ! Bathymetry NAMELIST/nambathy/ cn_fbathymet, cn_fbathylev, cn_bathymet, cn_bathylev !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE ReadCdfNames () !!--------------------------------------------------------------------- !! *** ROUTINE ReadCdfNames *** !! !! ** Purpose : update the standard NetCdfName using a dedicated !! namelist ( nam_cdf_names ) !! !! ** Method : Look for this namelist in the following order : !! 1. current dir !! 2. HOME/CDTOOLS_cfg directory !! !! nam_cdf_nam can be adjusted with environment !! variable NAM_CDF_NAMES !! !!---------------------------------------------------------------------- CHARACTER(LEN=90) :: cl_namlist= 'nam_cdf_names' CHARACTER(LEN=20) :: cl_env = 'NAM_CDF_NAMES' CHARACTER(LEN=90) :: cldum, cl_home LOGICAL :: ll_exist INTEGER(KIND=4) :: inam = 10 !!---------------------------------------------------------------------- CALL getenv ('HOME', cl_home) ! Look for cdf namelist name CALL getenv (cl_env, cldum ) IF ( cldum /= ' ' ) cl_namlist = cldum ! Now look for existence of the namelist INQUIRE( FILE=cl_namlist, EXIST=ll_exist ) IF ( .NOT. ll_exist ) THEN cldum=TRIM(cl_home)//'/CDFTOOLS_cfg/'//TRIM(cl_namlist) cl_namlist=cldum INQUIRE( FILE=cl_namlist, EXIST= ll_exist ) IF ( .NOT. ll_exist ) THEN RETURN ! assuming that there is no need to read ! a namelist for cdf names ENDIF ENDIF PRINT *, ' CAUTION : dim names and variable names are now set according to ' PRINT *, ' ======= the following namelist : ', TRIM(cl_namlist) OPEN(inam, FILE=cl_namlist, RECL=200) REWIND(inam) READ(inam, namdim ) READ(inam, namdimvar ) READ(inam, nammetrics ) READ(inam, namvars ) READ(inam, nambathy ) READ(inam, namsqdvar ) READ(inam, nammeshmask ) CLOSE ( inam ) END SUBROUTINE ReadCdfNames SUBROUTINE PrintCdfNames() !!--------------------------------------------------------------------- !! *** ROUTINE PrintCdfNames *** !! !! ** Purpose : Print a namelist like file from the actual netcdf names !! !! ** Method : Use namelist facilities !! !!---------------------------------------------------------------------- CHARACTER(LEN=80) :: cl_filout='PrintCdfNames.namlist' CHARACTER(LEN=24) :: cl_date INTEGER(KIND=4) :: iout=3 !!---------------------------------------------------------------------- CALL fdate(cl_date) ! cl_date=fdate() OPEN(iout, FILE=cl_filout, RECL=200) WRITE(iout, '(a,a)' ) ' ! ', cl_date WRITE(iout, '(a)' ) ' ! Namelist automatically generated by PrintCdfNames ' WRITE(iout, '(a)' ) ' ! Do not edit without changing its name ... ' WRITE(iout, '(a)' ) ' ! ------------------------------------------' WRITE(iout, namdim ) WRITE(iout, namdimvar ) WRITE(iout, nammetrics ) WRITE(iout, namvars ) WRITE(iout, nambathy ) WRITE(iout,'(a)' ) ' ! Namelist entry namsqdvar needs manual formating before' WRITE(iout,'(a)' ) ' ! it can be used as input : put variables names in between '' ' WRITE(iout,'(a)' ) ' ! and separate variables by , ' WRITE(iout, namsqdvar ) WRITE(iout, nammeshmask ) CLOSE (iout) END SUBROUTINE PrintCdfNames END MODULE modCdfNames cdftools-3.0/cdfokubo-w.f900000644000175000017500000002371112241227304016704 0ustar amckinstryamckinstry PROGRAM cdfokubow !!--------------------------------------------------------------------------- !! *** PROGRAM cdfokubow *** !! !! ** Purpose: Compute the okubow weiss parameter on F-points for given gridU gridV files and variables (like cdfcurl routine) !! !! history : !! Original : B. Djath (August 2012) !!--------------------------------------------------------------------- !! $Rev: 256 $ !! $Date: 2012-08-31 19:49:27 +0200 (ven. 31 aout 2012) $ !! !!-------------------------------------------------------------- !! * Modules used USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! Copyright (c) 2012, B. Djath !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jt ! dummy loop index INTEGER(KIND=4) :: ilev ! level to be processed INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: narg, iargc ! browse command line INTEGER(KIND=4) :: ncout, ierr ! browse command line INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! output variable properties REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2v, e1u, e1f, e2f, e1t, e2t ! horizontql metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn ! velocity field REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zun, zvn ! working arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: okubow, fmask, tmask ! curl and fmask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rotn, cisah1, cisah2t, cisah2 ! curl and fmask REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter CHARACTER(LEN=256) :: cf_ufil, cf_vfil ! file names CHARACTER(LEN=256) :: cf_out = 'okubow.nc' ! output file name CHARACTER(LEN=256) :: cv_u, cv_v ! variable names CHARACTER(LEN=256) :: cldum ! dummy string TYPE (variable), DIMENSION(1) :: stypvar ! structure for attibutes LOGICAL :: lforcing = .FALSE. ! forcing flag LOGICAL :: lchk = .FALSE. ! flag for missing files LOGICAL :: lperio = .FALSE. ! flag for E-W periodicity !!---------------------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg /= 5 ) THEN PRINT *,' usage : cdfokubow U-file V-file U-var V-var lev' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute Okubo-Weiss parameter of a vector field, at a specified level.' PRINT *,' If level is specified as 0, assume that the input files are' PRINT *,' forcing files, presumably on A-grid. In this latter case, the' PRINT *,' vector field is interpolated on the C-grid. In any case, the' PRINT *,' curl is computed on the F-point.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' U-file : zonal component of the vector field.' PRINT *,' V-file : meridional component of the vector field.' PRINT *,' U-var : zonal component variable name' PRINT *,' V-var : meridional component variable name.' PRINT *,' lev : level to be processed. If set to 0, assume forcing file ' PRINT *,' in input.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fhgr),' and ', TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : sokubow (s^-2)' STOP ENDIF CALL getarg(1, cf_ufil) CALL getarg(2, cf_vfil) CALL getarg(3, cv_u ) CALL getarg(4, cv_v ) CALL getarg(5, cldum ) ; READ(cldum,*) ilev lchk = chkfile(cn_fhgr ) .OR. lchk lchk = chkfile(cn_fmsk ) .OR. lchk lchk = chkfile(cf_ufil ) .OR. lchk lchk = chkfile(cf_vfil ) .OR. lchk IF ( lchk ) STOP ! missing files ! define new variables for output stypvar(1)%cname = 'sokubow' stypvar(1)%cunits = 's-2' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -1000. stypvar(1)%valid_max = 1000. stypvar(1)%clong_name = 'Okubo_Weiss_param (okubow)' stypvar(1)%cshort_name = 'sokubow' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TYX' ipk(1) = 1 ! 2D npiglo = getdim(cf_ufil,cn_x) npjglo = getdim(cf_ufil,cn_y) npk = getdim(cf_ufil,cn_z) npt = getdim(cf_ufil,cn_t) PRINT *, 'npiglo = ',npiglo PRINT *, 'npjglo = ',npjglo PRINT *, 'npk = ',npk PRINT *, 'npt = ',npt PRINT *, 'ilev = ',ilev !test if lev exists IF ( (npk==0) .AND. (ilev > 0) ) THEN PRINT *, 'Problem : npk = 0 and lev > 0 STOP' STOP END IF ! if forcing field IF ( ilev==0 .AND. npk==0 ) THEN lforcing=.true. npk = 1 ; ilev=1 PRINT *, 'npk =0, assume 1' END IF IF ( npt==0 ) THEN PRINT *, 'npt=0, assume 1' npt=1 END IF ! check files and determines if the curl will be 2D of 3D ! ???????????? ! Allocate the memory ALLOCATE ( e1u(npiglo,npjglo) , e1f(npiglo,npjglo) ) ALLOCATE ( e2v(npiglo,npjglo) , e2f(npiglo,npjglo) ) ALLOCATE ( e1t(npiglo,npjglo) , e2t(npiglo,npjglo) ) ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) ) ALLOCATE ( zun(npiglo,npjglo) , zvn(npiglo,npjglo) ) ALLOCATE ( cisah1(npiglo,npjglo) , cisah2(npiglo,npjglo) ) ALLOCATE ( cisah2t(npiglo,npjglo) , tmask(npiglo,npjglo) ) ALLOCATE ( okubow(npiglo,npjglo) , fmask(npiglo,npjglo) ) ALLOCATE ( rotn(npiglo,npjglo) , tim(npt) ) e1u = getvar(cn_fhgr, cn_ve1u, 1, npiglo, npjglo) e1f = getvar(cn_fhgr, cn_ve1f, 1, npiglo, npjglo) e2v = getvar(cn_fhgr, cn_ve2v, 1, npiglo, npjglo) e2f = getvar(cn_fhgr, cn_ve2f, 1, npiglo, npjglo) e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) ! use zun and zvn to store f latitude and longitude for output zun = getvar(cn_fhgr, cn_glamf, 1, npiglo, npjglo) zvn = getvar(cn_fhgr, cn_gphif, 1, npiglo, npjglo) ! look for E-W periodicity IF ( zun(1,1) == zun(npiglo-1,1) ) lperio = .TRUE. ! create output fileset ncout = create (cf_out, cf_ufil, npiglo, npjglo, 0 ) ierr = createvar (ncout , stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_ufil, npiglo, npjglo, 0, pnavlon=zun, pnavlat=zvn ) tim = getvar1d(cf_ufil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jt=1,npt IF (MOD(jt,100)==0 ) PRINT *, jt,'/',npt ! if files are forcing fields zun(:,:) = getvar(cf_ufil, cv_u, ilev ,npiglo,npjglo, ktime=jt) zvn(:,:) = getvar(cf_vfil, cv_v, ilev ,npiglo,npjglo, ktime=jt) tmask(:,:) = getvar(cn_fmsk, 'tmask', ilev , npiglo, npjglo) IF ( lforcing ) THEN ! for forcing file u and v are on the A grid DO ji=1, npiglo-1 un(ji,:) = 0.5*(zun(ji,:) + zun(ji+1,:)) END DO ! DO jj=1, npjglo-1 vn(:,jj) = 0.5*(zvn(:,jj) + zvn(:,jj+1)) END DO ! end compute u and v on U and V point ELSE un(:,:) = zun(:,:) vn(:,:) = zvn(:,:) END IF ! compute the mask IF ( jt==1 ) THEN DO jj = 1, npjglo - 1 DO ji = 1, npiglo - 1 fmask(ji,jj)=0. fmask(ji,jj)= un(ji,jj)*un(ji,jj+1) * vn(ji,jj)*vn(ji+1,jj) IF (fmask(ji,jj) /= 0.) fmask(ji,jj)=1. ENDDO ENDDO END IF rotn(:,:) = 0. ; cisah1(:,:) = 0. ; cisah2t(:,:) = 0. ; cisah2(:,:) = 0. ;okubow(:,:) = 0. DO jj = 1, npjglo -1 DO ji = 1, npiglo -1 ! vector opt. rotn(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ) - e2v(ji,jj) * vn(ji,jj) & & - e1u(ji ,jj+1) * un(ji ,jj+1) + e1u(ji,jj) * un(ji,jj) ) & & * fmask(ji,jj) / ( e1f(ji,jj) * e2f(ji,jj) ) ! quantity on f grid cisah1(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ) - e2v(ji,jj) * vn(ji,jj) & & + e1u(ji ,jj+1) * un(ji ,jj+1) - e1u(ji,jj) * un(ji,jj) ) & & * fmask(ji,jj) / ( e1f(ji,jj) * e2f(ji,jj) ) ! quantity on f grid cisah2t(ji,jj) = ( e1u(ji+1,jj ) * un(ji+1,jj ) - e1u(ji,jj) * un(ji,jj) & & - e2v(ji ,jj+1) * vn(ji ,jj+1) + e2v(ji,jj) * vn(ji,jj) ) & & * tmask(ji,jj) / ( e1t(ji,jj) * e2t(ji,jj) ) ! quantity on T grid cisah2(ji,jj) = 0.25 * fmask(ji,jj) * ( cisah2t(ji,jj) * cisah2t(ji,jj) & & + cisah2t(ji+1,jj) * cisah2t(ji+1,jj) + cisah2t(ji,jj+1) & & * cisah2t(ji,jj+1) + cisah2t(ji+1,jj+1) * cisah2t(ji+1,jj+1) ) ! quantity computed on f grid okubow(ji,jj) = cisah1(ji,jj) * cisah1(ji,jj) + cisah2(ji,jj) - rotn(ji,jj)*rotn(ji,jj) END DO END DO IF ( lperio ) okubow(npiglo,:) = okubow(2, :) ! write rotn on file at level k and at time jt ierr = putvar(ncout, id_varout(1), okubow, 1, npiglo, npjglo, ktime=jt) END DO ierr = closeout(ncout) END PROGRAM cdfokubow cdftools-3.0/cdfmoyt.f900000644000175000017500000003377312241227304016322 0ustar amckinstryamckinstryPROGRAM cdfmoyt !!====================================================================== !! *** PROGRAM cdfmoyt *** !!===================================================================== !! ** Purpose : Compute mean values for all the variables in a bunch !! of cdf files given as arguments. !! Store the results on a 'similar' cdf file. This version !! differ from cdfmoy, because if the input files have many !! time frames in it, the output file will have the same !! number of time frames, each being the average accross the !! input files. !! !! ** Method : Also store the mean squared values for the nn_sqdvar !! variables belonging to cn_sqdvar(:), than can be changed !! in the nam_cdf_names namelist if wished. !! !! History : 2.0 : 11/2004 : J.M. Molines : Original code !! : 2.1 : 06/2007 : P. Mathiot : Modif for forcing fields !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! varchk2 : check if variable is candidate for square mean !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!----------------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jfil, jrec ! dummy loop index INTEGER(KIND=4) :: jvar, jv, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: inpt ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! browsing command line INTEGER(KIND=4) :: nfil ! number of files to average INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! number of variables in a file INTEGER(KIND=4) :: ntframe ! cumul of time frame INTEGER(KIND=4) :: ncout, ncout2 ! ncid of output files INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! varid's of average vars INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout2 ! varid's of sqd average vars REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! array to read a layer of data REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zspval_in ! input missing value REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtab, dtab2 ! arrays for cumulated values REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dtotal_time ! to compute mean time CHARACTER(LEN=256) :: cf_in ! input file names CHARACTER(LEN=256) :: cf_out = 'cdfmoy.nc' ! output file for average CHARACTER(LEN=256) :: cf_out2 = 'cdfmoy2.nc' ! output file for squared average CHARACTER(LEN=256) :: cv_dep ! depth dimension name CHARACTER(LEN=256) :: cldum ! dummy string argument CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cf_list ! list of input files CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nam ! array of var name CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nam2 ! array of var2 name for output TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! attributes for average values TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar2 ! attributes for square averaged values LOGICAL :: lspval0 = .FALSE. ! cdfmoy_chsp flag !!---------------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmoyt list_of_model_files [-spval0] ' PRINT *,' PURPOSE :' PRINT *,' Compute the time average of a list of files given as arguments.' PRINT *,' This program handle multi time-frame files is such a way that' PRINT *,' the output files are also multi time-frame, each frame being' PRINT *,' the average across the files given in the list.' PRINT *,' ' PRINT *,' The program assume that all files in the list are of same' PRINT *,' type (shape, variables , and number of time frames ). ' PRINT *,' For some variables, the program also compute the time average ' PRINT *,' of the squared variables, which is used in other cdftools ' PRINT *,' (cdfeke, cdfrmsssh, cdfstdevw, cdfstddevts ... The actual variables' PRINT *,' selected for squared average are :' PRINT '(10x,"- ",a)' , (TRIM(cn_sqdvar(jv)), jv=1, nn_sqdvar) PRINT *,' This selection can be adapted with the nam_cdf_namelist process.' PRINT *,' (See cdfnamelist -i for details).' PRINT *,' If you want to compute the average of already averaged files,' PRINT *,' consider using cdfmoy_weighted instead, in order to take into' PRINT *,' account a particular weight for each file in the list.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' A list of similar model output files. ' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -spval0 ] : set missing_value attribute to 0 for all output' PRINT *,' variables and take care of the input missing_value.' PRINT *,' This option is usefull if missing_values differ from files ' PRINT *,' to files; it was formely done by cdfmoy_chsp).' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none ' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out),' and ',TRIM(cf_out2) PRINT *,' variables : are the same than in the input files. For squared averages' PRINT *,' _sqd is append to the original variable name.' STOP ENDIF ALLOCATE ( cf_list(narg) ) ! look for -spval0 option and set up cf_list, nfil ijarg = 1 nfil = 0 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-spval0' ) ! option to reset spval to 0 in the output files lspval0 = .TRUE. CASE DEFAULT ! then the argument is a file nfil = nfil + 1 cf_list(nfil) = TRIM(cldum) END SELECT END DO ! Initialisation from 1rst file (all file are assume to have the same geometry) ! time counter can be different for each file in the list. It is read in the ! loop for files IF ( chkfile (cf_list(1)) ) STOP ! missing file cf_in = cf_list(1) npiglo = getdim (cf_in,cn_x) npjglo = getdim (cf_in,cn_y) npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr) npt = getdim (cf_in,cn_t) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'nav_lev',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'levels',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF ENDIF ENDIF ! check that all files have the same number of time frames ierr = 0 DO jfil = 1, nfil IF ( chkfile (cf_list(jfil) ) ) STOP ! missing file inpt = getdim (cf_list(jfil), cn_t) IF ( inpt /= npt ) THEN PRINT *, 'File ',TRIM(cf_list(jfil) ),' has ',inpt,' time frames instead of ', npt ierr = ierr + 1 ENDIF ENDDO IF ( ierr /= 0 ) STOP ! frame numbers mismatch PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE( dtab(npiglo,npjglo), dtab2(npiglo,npjglo), v2d(npiglo,npjglo) ) ALLOCATE( dtotal_time(npt), tim(npt) ) nvars = getnvar(cf_in) PRINT *,' nvars = ', nvars ALLOCATE (cv_nam(nvars), cv_nam2(nvars) ) ALLOCATE (stypvar(nvars), stypvar2(nvars) ) ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars), id_varout2(nvars) ) ! get list of variable names and collect attributes in stypvar (optional) cv_nam(:) = getvarname(cf_in,nvars, stypvar) IF ( lspval0 ) THEN ALLOCATE ( zspval_in(nvars) ) zspval_in(:) = stypvar(:)%rmissing_value stypvar(:)%rmissing_value = 0. ENDIF DO jvar = 1, nvars ! variables that will not be computed or stored are named 'none' IF ( varchk2 ( cv_nam(jvar) ) ) THEN cv_nam2(jvar) = TRIM(cv_nam(jvar))//'_sqd' stypvar2(jvar)%cname = TRIM(stypvar(jvar)%cname)//'_sqd' ! name stypvar2(jvar)%cunits = '('//TRIM(stypvar(jvar)%cunits)//')^2' ! unit stypvar2(jvar)%rmissing_value = stypvar(jvar)%rmissing_value ! missing_value stypvar2(jvar)%valid_min = 0. ! valid_min = zero stypvar2(jvar)%valid_max = stypvar(jvar)%valid_max**2 ! valid_max *valid_max stypvar2(jvar)%scale_factor = 1. stypvar2(jvar)%add_offset = 0. stypvar2(jvar)%savelog10 = 0. stypvar2(jvar)%clong_name = TRIM(stypvar(jvar)%clong_name)//'_Squared' ! stypvar2(jvar)%cshort_name = TRIM(stypvar(jvar)%cshort_name)//'_sqd' ! stypvar2(jvar)%conline_operation = TRIM(stypvar(jvar)%conline_operation) stypvar2(jvar)%caxis = TRIM(stypvar(jvar)%caxis) ELSE cv_nam2(jvar) = 'none' END IF END DO id_var(:) = (/(jv, jv=1,nvars)/) ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk (cf_in,nvars,cdep=cv_dep) WHERE( ipk == 0 ) cv_nam='none' stypvar( :)%cname = cv_nam stypvar2(:)%cname = cv_nam2 ! create output file taking the sizes in cf_in ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep) ierr = createvar (ncout , stypvar, nvars, ipk, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk, cdep=cv_dep) ncout2 = create (cf_out2, cf_in, npiglo, npjglo, npk, cdep=cv_dep) ierr = createvar (ncout2, stypvar2, nvars, ipk, id_varout2 ) ierr = putheadervar(ncout2, cf_in, npiglo, npjglo, npk, cdep=cv_dep) ! Compute the mean time for each mean frame dtotal_time(:) = 0.d0 DO jfil = 1, nfil cf_in = cf_list(jfil) tim(:) = getvar1d(cf_in, cn_vtimec, npt) dtotal_time(:) = dtotal_time(:) + tim (:) END DO tim(:) = dtotal_time(:)/ nfil ierr = putvar1d(ncout, tim, npt, 'T') ierr = putvar1d(ncout2, tim, npt, 'T') DO jrec = 1, npt DO jvar = 1,nvars IF ( cv_nam(jvar) == cn_vlon2d .OR. & ! nav_lon cv_nam(jvar) == cn_vlat2d ) THEN ! nav_lat ! skip these variable ELSE PRINT *,' Working with ', TRIM(cv_nam(jvar)), ipk(jvar) DO jk = 1, ipk(jvar) PRINT *,'level ',jk dtab(:,:) = 0.d0 ; dtab2(:,:) = 0.d0 ntframe = 0 DO jfil = 1, nfil cf_in = cf_list(jfil) v2d(:,:) = getvar(cf_in, cv_nam(jvar), jk, npiglo, npjglo, ktime=jrec ) IF ( lspval0 ) WHERE (v2d == zspval_in(jvar)) v2d = 0. ! change missing values to 0 dtab(:,:) = dtab(:,:) + v2d(:,:) IF (cv_nam2(jvar) /= 'none' ) dtab2(:,:) = dtab2(:,:) + v2d(:,:)*v2d(:,:) END DO ! store variable on outputfile ierr = putvar(ncout, id_varout(jvar), SNGL(dtab(:,:)/nfil), jk, npiglo, npjglo, kwght=nfil, ktime = jrec ) IF (cv_nam2(jvar) /= 'none' ) THEN ierr = putvar(ncout2, id_varout2(jvar), SNGL(dtab2(:,:)/nfil), jk, npiglo, npjglo, kwght=nfil, ktime=jrec) ENDIF END DO ! loop to next level END IF END DO ! loop to next var in file END DO ! loop to next record in input file ierr = closeout(ncout) ierr = closeout(ncout2) CONTAINS LOGICAL FUNCTION varchk2 ( cd_var ) !!--------------------------------------------------------------------- !! *** FUNCTION varchk2 *** !! !! ** Purpose : Return true if cd_var is candidate for mean squared value !! !! ** Method : List of candidate is established in modcdfnames, and !! can be changed via the nam_cdf_names namelist !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cd_var INTEGER(KIND=4) :: jv !!---------------------------------------------------------------------- varchk2 = .FALSE. DO jv = 1, nn_sqdvar IF ( cd_var == cn_sqdvar(jv) ) THEN varchk2 = .TRUE. EXIT ENDIF ENDDO END FUNCTION varchk2 END PROGRAM cdfmoyt cdftools-3.0/cdfmean.f900000644000175000017500000004742712241227304016253 0ustar amckinstryamckinstryPROGRAM cdfmean !!====================================================================== !! *** PROGRAM cdfmean *** !!===================================================================== !! ** Purpose : Compute the Mean Value over the ocean or part of the !! ocean (spatial mean). !! !! ** Method : mean= sum( V * e1 *e2 * e3 *mask )/ sum( e1 * e2 * e3 *mask )) !! Partial cell version !! !! History : 2.1 : 10/2005 : J.M. Molines : Original code !! : 2.1 : 07/2009 : R. Dussin : Netcdf output !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index INTEGER(KIND=4) :: ik, ii, ivar ! INTEGER(KIND=4) :: iimin=0, iimax=0 ! domain limitation for computation INTEGER(KIND=4) :: ijmin=0, ijmax=0 ! domain limitation for computation INTEGER(KIND=4) :: ikmin=0, ikmax=0 ! domain limitation for computation INTEGER(KIND=4) :: narg, iargc, ijarg ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npiglo_fi ! size of the domain from input file INTEGER(KIND=4) :: npjglo_fi ! size of the domain from input file INTEGER(KIND=4) :: npk_fi ! size of the domain from input file INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvpk ! vertical levels in working variable INTEGER(KIND=4) :: numout=10 ! logical unit for mean output file INTEGER(KIND=4) :: numvar=11 ! logical unit for variance output file INTEGER(KIND=4) :: ikx=1, iky=1 ! dims of netcdf output file INTEGER(KIND=4) :: nvars ! number of values to write in cdf output INTEGER(KIND=4) :: ncout, ierr ! for netcdf output INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout REAL(KIND=4) :: zspval ! missing value REAL(KIND=4), DIMENSION(1,1) :: rdummy ! dummy variable REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1, e2, e3, zv ! metrics, velocity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! npiglo x npjglo REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon, rdumlat ! dummy lon/lat for output file REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdummymean ! array for mean value on output file REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdep ! depth REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zdep ! depth of the whole vertical levels REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! 1d vertical spacing REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=8) :: dvol, dsum, dsurf ! cumulated values REAL(KIND=8) :: dvol2d, dsum2d ! REAL(KIND=8) :: dvar2d, dvar ! for variance computing REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvmeanout ! spatial mean REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvariance ! spatial variance REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvmeanout3d ! global 3D mean value REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvariance3d ! global 3D mean variance CHARACTER(LEN=256) :: cv_nam ! current variable name CHARACTER(LEN=256) :: cv_dep ! deptht name CHARACTER(LEN=20) :: cv_e1, cv_e2 ! horizontal metrics names CHARACTER(LEN=20) :: cv_e3, cv_e31d ! vertical metrics names CHARACTER(LEN=20) :: cv_msk ! mask variable name CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cf_out = 'cdfmean.txt' ! ASCII output file for mean CHARACTER(LEN=256) :: cf_var = 'cdfvar.txt' ! ASCII output file for variance CHARACTER(LEN=256) :: cf_ncout = 'cdfmean.nc' ! NCDF output file CHARACTER(LEN=256) :: cf_zerom = 'zeromean.nc' ! NCDF output file with zeromean field CHARACTER(LEN=256) :: ctype ! type of C-grid point to work with CHARACTER(LEN=256) :: clunits ! attribute of output file : units CHARACTER(LEN=256) :: cllong_name ! " long name CHARACTER(LEN=256) :: clshort_name ! " short name CHARACTER(LEN=256) :: cglobal ! " global CHARACTER(LEN=256) :: cldum ! dummy char variable CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! list of file names TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvarin ! structure of input data TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvarzero ! structure of zeromean output LOGICAL :: lfull = .false.! full step flag LOGICAL :: lvar = .false.! variance flag LOGICAL :: lzeromean = .false.! zero mean flag LOGICAL :: lnodep = .false.! no depth flag LOGICAL :: lchk ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmean IN-file IN-var T|U|V|F|W [imin imax jmin jmax kmin kmax]' PRINT *,' ... [-full] [-var] [-zeromean] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Computes the mean value of the field (3D, weighted). For 3D fields,' PRINT *,' a horizontal mean for each level is also given. If a spatial window' PRINT *,' is specified, the mean value is computed only in this window.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : input netcdf file.' PRINT *,' IN-var : name of netcdf variable to work with.' PRINT *,' T|U|V|F|W : position of cdfvar on the C-grid' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [imin imax jmin jmax kmin kmax] : spatial windows where mean value ' PRINT *,' is computed:' PRINT *,' if imin = 0 then ALL i are taken' PRINT *,' if jmin = 0 then ALL j are taken' PRINT *,' if kmin = 0 then ALL k are taken' PRINT *,' [ -full ] : compute the mean for full steps, instead of default ' PRINT *,' partial steps.' PRINT *,' [ -var ] : also compute the spatial variance of cdfvar ' PRINT *,' [ -zeromean ] : create a file with cdfvar having a zero spatial mean.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' Files ', TRIM(cn_fhgr),', ', TRIM(cn_fzgr),', ', TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' - netcdf file : ', TRIM(cf_ncout) PRINT *,' variables : mean_cdfvar, mean_3D_cdfvar ' PRINT *,' [var_cdfvar, var_3D_cdfvar, in case of -var]' PRINT *,' - netcdf file : ', TRIM(cf_zerom),' [ in case of -zeromean option]' PRINT *,' variables : cdfvar' PRINT *,' - ASCII files : ', TRIM(cf_out) PRINT *,' [ ',TRIM(cf_var),', in case of -var ]' PRINT *,' - all output on ASCII files are also sent to standard output.' STOP ENDIF ! Open standard output with recl=256 to avoid wrapping of long lines (ifort) OPEN(6,FORM='FORMATTED',RECL=256) ! ifort ! OPEN(6,FORM='FORMATTED') ! gfortran cglobal = 'Partial step computation' ijarg = 1 ; ii = 0 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum ) ; ijarg = ijarg + 1 SELECT CASE (cldum) CASE ('-full' ) lfull = .true. cglobal = 'full step computation' CASE ('-var' ) lvar = .true. CASE ('-zeromean' ) lzeromean = .true. CASE DEFAULT ii=ii+1 SELECT CASE (ii) CASE ( 1 ) ; cf_in = cldum CASE ( 2 ) ; cv_nam = cldum CASE ( 3 ) ; ctype = cldum CASE ( 4 ) ; READ(cldum,*) iimin CASE ( 5 ) ; READ(cldum,*) iimax CASE ( 6 ) ; READ(cldum,*) ijmin CASE ( 7 ) ; READ(cldum,*) ijmax CASE ( 8 ) ; READ(cldum,*) ikmin CASE ( 9 ) ; READ(cldum,*) ikmax CASE DEFAULT PRINT *, ' ERROR : Too many arguments ...' STOP END SELECT END SELECT END DO lchk = chkfile(cn_fhgr) lchk = chkfile(cn_fzgr) .OR. lchk lchk = chkfile(cn_fmsk) .OR. lchk lchk = chkfile(cf_in ) .OR. lchk IF ( lchk ) STOP ! missing file cv_dep = 'none' npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in, 'z', cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in, 'sigma', cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in, 'nav_lev', cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF ENDIF npt = getdim (cf_in, cn_t) nvpk = getvdim(cf_in, cv_nam) ! save original npiglo, npiglo npiglo_fi = npiglo npjglo_fi = npjglo npk_fi = npk IF (npk == 0 ) THEN ; lnodep = .true.; npk = 1 ; ENDIF ! no depth dimension ==> 1 level IF (iimin /= 0 ) THEN ; npiglo = iimax -iimin + 1; ELSE ; iimin=1 ; ENDIF IF (ijmin /= 0 ) THEN ; npjglo = ijmax -ijmin + 1; ELSE ; ijmin=1 ; ENDIF IF (ikmin /= 0 ) THEN ; npk = ikmax -ikmin + 1; ELSE ; ikmin=1 ; ENDIF IF (nvpk == 2 ) nvpk = 1 IF (nvpk == 3 ) nvpk = npk WRITE(6, *) 'npiglo = ', npiglo WRITE(6, *) 'npjglo = ', npjglo WRITE(6, *) 'npk = ', npk WRITE(6, *) 'npt = ', npt WRITE(6, *) 'nvpk = ', nvpk WRITE(6, *) 'depth dim name is ', TRIM(cv_dep) ! Allocate arrays ALLOCATE ( zmask(npiglo,npjglo) ) ALLOCATE ( zv (npiglo,npjglo) ) ALLOCATE ( e1 (npiglo,npjglo), e2(npiglo,npjglo), e3(npiglo,npjglo) ) ALLOCATE ( gdep (npk), e31d(npk), tim(npt) , dvariance3d(npt), dvmeanout3d(npt) ) ALLOCATE ( zdep(npk_fi) ) SELECT CASE (TRIM(ctype)) CASE ( 'T' ) cv_e1 = cn_ve1t cv_e2 = cn_ve2t cv_e3 = 'e3t_ps' cv_e31d = cn_ve3t cv_msk = 'tmask' cv_dep = cn_gdept CASE ( 'U' ) cv_e1 = cn_ve1u cv_e2 = cn_ve2u cv_e3 = 'e3t_ps' cv_e31d = cn_ve3t cv_msk = 'umask' cv_dep = cn_gdept CASE ( 'V' ) cv_e1 = cn_ve1v cv_e2 = cn_ve2v cv_e3 = 'e3t_ps' cv_e31d = cn_ve3t cv_msk = 'vmask' cv_dep = cn_gdept CASE ( 'F' ) cv_e1 = cn_ve1f cv_e2 = cn_ve2f cv_e3 = 'e3t_ps' cv_e31d = cn_ve3t cv_msk = 'fmask' cv_dep = cn_gdept CASE ( 'W' ) cv_e1 = cn_ve1t cv_e2 = cn_ve2t cv_e3 = 'e3w_ps' cv_e31d = cn_ve3w cv_msk = 'tmask' cv_dep = cn_gdepw CASE DEFAULT PRINT *, 'this type of variable is not known :', TRIM(ctype) STOP END SELECT e1(:,:) = getvar (cn_fhgr, cv_e1, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin) e2(:,:) = getvar (cn_fhgr, cv_e2, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin) IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cv_e31d, npk) zdep(:) = getvare3(cn_fzgr, cv_dep, npk_fi) gdep(:) = zdep(ikmin:npk - ikmin + 1) IF ( lvar ) THEN nvars = 4 ! space for variance too ELSE nvars = 2 ! default value ENDIF ALLOCATE ( stypvar(nvars), ipk(nvars), id_varout(nvars) ) ALLOCATE ( rdumlon(ikx,iky), rdumlat(ikx,iky), rdummymean(ikx,iky) ) ALLOCATE ( dvmeanout(npk) ) IF ( lvar ) ALLOCATE ( dvariance(npk) ) rdumlon(:,:) = 0. rdumlat(:,:) = 0. ipk(1) = nvpk ! mean for each level ipk(2) = 1 ! 3D mean IF ( lvar ) THEN ipk(3) = nvpk ! variance for each level ipk(4) = 1 ! 3D variance ENDIF ierr=getvaratt (cf_in, cv_nam, clunits, zspval, cllong_name, clshort_name) ! define new variables for output stypvar%cunits = TRIM(clunits) stypvar%rmissing_value = 99999. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%scale_factor = 1. stypvar%add_offset = 0. stypvar%savelog10 = 0. stypvar%conline_operation = 'N/A' stypvar(1)%cname = 'mean_'//TRIM(cv_nam) stypvar(1)%clong_name = 'mean_'//TRIM(cllong_name) stypvar(1)%cshort_name = 'mean_'//TRIM(clshort_name) stypvar(1)%caxis = 'ZT' stypvar(2)%cname = 'mean_3D'//TRIM(cv_nam) stypvar(2)%clong_name = 'mean_3D'//TRIM(cllong_name) stypvar(2)%cshort_name = 'mean_3D'//TRIM(clshort_name) stypvar(2)%caxis = 'T' IF ( lvar) THEN stypvar(3)%cunits = TRIM(clunits)//'^2' stypvar(3)%cname = 'var_'//TRIM(cv_nam) stypvar(3)%clong_name = 'var_'//TRIM(cllong_name) stypvar(3)%cshort_name = 'var_'//TRIM(clshort_name) stypvar(3)%caxis = 'ZT' stypvar(4)%cunits = TRIM(clunits)//'^2' stypvar(4)%cname = 'var_3D'//TRIM(cv_nam) stypvar(4)%clong_name = 'var_3D'//TRIM(cllong_name) stypvar(4)%cshort_name = 'var_3D'//TRIM(clshort_name) stypvar(4)%caxis = 'T' ENDIF OPEN(numout,FILE=cf_out) IF ( lvar ) OPEN(numvar,FILE=cf_var) ! create output fileset ncout = create (cf_ncout, 'none', ikx, iky, nvpk, cdep=cv_dep) ierr = createvar (ncout, stypvar, nvars, ipk, id_varout, cdglobal=TRIM(cglobal) ) ierr = putheadervar(ncout, cf_in, ikx, iky, npk, pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdep(1:nvpk), cdep=cv_dep) tim = getvar1d(cf_in, cn_vtimec, npt) ierr = putvar1d(ncout, tim, npt, 'T') DO jt=1,npt dvol = 0.d0 dsum = 0.d0 dvar = 0.d0 DO jk = 1, nvpk ik = jk+ikmin-1 ! Get velocities v at ik zv (:,:) = getvar(cf_in, cv_nam, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jt) zmask(:,:) = getvar(cn_fmsk, cv_msk, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin ) IF ( lfull ) THEN e3(:,:) = e31d(jk) ELSE e3(:,:) = getvar(cn_fzgr, cv_e3, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ldiom=.TRUE.) ENDIF ! dsurf = SUM(DBLE( e1 * e2 * zmask)) dvol2d = SUM(DBLE( e1 * e2 * e3 * zmask)) dvol = dvol + dvol2d dsum2d = SUM(DBLE(zv * e1 * e2 * e3 * zmask)) dvar2d = SUM(DBLE(zv * zv * e1 * e2 * e3 * zmask)) dsum = dsum + dsum2d dvar = dvar + dvar2d IF (dvol2d /= 0 )THEN dvmeanout(jk) = dsum2d/dvol2d WRITE(6,*)' Mean value at level ',ik,'(',gdep(jk),' m) ',dvmeanout(jk), 'surface = ',dsurf/1.e6,' km^2' WRITE(numout,9004) gdep(jk), ik, dvmeanout(jk) IF ( lvar ) THEN dvariance(jk) = dvar2d/dvol2d - dvmeanout(jk) * dvmeanout(jk) WRITE(6,*)' Variance value at level ',ik,'(',gdep(jk),' m) ',dvariance(jk), 'surface = ',dsurf/1.e6,' km^2' WRITE(numvar,9004) gdep(jk), ik, dvariance(jk) ENDIF ELSE WRITE(6,*) ' No points in the water at level ',ik,'(',gdep(jk),' m) ' dvmeanout(jk) = 99999. IF( lvar ) dvariance(jk) = 99999. ENDIF rdummymean(1,1) = dvmeanout(jk) ierr = putvar(ncout, id_varout(1), rdummymean, jk, ikx, iky, ktime=jt ) IF ( lvar ) THEN rdummymean(1,1) = dvariance(jk) ierr = putvar(ncout, id_varout(3), rdummymean, jk, ikx, iky, ktime=jt ) ENDIF END DO dvmeanout3d(jt) = dsum / dvol WRITE(6,*) ' Mean value over the ocean: ', dvmeanout3d(jt), jt rdummy(:,:) = dvmeanout3d(jt) ierr = putvar0d(ncout, id_varout(2), rdummy, ktime=jt ) IF ( lvar ) THEN dvariance3d(jt) = dvar/dvol - dsum / dvol * dsum / dvol WRITE(6,*) ' Variance over the ocean: ', dvariance3d(jt), jt rdummy(:,:) = dvariance3d(jt) ierr = putvar0d(ncout, id_varout(4), rdummy, ktime=jt ) ENDIF END DO ! time loop CLOSE(numout) IF ( lvar ) CLOSE(numvar) ierr = closeout(ncout) 9004 FORMAT(f9.2,' ',i2,' ',f9.2) ! -zeromean option activated : rest the spatial mean computed above for each timeframe ! from the original variable, and output the result to zeromean.nc ! This replaces exactly the cdfzeromean tool ! The mean value which is used here is eventually computed on a reduced region IF ( lzeromean ) THEN DEALLOCATE ( zv, zmask, id_varout, ipk ) npiglo = npiglo_fi ; npjglo = npjglo_fi ALLOCATE (zv(npiglo,npjglo), zmask(npiglo,npjglo) ) ! re-read file and rest mean value from the variable and store on file nvars = getnvar(cf_in) ALLOCATE ( stypvarin(nvars), cv_names(nvars) ) ALLOCATE ( id_varout(1), ipk(1), stypvarzero(1) ) cv_names(:) = getvarname(cf_in, nvars, stypvarin) ! look for the working variable DO jvar = 1, nvars IF ( TRIM(cv_names(jvar)) == TRIM(cv_nam) ) EXIT END DO ivar = jvar ipk(1) = nvpk stypvarzero(1)%cname = cv_nam stypvarzero%cunits = stypvarin(ivar)%cunits stypvarzero%rmissing_value = stypvarin(ivar)%rmissing_value stypvarzero%valid_min = stypvarin(ivar)%valid_min - MAXVAL(dvmeanout3d) stypvarzero%valid_max = stypvarin(ivar)%valid_max - MINVAL(dvmeanout3d) stypvarzero(1)%clong_name = stypvarin(ivar)%clong_name//' zero mean ' stypvarzero(1)%cshort_name = cv_nam stypvarzero%conline_operation = 'N/A' stypvarzero%caxis = stypvarin(ivar)%caxis ik=nvpk IF ( lnodep ) ik = 0 ! no depth variable in input file : the same in output file ncout = create (cf_zerom, cf_in, npiglo, npjglo, ik ) ierr = createvar (ncout , stypvarzero , 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, ik , pdep=zdep) tim = getvar1d(cf_in, cn_vtimec, npt) DO jt=1,npt DO jk = 1, nvpk ik = jk+ikmin-1 zv (:,:) = getvar(cf_in, cv_nam, ik, npiglo, npjglo, ktime=jt) zmask(:,:) = getvar(cn_fmsk, cv_msk, ik, npiglo, npjglo) WHERE (zmask /= 0 ) zv(:,:) = zv(:,:) - dvmeanout3d(jt) ierr = putvar(ncout, id_varout(1), zv, ik, npiglo, npjglo, ktime=jt ) END DO END DO ierr=putvar1d(ncout, tim, npt,'T') ierr=closeout(ncout ) ENDIF END PROGRAM cdfmean cdftools-3.0/cdfprofile.f900000644000175000017500000002122212241227304016754 0ustar amckinstryamckinstryPROGRAM cdfprofile !!====================================================================== !! *** PROGRAM cdfprofile *** !!===================================================================== !! ** Purpose : extract a vertical profile from a CDFfile !! !! ** Method : read (i,j) position of point to extract !! read varname !! print profile !! !! History : 2.1 : 06/2005 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! argument numbers INTEGER(KIND=4) :: ijarg ! argument counter INTEGER(KIND=4) :: ilook, jlook ! look position INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt, nvars ! vetical, time size, number of variables INTEGER(KIND=4) :: ikx=1, iky=1, ikz ! dims of netcdf output file INTEGER(KIND=4) :: nboutput=1 ! number of variables to write in cdf output INTEGER(KIND=4) :: ncout, ierr ! ncid and error flag for cdfio INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! vertical size and id of output variables REAL(KIND=4) :: rdep ! vertical interpolation stuff REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept, rprofile ! depth and profile values REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepout ! output depth array REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, rlon, rlat ! 2d data array, longitude, latitude REAL(KIND=4), DIMENSION(1,1) :: rdumlon, rdumlat ! dummy array for output REAL(KIND=4), DIMENSION(1,1) :: rdummy ! dummy array CHARACTER(LEN=256) :: cldum ! dummy character variable CHARACTER(LEN=256) :: cf_in ! input file CHARACTER(LEN=256) :: cf_out='profile.nc' CHARACTER(LEN=256) :: cv_in, cv_dep ! variable name and depth name CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar_input ! structure of input data TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output data LOGICAL :: l_vert_interp=.false. ! flag for -dep option !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg < 4 ) THEN PRINT *,' usage : cdfprofile I J IN-file IN-var [-dep depth ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Extract a vertical profile at location I J, for a variable' PRINT *,' in an input file.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' I J : I, J position of the point to extract from file.' PRINT *,' IN-file : input file to work with.' PRINT *,' IN-var : variable name whose profile is requested.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' -dep depth : specify a depth where vertical value will be' PRINT *,' interpolated.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none ' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variable : name given as argument.' PRINT *,' Profile is also written on standard output.' STOP ENDIF ijarg = 1 DO WHILE ( ijarg < narg ) CALL getarg (ijarg, cldum ) ; ijarg = ijarg+1 SELECT CASE ( cldum ) CASE ( '-dep' ) CALL getarg (ijarg, cldum ) ; ijarg = ijarg+1 READ(cldum,*) rdep l_vert_interp = .true. CASE DEFAULT ! read 4 successives arguments READ(cldum,*) ilook CALL getarg (ijarg, cldum ) ; READ(cldum,*) jlook ; ijarg = ijarg+1 CALL getarg (ijarg, cf_in ) ; ijarg = ijarg+1 CALL getarg (ijarg, cv_in ) ; ijarg = ijarg+1 END SELECT ENDDO IF ( chkfile(cf_in) ) STOP ! missing file npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z, cv_dep) nvars = getnvar(cf_in) npt = getdim (cf_in, cn_t) ! Allocate arrays ALLOCATE ( v2d (npiglo,npjglo), gdept(npk), rprofile(npk), tim(npt) ) ALLOCATE ( stypvar_input(nvars) ,cv_names(nvars) ) ALLOCATE ( stypvar(nboutput), ipk(nboutput), id_varout(nboutput) ) ALLOCATE ( rlon(npiglo,npjglo), rlat(npiglo,npjglo)) rlon(:,:)= getvar(cf_in, cn_vlon2d, 1, npiglo, npjglo) rlat(:,:)= getvar(cf_in, cn_vlat2d, 1, npiglo, npjglo) rdumlon(:,:) = rlon(ilook,jlook) rdumlat(:,:) = rlat(ilook,jlook) gdept(:) = getvar1d(cf_in, cv_dep, npk, ierr) IF ( l_vert_interp ) THEN ipk(:) = 1 ikz = 1 ALLOCATE ( gdepout(ikz) ) gdepout(1) = rdep ELSE ipk(:) = npk ikz = npk ALLOCATE ( gdepout(ikz) ) gdepout(:) = gdept(:) ENDIF cv_names(:) = getvarname(cf_in, nvars, stypvar_input) DO jvar = 1, nvars IF ( cv_names(jvar) == cv_in ) THEN stypvar=stypvar_input(jvar) EXIT ! found cv_in ENDIF ENDDO ! create output fileset ncout = create (cf_out, 'none', ikx, iky, ikz, cdep='depth') ierr = createvar (ncout, stypvar, nboutput, ipk, id_varout ) ierr = putheadervar(ncout, cf_in, ikx, iky, ikz, pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdepout) tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jt=1,npt DO jk=1,npk v2d(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt) rprofile(jk) = v2d(ilook,jlook) ! netcdf output IF ( .NOT. l_vert_interp ) THEN rdummy(1,1) = rprofile(jk) ierr = putvar(ncout, id_varout(1), rdummy, jk, ikx, iky, ktime=jt) ENDIF END DO PRINT *, 'FILE : ', TRIM(cf_in), ' TIME = ', jt PRINT *, ' ', TRIM(cv_dep),' ', TRIM(cv_in),'(',ilook,',',jlook,')' IF ( l_vert_interp ) THEN rdummy(1,1) = vinterp (rprofile, gdept , rdep, npk ) ierr = putvar(ncout, id_varout(1), rdummy, 1, ikx, iky, ktime=jt) PRINT *, ' Interpolated value is : ', rdummy(1,1) ENDIF ! Ascii output DO jk=1, npk PRINT *, gdept(jk), rprofile(jk) END DO END DO ierr = closeout(ncout) CONTAINS REAL(KIND=4) FUNCTION vinterp ( profile, pdept, pdep, kpk) !!--------------------------------------------------------------------- !! *** FUNCTION vinterp *** !! !! ** Purpose : return the interpolated value at specified depth from !! an input profile. !! !! ** Method : Linear interpolation !! !!---------------------------------------------------------------------- REAL(KIND=4), DIMENSION(kpk), INTENT(in) :: profile ! vertical profile REAL(KIND=4), DIMENSION(kpk), INTENT(in) :: pdept ! depth array REAL(KIND=4), INTENT(in) :: pdep ! required depth INTEGER(KIND=4), INTENT(in) :: kpk ! number of level in the profile ! INTEGER(KIND=4) :: jk ! loop index INTEGER(KIND=4) :: ik0, ik1 ! limit index REAL(KIND=8) :: dalfa ! weight !!---------------------------------------------------------------------- ! find interpolation limits for required depth DO jk = 1, kpk IF ( pdept(jk) > pdep ) THEN ik0 = jk - 1 ik1 = ik0 + 1 EXIT ENDIF ENDDO dalfa = ( pdep - pdept(ik0) ) / ( pdept(ik1) - pdept(ik0) ) vinterp = dalfa * profile (ik1) + ( 1.d0 - dalfa ) * profile (ik0 ) END FUNCTION vinterp END PROGRAM cdfprofile cdftools-3.0/cdfvita.f900000644000175000017500000003155712241227304016273 0ustar amckinstryamckinstryPROGRAM cdfvita !!====================================================================== !! *** PROGRAM cdfvita *** !!===================================================================== !! ** Purpose : Compute velocity on t grid !! !! ** Method : Read velocity component on input gridU and gridV file !! Use gridT file for the proper location of T points !! The velocity module is also output (same function than !! cdfspeed) If a gridW file is given, (fifth argument) !! then w is also computed on the T grid !! !! History : 2.1 : 11/2006 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !! : 03/2013 : J.M. Molines : add -geo option !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt, jlev ! dummy loop index INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nlev, ik ! number of selected levels, current lev INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr ! error status for cdfio INTEGER(KIND=4) :: nvar ! number of variable INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nklev ! selected levels INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! output stuff REAL(KIND=4) :: pi ! pi REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter array REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdeptall, gdept ! depths and selected depths REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: uc, vc ! velocity component on C grid REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ua, va, vmod, vdir ! velocity component on A grid TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! data attributes CHARACTER(LEN=256) :: cf_ufil, cf_vfil ! velocity files on C grid CHARACTER(LEN=256) :: cf_wfil ! optional W file on C grid CHARACTER(LEN=256) :: cf_tfil ! GridT file for T position CHARACTER(LEN=256) :: cf_out='vita.nc' ! output file name CHARACTER(LEN=256) :: cldum ! dummy char variable LOGICAL :: lvertical = .FALSE. ! vertical velocity flag LOGICAL :: lperio = .FALSE. ! E_W periodicity flag LOGICAL :: lgeo = .FALSE. ! input U V files are geostrophic files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfvita U-file V_file T-file [-w W-file] [-geo ] [-lev level_list]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Create a file with velocity components, module and direction' PRINT *,' at T points from file on C-grid. T-file is used only for' PRINT *,' getting the header of the output file. Any file on T grid' PRINT *,' can be used.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' U-file : netcdf file with zonal component of velocity' PRINT *,' V-file : netcdf file with meridional component of velocity' PRINT *,' T-file : netcdf file with T points header OK.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -w W-file ] : if used, also compute vertical velocities at' PRINT *,' T points.' PRINT *,' [ -geo ] : indicate that input velocity files are produced ' PRINT *,' by cdfgeo-uv, hence ugeo on V-point, vgeo on U-points' PRINT *,' ( U-file and V_file are the same !)' PRINT *,' [ -lev level_list] : specify a list of level to be used ' PRINT *,' (default option is to use all input levels).' PRINT *,' This option MUST be the last on the command line !!' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : sovitua, sovitva, sovitmod, sovitdir, [sovitwa]' STOP ENDIF nlev = 0 ijarg=1 pi=ACOS(-1.) DO WHILE ( ijarg <= narg ) CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE ( '-lev' ) nlev= narg - ijarg + 1 ALLOCATE (nklev(nlev) ) DO jlev = 1, nlev CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,* ) nklev(jlev) ENDDO CASE ( '-w' ) CALL getarg( ijarg, cf_wfil ) ; ijarg=ijarg+1 lvertical=.TRUE. CASE ( '-geo' ) lgeo = .TRUE. CASE DEFAULT cf_ufil=cldum CALL getarg( ijarg, cf_vfil ) ; ijarg=ijarg+1 CALL getarg( ijarg, cf_tfil ) ; ijarg=ijarg+1 END SELECT ENDDO ! adjust number of variable according to -w option nvar=4 IF ( lvertical ) nvar = 5 ALLOCATE ( ipk(nvar), id_varout(nvar), stypvar(nvar) ) IF ( chkfile(cf_ufil) .OR. chkfile(cf_vfil) .OR. chkfile(cf_tfil) ) STOP ! missing file IF ( lvertical ) THEN IF ( chkfile(cf_wfil) ) STOP ! missing file ENDIF npiglo = getdim (cf_ufil,cn_x) npjglo = getdim (cf_ufil,cn_y) npk = getdim (cf_ufil,cn_z) npt = getdim (cf_ufil,cn_t) IF (npk == 0 ) THEN npk = 1 ENDIF IF ( nlev == 0 ) THEN ! take all levels nlev = npk ALLOCATE (nklev(nlev) ) DO jlev = 1, nlev nklev(jlev) = jlev ENDDO ENDIF ALLOCATE ( gdept(nlev) ) ! Zonal Velocity T point ipk(1) = nlev stypvar(1)%cname = 'sovitua' stypvar(1)%cunits = 'm/s' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 10000. stypvar(1)%clong_name = 'Zonal Velocity T point' stypvar(1)%cshort_name = 'sovitua' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' ! Meridional Velocity T point ipk(2) = nlev stypvar(2)%cname = 'sovitva' stypvar(2)%cunits = 'm/s' stypvar(2)%rmissing_value = 0. stypvar(2)%valid_min = 0. stypvar(2)%valid_max = 10000. stypvar(2)%clong_name = 'Meridional Velocity T point' stypvar(2)%cshort_name = 'sovitva' stypvar(2)%conline_operation = 'N/A' stypvar(2)%caxis = 'TZYX' ! Velocity module T point ipk(3) = nlev stypvar(3)%cname = 'sovitmod' stypvar(3)%cunits = 'm/s' stypvar(3)%rmissing_value = 0. stypvar(3)%valid_min = 0. stypvar(3)%valid_max = 10000. stypvar(3)%clong_name = 'Velocity module T point' stypvar(3)%cshort_name = 'sovitmod' stypvar(3)%conline_operation = 'N/A' stypvar(3)%caxis = 'TZYX' ! Velocity module T point ipk(4) = nlev stypvar(4)%cname = 'sovitdir' stypvar(4)%cunits = 'deg N' stypvar(4)%rmissing_value = 0. stypvar(4)%valid_min = 0. stypvar(4)%valid_max = 360. stypvar(4)%clong_name = 'Velocity direction T point' stypvar(4)%cshort_name = 'sovitdir' stypvar(4)%conline_operation = 'N/A' stypvar(4)%caxis = 'TZYX' IF ( lvertical ) THEN ! Vertical Velocity at T point ipk(nvar) = nlev stypvar(nvar)%cname = 'sovitwa' stypvar(nvar)%cunits = 'mm/s' stypvar(nvar)%rmissing_value = 0. stypvar(nvar)%valid_min = 0. stypvar(nvar)%valid_max = 10000. stypvar(nvar)%clong_name = 'Vertical Velocity at T point' stypvar(nvar)%cshort_name = 'sovitwa' stypvar(nvar)%conline_operation = 'N/A' stypvar(nvar)%caxis = 'TZYX' ENDIF PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt PRINT *, 'nlev =', nlev ALLOCATE( uc(npiglo,npjglo), vc(npiglo,npjglo) ) ALLOCATE( ua(npiglo,npjglo), va(npiglo,npjglo) ) ALLOCATE( vmod(npiglo,npjglo), vdir(npiglo, npjglo) ) ALLOCATE( tim(npt), gdeptall(npk) ) gdeptall(:) = getvar1d(cf_tfil,cn_vdeptht, npk) DO jlev = 1, nlev ik = nklev(jlev) gdept(jlev) = gdeptall(ik) ENDDO ! check E-W periodicity using uc array as working space uc(:,:) = getvar(cf_tfil, cn_vlon2d, 1, npiglo, npjglo ) IF ( uc(1,1) == uc(npiglo-1,1) ) THEN lperio = .TRUE. PRINT *,' E-W periodicity detected.' ENDIF ncout = create (cf_out, cf_tfil, npiglo, npjglo, nlev ) ierr = createvar (ncout , stypvar, nvar, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, nlev, pdep=gdept ) DO jt = 1, npt DO jlev = 1, nlev ik = nklev(jlev) uc(:,:) = getvar(cf_ufil, cn_vozocrtx, ik ,npiglo, npjglo, ktime=jt ) vc(:,:) = getvar(cf_vfil, cn_vomecrty, ik ,npiglo, npjglo, ktime=jt ) ua = 0. ; va = 0. ; ua(:,:) = 0. ; va(:,:)=0. ; vmod(:,:)=0. IF ( lgeo ) THEN ! geostrophic velocities DO ji=2, npiglo DO jj=2,npjglo ua(ji,jj) = 0.5* (uc(ji,jj)+ uc(ji ,jj-1)) va(ji,jj) = 0.5* (vc(ji,jj)+ vc(ji-1,jj )) vmod(ji,jj) = SQRT( ua(ji,jj)*ua(ji,jj) + va(ji,jj)*va(ji,jj) ) vdir(ji,jj) = 90. - atan2(va(ji,jj),ua(ji,jj))*180./pi IF ( vdir(ji,jj) < 0. ) vdir(ji,jj) = 360.+vdir(ji,jj) END DO END DO ELSE DO ji=2, npiglo DO jj=2,npjglo ua(ji,jj) = 0.5* (uc(ji,jj)+ uc(ji-1,jj)) va(ji,jj) = 0.5* (vc(ji,jj)+ vc(ji,jj-1)) vmod(ji,jj) = SQRT( ua(ji,jj)*ua(ji,jj) + va(ji,jj)*va(ji,jj) ) vdir(ji,jj) = 90. - atan2(va(ji,jj),ua(ji,jj))*180./pi IF ( vdir(ji,jj) < 0. ) vdir(ji,jj) = 360.+vdir(ji,jj) END DO END DO ENDIF IF ( lperio) THEN ! periodic E-W boundary ... ua (1,:) = ua (npiglo-1,:) va (1,:) = va (npiglo-1,:) vmod(1,:) = vmod(npiglo-1,:) vdir(1,:) = vdir(npiglo-1,:) ENDIF ierr=putvar(ncout, id_varout(1), ua, jlev ,npiglo, npjglo, ktime=jt ) ierr=putvar(ncout, id_varout(2), va, jlev ,npiglo, npjglo, ktime=jt ) ierr=putvar(ncout, id_varout(3), vmod, jlev ,npiglo, npjglo, ktime=jt ) ierr=putvar(ncout, id_varout(4), vdir, jlev ,npiglo, npjglo, ktime=jt ) END DO END DO IF ( lvertical ) THEN ! reuse uc an vc arrays to store Wk and Wk+1 DO jt = 1, npt DO jlev=1, nlev - 1 uc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(jlev), npiglo, npjglo, ktime=jt ) vc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(jlev)+1, npiglo, npjglo, ktime=jt ) ua(:,:) = 0.5*(uc(:,:) + vc(:,:))*1000. ! mm/sec ierr = putvar(ncout, id_varout(4), ua, jlev, npiglo, npjglo, ktime=jt ) uc(:,:) = vc(:,:) END DO IF ( nlev == npk ) THEN ua(:,:) = 0.e0 ! npk ELSE uc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(nlev), npiglo, npjglo, ktime=jt ) vc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(nlev)+1, npiglo, npjglo, ktime=jt ) ua(:,:) = 0.5*(uc(:,:) + vc(:,:))*1000. ! mm/sec ENDIF ierr = putvar(ncout, id_varout(4), ua, nlev ,npiglo, npjglo, ktime=jt ) ENDDO ENDIF tim = getvar1d(cf_ufil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdfvita cdftools-3.0/cdfscale.f900000644000175000017500000001140512241227304016405 0ustar amckinstryamckinstryPROGRAM cdfscale !!====================================================================== !! *** PROGRAM cdfscale *** !!===================================================================== !! ** Purpose : Replace a variable in the file by its value x scale !! given in argument !! !! History : 3.0 : 12/2011 : J.M. Molines : Original code !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jvar, jt ! dummy loop index INTEGER(KIND=4) :: ivar ! index of working variable INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: ncid ! ncid of input file for rewrite INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! Number of variables in a file INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id REAL(KIND=4) :: vscale ! spval, replace value REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tab ! Arrays for data CHARACTER(LEN=256) :: cldum ! dummy string for getarg CHARACTER(LEN=256) :: cf_inout ! file name CHARACTER(LEN=256) :: cunits, clname, csname ! attributes CHARACTER(LEN=256) :: cv_inout ! variable name CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! type for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfscale INOUT-file IN-var scale ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Replace IN-var in INOUT-file by its values x scale.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' INOUT-file : netcdf input file (!overwritten!).' PRINT *,' IN-var : netcdf variable to be scaled.' PRINT *,' scale : Scale value to be used (multiplication factor).' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : input file is rewritten ' PRINT *,' variables : same name as input.' STOP ENDIF CALL getarg(1, cf_inout) CALL getarg(2, cv_inout) CALL getarg(3, cldum) ; READ(cldum,*) vscale IF ( chkfile (cf_inout) ) STOP ! missing file npiglo = getdim (cf_inout, cn_x ) npjglo = getdim (cf_inout, cn_y ) npk = getdim (cf_inout, cn_z, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_inout,'z',kstatus=ierr) IF (ierr /= 0 ) THEN PRINT *, 'ASSUME NO VERTICAL DIMENSIONS !' npk=0 ENDIF ENDIF ncid = ncopen ( cf_inout ) npt = getdim ( cf_inout, cn_t ) PRINT *, 'npiglo=', npiglo PRINT *, 'npjglo=', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt ALLOCATE( tab(npiglo,npjglo) ) nvars = getnvar(cf_inout) ALLOCATE (cv_names(nvars), id_var(nvars),ipk(nvars), stypvar(nvars)) cv_names(:) = getvarname(cf_inout,nvars,stypvar) ipk(:) = getipk(cf_inout,nvars) id_var(:) = getvarid(cf_inout,nvars) ! look for cv_inout in the list of variables DO jvar = 1, nvars IF ( cv_inout == cv_names(jvar) ) THEN ivar = jvar ENDIF ENDDO PRINT *,' Working with ',TRIM(cv_inout),' variable number ', ivar PRINT *,' IPK : ', ipk(ivar) PRINT *,' scale : ', vscale ! work only for ivar DO jt=1,npt DO jk = 1, ipk(ivar) tab(:,:) = getvar(cf_inout, cv_names(ivar), jk, npiglo, npjglo, ktime=jt ) tab(:,:) = tab(:,:) * vscale ierr = putvar(ncid, id_var(ivar), tab, jk, npiglo, npjglo, ktime=jt) ENDDO END DO ierr = closeout(ncid) END PROGRAM cdfscale cdftools-3.0/cdfvFWov.f900000644000175000017500000002777212241227304016403 0ustar amckinstryamckinstryPROGRAM cdfvFWov !!------------------------------------------------------------------- !!====================================================================== !! *** PROGRAM cdfvFWov *** !!===================================================================== !! ** Purpose : from a section calculate net freshwater transport and its !! overturning component !! section is assumed to be 2 j lines (j and j+1) !! !! ** Method : compute salinity at v point !! compute zonal mean of salinity-vpt and v velocity !! compute total freshwater transport and overturning component !! !! History : 2.1 : 12/2011 : J. Deshayes : Original code !! 3.0 : 12/2011 : J.M. Molines : Port to 3.0 !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: narg, iargc ! arguments on command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ji, jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! error status of I/O INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ikx=1, iky=1, ikz=1 ! dims of netcdf output file INTEGER(KIND=4) :: nboutput = 3 ! number of output variables INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! output variables properties REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: rmaskn, rmasks ! S-mask North and South of V-point REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: rmaskv ! mask at V point REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zsaln, zsals ! salinity North and South of v point REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zsalv, zvitv ! salinity at V point, velocity REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zFWv ! work array REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: rdumlon, rdumlat ! dummy arrays for I/O REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: de3v ! vertical metrics REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: de1v ! horizontal metrics REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: dnetvFW, dtotvFW ! transport array REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: dovFW, dtime ! overturning array, time REAL(KIND=8), DIMENSION (1) :: dnetv, dnetFW ! total transport accross section (mass and FW) REAL(KIND=8), DIMENSION (1) :: darea, dareak ! work space REAL(KIND=8), DIMENSION (1) :: dzonalv, dzonalFW REAL(KIND=8) :: dztrp, dcellarea REAL(KIND=8), PARAMETER :: dp_rsal=35.d0 ! reference salinity for freshwater calculation CHARACTER(LEN=256) :: cf_vfil ! input V file CHARACTER(LEN=256) :: cf_sfil ! input S file CHARACTER(LEN=256) :: cf_zgr ! zgr file CHARACTER(LEN=256) :: cf_hgr ! hgr file CHARACTER(LEN=256) :: cf_mask ! mask file CHARACTER(LEN=256) :: cf_out = 'vFWov.nc' ! output file CHARACTER(LEN=256) :: cv_netvFW = 'netvFW' ! output variable 1 CHARACTER(LEN=256) :: cv_totvFW = 'totvFW' ! output variable 2 CHARACTER(LEN=256) :: cv_ovFW = 'ovFW' ! output variable 3 CHARACTER(LEN=256) :: cglobal ! Global attribute for output file TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! I/O data structure LOGICAL :: lchk = .FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() !! Read command line narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfvFWov V-secfile S-secfile ZGR-secfile HGR-secfile MSK-secfile' PRINT *,' PURPOSE :' PRINT *,' Compute the fresh water transport and its overturning component through' PRINT *,' a section specified by the input files (data and metrics).' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' All arguments are ''section files'', which are assumed to be files with' PRINT *,' 2 zonal lines of data ( j and j+1 ): ' PRINT *,' - V_secfile : meridional velocity section file.' PRINT *,' - S_secfile : salinity section file.' PRINT *,' - ZGR_secfile : mesh_zgr section file ' PRINT *,' - HGR_secfile : mesh_hgr section file ' PRINT *,' - MSK_secfile : mask section file ' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ',TRIM(cv_netvFW),', ',TRIM(cv_totvFW),', ',TRIM(cv_ovFW) PRINT *,' Output file only has time relevant dimension. Other dims are set to 1.' PRINT *,' Degenerated dimensions can be removed with :' PRINT *,' ncwga -a x,y,depthw ',TRIM(cf_out), ' -o out.nc' STOP ENDIF !! get arguments CALL getarg (1, cf_vfil) CALL getarg (2, cf_sfil) CALL getarg (3, cf_zgr ) CALL getarg (4, cf_hgr ) CALL getarg (5, cf_mask) lchk = lchk .OR. chkfile ( cf_vfil ) lchk = lchk .OR. chkfile ( cf_sfil ) lchk = lchk .OR. chkfile ( cf_zgr ) lchk = lchk .OR. chkfile ( cf_hgr ) lchk = lchk .OR. chkfile ( cf_mask ) IF ( lchk ) STOP ! missing files !! get dimensions of input file containing data npiglo = getdim(cf_vfil, cn_x) npjglo = getdim(cf_vfil, cn_y) npk = getdim(cf_vfil, cn_z) npt = getdim(cf_vfil, cn_t) PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt IF ( npjglo /= 2 ) THEN PRINT *,' ERROR : This program works with section files.' PRINT *,' all data should have j dimension equal to 2 ' STOP ENDIF ALLOCATE ( dnetvFW(npt), dtotvFW(npt), dovFW(npt), dtime(npt) ) ALLOCATE ( de1v(npiglo,npjglo), de3v(npiglo,npk)) ALLOCATE ( zFWv(npiglo,npk), zvitv(npiglo,npk) ) ALLOCATE ( zsals(npiglo,npk), zsaln(npiglo,npk), zsalv(npiglo,npk) ) ALLOCATE ( rmasks(npiglo,npk), rmaskn(npiglo,npk), rmaskv(npiglo,npk)) ALLOCATE ( stypvar(nboutput), ipk(nboutput), id_varout(nboutput) ) ALLOCATE ( rdumlon(1,1), rdumlat(1,1) ) rdumlon(:,:) = 0.e0 ! dummy longitude rdumlat(:,:) = 0.e0 ! dummy latitude !! load data dtime = getvar1d(cf_vfil, cn_vtimec, npt) !! define output variables ipk(:) = 1 stypvar%rmissing_value = 0. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%conline_operation = 'N/A' stypvar%caxis = 'T' stypvar%scale_factor = 1. stypvar%add_offset = 0. stypvar%savelog10 = 0. stypvar(1)%cname = TRIM(cv_netvFW ) stypvar(2)%cname = TRIM(cv_totvFW ) stypvar(3)%cname = TRIM(cv_ovFW ) stypvar(1)%cunits ='Sv' stypvar(2)%cunits ='Sv' stypvar(3)%cunits ='Sv' stypvar(1)%clong_name = 'Net transport of freshwater across section' stypvar(2)%clong_name = 'Transport of freshwater across section when net mass transport equals 0' stypvar(3)%clong_name = 'Overturning component of freshwater transport across section' stypvar(1)%cshort_name = TRIM(cv_netvFW ) stypvar(2)%cshort_name = TRIM(cv_totvFW ) stypvar(3)%cshort_name = TRIM(cv_ovFW ) WRITE(cglobal,'(a,f5.1,a)' ) 'comment : Reference salinity ', dp_rsal,' transport is positive northward' !! prepare output file ncout = create (cf_out, 'none', ikx, iky, ikz, cdep='depthw' ) ierr = createvar (ncout, stypvar, nboutput, ipk, id_varout, cdglobal=TRIM(cglobal) ) ierr = putheadervar(ncout, cf_vfil, ikx, iky, ikz, pnavlon=rdumlon, pnavlat=rdumlat ) ierr = putvar1d(ncout, REAL(dtime), npt, 'T') !! load scale factors rmasks(:,:) = getvarxz(cf_mask, 'tmask', kj=1, kpi=npiglo, kpz=npk, kimin=1, kkmin=1) rmaskn(:,:) = getvarxz(cf_mask, 'tmask', kj=2, kpi=npiglo, kpz=npk, kimin=1, kkmin=1) rmaskv(:,:) = getvarxz(cf_mask, 'vmask', kj=1, kpi=npiglo, kpz=npk, kimin=1, kkmin=1) de1v(:,:) = getvar (cf_hgr, cn_ve1v, klev=1, kpi=npiglo, kpj=npjglo, kimin=1, kjmin=1) de3v(:,:) = getvarxz(cf_zgr, 'e3v', kj=1, kpi=npiglo, kpz=npk, kimin=1, kkmin=1) WHERE ( rmasks /= 0. ) rmasks = 1. WHERE ( rmaskn /= 0. ) rmaskn = 1. WHERE ( rmaskv /= 0. ) rmaskv = 1. !! do calculation for each time step DO jt=1,npt PRINT *,'jt =',jt ! reset cumulative arrays to 0 zFWv(:,:) = 0.e0 dnetv = 0.d0 ; dnetFW = 0.d0 darea = 0.d0 dnetvFW(jt) = 0.d0 ; dtotvFW(jt) = 0.d0 ; dovFW(jt) = 0.d0 zvitv(:,:)= getvarxz(cf_vfil, cn_vomecrty, kj=1, kpi=npiglo, kpz=npk, kimin=1, kkmin=1, ktime=jt) zsals(:,:)= getvarxz(cf_sfil, cn_vosaline, kj=1, kpi=npiglo, kpz=npk, kimin=1, kkmin=1, ktime=jt) zsaln(:,:)= getvarxz(cf_sfil, cn_vosaline, kj=2, kpi=npiglo, kpz=npk, kimin=1, kkmin=1, ktime=jt) DO jk = 1, npk DO ji = 1, npiglo IF ( rmasks(ji,jk) + rmaskn(ji,jk) /= 0 ) THEN zFWv(ji,jk) = ( dp_rsal - ( zsals(ji,jk) * rmasks(ji,jk) + zsaln(ji,jk) * rmaskn(ji,jk) ) & & / ( rmasks(ji,jk) + rmaskn(ji,jk) ) ) / dp_rsal ! freshwater at Vpoint ENDIF dcellarea = de1v(ji,1) * de3v(ji,jk) * rmaskv(ji,jk) dztrp = zvitv(ji,jk) * dcellarea dnetvFW(jt) = dnetvFW(jt) + zFWv(ji,jk) * dztrp /1.d6 ! net freshwater transport in Sv dnetv = dnetv + dztrp dnetFW = dnetFW + zFWv(ji,jk) * dcellarea darea = darea + dcellarea END DO !ji END DO !jk PRINT *,'total mass transport across section =', dnetv / 1.d6,' Sv' dnetv = dnetv / darea ! mean velocity across section dnetFW = dnetFW / darea ! mean freshwater along section PRINT *,'mean salinity along section =', dp_rsal - dnetFW * dp_rsal,' psu' DO jk = 1, npk dzonalv = 0.d0 dzonalFW = 0.d0 dareak = 0.d0 DO ji = 1, npiglo dcellarea = de1v(ji,1) * de3v(ji,jk) * rmaskv(ji,jk) dzonalv = dzonalv + ( zvitv(ji,jk) - dnetv ) * dcellarea dzonalFW = dzonalFW + ( zFWv(ji,jk) - dnetFW ) * dcellarea dareak = dareak + dcellarea dtotvFW(jt) = dtotvFW(jt) + ( zvitv(ji,jk) - dnetv(1) ) * zFWv(ji,jk) * dcellarea /1.d6 END DO !ji IF ( dareak(1) > 0 ) THEN ! overturning freshwater transport in Sv dovFW(jt) = dovFW(jt) + dzonalv(1) * dzonalFW(1) / dareak(1) /1.d6 ENDIF END DO !jk PRINT *,'netvFW = ', dnetvFW(jt), ' Sv' PRINT *,'totvFW = ', dtotvFW(jt), ' Sv' PRINT *,'ovFW = ', dovFW(jt), ' Sv' ierr = putvar0d( ncout, id_varout(1), REAL(dnetvFW(jt)), ktime = jt ) ierr = putvar0d( ncout, id_varout(2), REAL(dtotvFW(jt)), ktime = jt ) ierr = putvar0d( ncout, id_varout(3), REAL(dovFW(jt)) , ktime = jt ) END DO !jt ierr = closeout(ncout) END PROGRAM cdfvFWov cdftools-3.0/cdfmoy_freq.f900000644000175000017500000002146712241227304017150 0ustar amckinstryamckinstryPROGRAM cdfmoy_freq !!====================================================================== !! *** PROGRAM cdfmoy_freq *** !!===================================================================== !! ** Purpose : Mainly in case of forcing file (gathered as yearly file) !! compute annual mean, monthl mean or diurnal means. !! !! ** Method : Detect the frequency of the input file according to the !! number of fields in the file. !! !! History : 2.1 : 06/2007 : P. Mathiot : Original code from cdfmoy !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic. !! 3.0 : 10/2011 : P. Mathiot : Add seasonal option and !! allow file with 73 time steps !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: nt_in, nt_out INTEGER(KIND=4) :: jk, jvar ! dummy loop index INTEGER(KIND=4) :: jv, jtt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: itime ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk ,npt ! size of the domain INTEGER(KIND=4) :: nvars ! Number of variables in a file INTEGER(KIND=4) :: ntframe ! Cumul of time frame INTEGER(KIND=4) :: ncout, ncout2 INTEGER(KIND=4), DIMENSION(365) :: njd ! day vector INTEGER(KIND=4), DIMENSION( 12) :: njm ! month vector INTEGER(KIND=4), DIMENSION( 4) :: njs !season vector INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var, ipk, id_varout REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, rmean REAL(KIND=4), DIMENSION(1) :: time REAL(KIND=4), DIMENSION(365) :: tim REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtab ! Arrays for cumulated values REAL(KIND=8) :: dtotal_time CHARACTER(LEN=256) :: cf_in ! CHARACTER(LEN=256) :: cf_out ! file name CHARACTER(LEN=256) :: cv_dep CHARACTER(LEN=256) :: cfreq_out, cfreq_in CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var nam TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar LOGICAL :: lcaltmean, lprint !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmoy_freq IN-file output_frequency' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute annual mean or monthly mean or daily mean from a yearly' PRINT *,' input forcing file given on input.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : netcdf input file corresponding to 1 year of forcing variable (1460, 365, 73 or 12 time step) ' PRINT *,' output_frequency : either one of monthly, daily, seasonal or annual.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : cdfmoy_outputFreaquency.nc' PRINT *,' variables : same as variables in input file.' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfmoy, cdfmoy_weighted' PRINT *,' ' STOP ENDIF !! Initialisation from 1st file (all file are assume to have the same geometry) CALL getarg (1, cf_in ) CALL getarg (2, cfreq_out) IF ( chkfile ( cf_in ) ) STOP ! missing file SELECT CASE ( cfreq_out ) CASE ('daily' ) ; nt_out = 365 CASE ('monthly' ) ; nt_out = 12 CASE ('seasonal') ; nt_out = 4 CASE ('annual' ) ; nt_out = 1 CASE DEFAULT PRINT *, 'Pb : this output_frequency is not allowed, please use daily, monthly, seasonal or annual' STOP END SELECT npiglo= getdim (cf_in, cn_x ) npjglo= getdim (cf_in, cn_y ) npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF npt = getdim (cf_in, cn_t) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE( dtab(npiglo,npjglo), v2d(npiglo,npjglo) ) ALLOCATE( rmean(npiglo,npjglo) ) nvars = getnvar(cf_in) PRINT *,' nvars =', nvars ALLOCATE (cv_names(nvars) ) ALLOCATE (stypvar(nvars) ) ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars)) ! get list of variable names and collect attributes in stypvar (optional) cv_names(:)=getvarname(cf_in, nvars, stypvar) id_var(:) = (/(jv, jv=1,nvars)/) ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk (cf_in, nvars, cdep=cv_dep) ! WHERE( ipk == 0 ) cv_names='none' stypvar(:)%cname = cv_names ! ! create output file taking the sizes in cf_in cf_out = 'cdfmoy_'//TRIM(cfreq_out)//'.nc' ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep ) ierr = createvar (ncout, stypvar, nvars, ipk, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk, cdep=cv_dep ) time=getvar1d(cf_in, cn_vtimec, 1) ierr=putvar1d(ncout, time, 1, 'T') npt = getdim (cf_in, cn_t) nt_in = npt SELECT CASE ( npt ) CASE ( 1460 ) ; PRINT *, 'Frequency of this file : 6h ' CASE ( 365 ) ; PRINT *, 'Frequency of this file : daily ' CASE ( 73 ) ; PRINT *, 'Frequency of this file : 5 day ' CASE ( 12 ) ; PRINT *, 'Frequency of this file : monthly ' END SELECT IF (npt <= nt_out) THEN PRINT *, 'You don''t need to use it, or it is impossible (npt_in <= npt_out)' STOP END IF ! number of day by month, season and day njd(:)= 1 njm= (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) njs= (/ 90, 91, 92, 92 /) DO jvar = 1,nvars IF ( cv_names(jvar) == cn_vlon2d .OR. & cv_names(jvar) == cn_vlat2d .OR. cv_names(jvar) == 'none') THEN ! skip these variable ELSE PRINT *,' Working with ', TRIM(cv_names(jvar)) DO jk=1,ipk(jvar) ! initialisation dtab(:,:) = 0.d0 ; dtotal_time = 0.d0; ntframe=0; itime=1; ! time loop DO jtt=1, nt_in lprint=.FALSE. ntframe=ntframe+1 ! load data v2d(:,:) = getvar(cf_in, cv_names(jvar), jk, npiglo, npjglo, ktime=jtt ) dtab(:,:) = dtab(:,:) + v2d(:,:)*1.d0 ! detection of time when you have to print the average IF (nt_out==365) THEN IF (MOD(jtt,FLOOR(SUM(njd(1:itime)) * nt_in/365.))==0) lprint=.TRUE. ELSE IF (nt_out==12) THEN IF (MOD(jtt,FLOOR(SUM(njm(1:itime)) * nt_in/365.))==0) lprint=.TRUE. ELSE IF (nt_out==4) THEN IF (MOD(jtt,FLOOR(SUM(njs(1:itime)) * nt_in/365.))==0) lprint=.TRUE. ELSE IF (nt_out==1) THEN IF (MOD(jtt, nt_in )==0) lprint=.TRUE. END IF ! ! Compute and print the average at the right time IF ( lprint ) THEN IF (jk==1) PRINT *, itime, jtt,'/',npt ! compute mean rmean(:,:) = dtab(:,:)/ntframe ! store variable on outputfile ierr = putvar(ncout, id_varout(jvar) ,rmean, jk, npiglo, npjglo, ktime=itime) dtab(:,:) = 0.d0 ; dtotal_time = 0.; ntframe=0; itime=itime+1 END IF ! ENDDO ! loop to next time ENDDO ! loop to next level END IF END DO ! loop to next var in file ierr = closeout(ncout) END PROGRAM cdfmoy_freq cdftools-3.0/cdfstdevw.f900000644000175000017500000001325412241227304016636 0ustar amckinstryamckinstryPROGRAM cdfstdevw !!====================================================================== !! *** PROGRAM cdfstdevw *** !!===================================================================== !! ** Purpose : Compute the RMS of W, from the mean squared value. !! !! ** Method : Read gridW and gridW2 and compute rms !! !! History : 2.1 : 11/2004 : J.M. Molines : Original code !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output variable INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4), DIMENSION(1) :: ipko, id_varout ! output variable REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvbar, zvba2 ! mean and mean2 variable REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsdev ! standard deviation CHARACTER(LEN=256) :: cf_in ! input mean file name CHARACTER(LEN=256) :: cf_in2 ! input mean2 file name CHARACTER(LEN=256) :: cf_out = 'rmsw.nc'! output file name CHARACTER(LEN=256) :: cv_in, cv_in2 ! input variable names CHARACTER(LEN=256) :: cldum ! dummy character variable TYPE(variable), DIMENSION(1) :: stypvaro ! output data structure LOGICAL :: lchk = .FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() cv_in = cn_vovecrtz narg= iargc() IF ( narg /= 2 ) THEN PRINT *,' usage : cdfstdevw W-file W2-file ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the standard deviation of the vertical velocity' PRINT *,' from its mean value and its mean square value. ' PRINT *,' ' PRINT *,' Note that what is computed in this program is stictly the' PRINT *,' standard deviation. It is very often called RMS, which is' PRINT *,' an abuse. It is the same only in the case of zero mean value.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' W-file : netcdf file with mean values for w' PRINT *,' W2-file : netcdf file with mean squared values for w' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_in)//'_rms, same unit than the input.' PRINT *,' ' PRINT *,' SEA ALSO :' PRINT *,' cdfstd, cdfrmsssh, cdfstdevts.' STOP ENDIF ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg) CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE DEFAULT ireq = ireq + 1 SELECT CASE ( ireq ) CASE ( 1 ) ; cf_in = cldum CASE ( 2 ) ; cf_in2 = cldum CASE DEFAULT PRINT *, ' Too many variables ' ; STOP END SELECT END SELECT ENDDO ! check existence of files lchk = lchk .OR. chkfile(cf_in ) lchk = lchk .OR. chkfile(cf_in2) IF (lchk ) STOP ! missing file npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z) npt = getdim (cf_in, cn_t) ipko(1) = npk stypvaro(1)%cname = TRIM(cv_in)//'_rms' stypvaro(1)%cunits = 'm/s' stypvaro(1)%rmissing_value = 0. stypvaro(1)%valid_min = 0. stypvaro(1)%valid_max = 0.01 stypvaro(1)%clong_name = 'RMS_Vertical_Velocity' stypvaro(1)%cshort_name = TRIM(cv_in)//'_rms' stypvaro(1)%conline_operation = 'N/A' stypvaro(1)%caxis = 'TZYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE( zvbar(npiglo,npjglo), zvba2(npiglo,npjglo) ) ALLOCATE( dsdev(npiglo,npjglo), tim(npt) ) ncout = create (cf_out, cf_in, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvaro, 1, ipko, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk ) cv_in2 = TRIM(cv_in)//'_sqd' DO jt = 1, npt DO jk = 1, npk zvbar(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt) zvba2(:,:) = getvar(cf_in2, cv_in2, jk, npiglo, npjglo, ktime=jt) dsdev(:,:) = SQRT ( DBLE(zvba2(:,:) - zvbar(:,:)*zvbar(:,:)) ) ierr = putvar(ncout, id_varout(1), REAL(dsdev), jk, npiglo, npjglo, ktime=jt) END DO END DO tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdfstdevw cdftools-3.0/cdfspice.f900000644000175000017500000001731612241227304016430 0ustar amckinstryamckinstryPROGRAM cdfspice !!====================================================================== !! *** PROGRAM cdfspice *** !!===================================================================== !! ** Purpose : Compute spiciness 3D field from gridT file !! Store the results on a 'similar' cdf file. !! !! ** Method : spiciness = sum(i=0,5)[sum(j=0,4)[b(i,j)*theta^i*(s-35)^j]] !! with: b -> coefficients !! theta -> potential temperature !! s -> salinity !! !! ** Example: !! spice(15,33)= 0.5445863 0.544586321373410 calcul en double !! spice(15,33)= 0.5445864 (calcul en simple precision) !! !! ** References : Flament (2002) "A state variable for characterizing !! water masses and their diffusive stability: spiciness." !! Progress in Oceanography Volume 54, 2002, Pages 493-501. !! !! History : 2.1 : 03/2010 : C.O. Dufour : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: narg, iargc ! browse command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's REAL(KIND=4) :: zspval ! missing value REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtemp ! temperature REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtempt ! temperature REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsal ! salinity REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsalt ! salinity REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsalref ! reference salinity REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dspi ! spiceness REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmask ! 2D mask at current level REAL(KIND=8), DIMENSION(6,5) :: dbet ! coefficients of spiciness formula CHARACTER(LEN=256) :: cf_tfil ! input filename CHARACTER(LEN=256) :: cf_out='spice.nc' ! output file name TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfspice T-file ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the spiceness corresponding to temperatures and salinities' PRINT *,' given in the input file.' PRINT *,' ' PRINT *,' spiciness = sum(i=0,5)[sum(j=0,4)[b(i,j)*theta^i*(s-35)^j]]' PRINT *,' with: b -> coefficients' PRINT *,' theta -> potential temperature' PRINT *,' s -> salinity' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with temperature and salinity (gridT)' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : vospice' PRINT *,' ' PRINT *,' REFERENCE :' PRINT *,' Flament (2002) "A state variable for characterizing ' PRINT *,' water masses and their diffusive stability: spiciness."' PRINT *,' Progress in Oceanography Volume 54, 2002, Pages 493-501.' STOP ENDIF IF ( narg == 0 ) THEN PRINT *,'usage : cdfspice gridT ' PRINT *,' Output on spice.nc, variable vospice' STOP ENDIF CALL getarg (1, cf_tfil) IF ( chkfile(cf_tfil) ) STOP ! missing files npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) ipk(:) = npk stypvar(1)%cname = 'vospice' stypvar(1)%cunits = 'kg/m3' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -300. stypvar(1)%valid_max = 300. stypvar(1)%clong_name = 'spiciness' stypvar(1)%cshort_name = 'vospice' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE (dtemp(npiglo,npjglo), dsal (npiglo,npjglo) ) ALLOCATE (dspi( npiglo,npjglo), dmask(npiglo,npjglo) ) ALLOCATE (dtempt(npiglo,npjglo), dsalt(npiglo,npjglo)) ALLOCATE (dsalref(npiglo,npjglo)) ALLOCATE (tim(npt)) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') zspval = getatt(cf_tfil, cn_vosaline, 'missing_value') ! Define coefficients to compute spiciness (R*8) dbet(1,1) = 0 ; dbet(1,2) = 7.7442d-01 ; dbet(1,3) = -5.85d-03 ; dbet(1,4) = -9.84d-04 ; dbet(1,5) = -2.06d-04 dbet(2,1) = 5.1655d-02 ; dbet(2,2) = 2.034d-03 ; dbet(2,3) = -2.742d-04 ; dbet(2,4) = -8.5d-06 ; dbet(2,5) = 1.36d-05 dbet(3,1) = 6.64783d-03 ; dbet(3,2) = -2.4681d-04 ; dbet(3,3) = -1.428d-05 ; dbet(3,4) = 3.337d-05 ; dbet(3,5) = 7.894d-06 dbet(4,1) = -5.4023d-05 ; dbet(4,2) = 7.326d-06 ; dbet(4,3) = 7.0036d-06 ; dbet(4,4) = -3.0412d-06 ; dbet(4,5) = -1.0853d-06 dbet(5,1) = 3.949d-07 ; dbet(5,2) = -3.029d-08 ; dbet(5,3) = -3.8209d-07 ; dbet(5,4) = 1.0012d-07 ; dbet(5,5) = 4.7133d-08 dbet(6,1) = -6.36d-10 ; dbet(6,2) = -1.309d-09 ; dbet(6,3) = 6.048d-09 ; dbet(6,4) = -1.1409d-09 ; dbet(6,5) = -6.676d-10 ! Compute spiciness DO jt=1,npt PRINT *,' TIME = ', jt, tim(jt)/86400.,' days' DO jk = 1, npk dmask(:,:) = 1. dtemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) dsal( :,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) WHERE(dsal == zspval ) dmask = 0 ! spiciness at time jt, at level jk dspi(:,:) = 0.d0 dsalref(:,:) = dsal(:,:) - 35.d0 dtempt(:,:) = 1.d0 DO ji=1,6 dsalt(:,:) = 1.d0 DO jj=1,5 dspi( :,:) = dspi (:,:) + dbet (ji,jj) * dtempt(:,:) * dsalt(:,:) dsalt(:,:) = dsalt(:,:) * dsalref( :,: ) END DO dtempt(:,:) = dtempt(:,:) * dtemp(:,:) END DO ierr = putvar(ncout, id_varout(1), REAL(dspi*dmask), jk, npiglo, npjglo, ktime=jt) END DO ! loop to next level END DO ! next time frame ierr = closeout(ncout) END PROGRAM cdfspice cdftools-3.0/cdfheatc.f900000644000175000017500000002020612241227304016401 0ustar amckinstryamckinstryPROGRAM cdfheatc !!====================================================================== !! *** PROGRAM cdfheatc *** !!===================================================================== !! ** Purpose : Compute the heat content of the ocean : 1 single value !! !! ** Method : compute the sum ( rho cp T * e1t *e2t * e3t * tmask ) !! !! History : 2.1 : 03/2006 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ik ! working integer INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: iimin=0, iimax=0 ! domain limitation for computation INTEGER(KIND=4) :: ijmin=0, ijmax=0 ! domain limitation for computation INTEGER(KIND=4) :: ikmin=0, ikmax=0 ! domain limitation for computation INTEGER(KIND=4) :: narg, iargc, ijarg ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvpk ! vertical levels in working variable REAL(KIND=4), PARAMETER :: pprho0=1020. ! water density (kg/m3) REAL(KIND=4), PARAMETER :: ppcp=4000. ! calorific capacity (J/kg/m3) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t ! horizontal metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3t ! vertical metric REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp ! temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! tmask REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! depth REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics in case of full step REAL(KIND=8) :: dvol ! 3D volume of the ocean REAL(KIND=8) :: dsum ! weighted sum 3D REAL(KIND=8) :: dvol2d ! volume of a layer REAL(KIND=8) :: dsum2d ! weigthed sum per layer REAL(KIND=8) :: dsurf ! surface of a layer CHARACTER(LEN=256) :: cf_tfil ! input gridT file CHARACTER(LEN=256) :: cldum ! dummy character variable LOGICAL :: lfull=.FALSE. ! flag for full step computation LOGICAL :: lchk ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfheatc T-file ...' PRINT *,' ... [imin imax jmin jmax kmin kmax] [-full] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Computes the heat content in the specified area (Joules)' PRINT *,' A sub-domain can be specified in option.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : a file with temperature and salinity' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [imin imax jmin jmax kmin kmax] : limit of a sub domain where' PRINT *,' the heat content will be calculated.' PRINT *,' - if imin = 0 then ALL i are taken' PRINT *,' - if jmin = 0 then ALL j are taken' PRINT *,' - if kmin = 0 then ALL k are taken' PRINT *,' [-full ] : assume full step model output instead of default' PRINT *,' partial steps.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' Files ',TRIM(cn_fhgr),', ',TRIM(cn_fzgr),' and ',TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : to be done ....' PRINT *,' Standard output' STOP ENDIF ijarg = 1 CALL getarg (ijarg, cf_tfil) ; ijarg = ijarg + 1 lchk = chkfile(cn_fhgr) lchk = chkfile(cn_fzgr) .OR. lchk lchk = chkfile(cn_fmsk) .OR. lchk lchk = chkfile(cf_tfil) .OR. lchk IF ( lchk ) STOP ! missing files DO WHILE ( ijarg <= narg ) CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-full' ) ; lfull = .true. CASE DEFAULT PRINT *,' Reading 6 values : imin imax jmin jmax kmin kmax ' READ(cldum,*) iimin CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmin CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmax END SELECT END DO npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) IF (iimin /= 0 ) THEN ; npiglo = iimax - iimin + 1; ELSE ; iimin=1 ; ENDIF IF (ijmin /= 0 ) THEN ; npjglo = ijmax - ijmin + 1; ELSE ; ijmin=1 ; ENDIF IF (ikmin /= 0 ) THEN ; npk = ikmax - ikmin + 1; ELSE ; ikmin=1 ; ENDIF nvpk = getvdim(cf_tfil,cn_votemper) IF (nvpk == 2 ) nvpk = 1 IF (nvpk == 3 ) nvpk = npk PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt PRINT *, 'nvpk = ', nvpk ! Allocate arrays ALLOCATE ( tmask(npiglo,npjglo) ) ALLOCATE ( temp (npiglo,npjglo) ) ALLOCATE ( e1t (npiglo,npjglo), e2t(npiglo,npjglo), e3t(npiglo,npjglo) ) ALLOCATE ( gdept(npk), tim(npt) ) IF ( lfull ) ALLOCATE ( e31d(npk) ) e1t(:,:) = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin) e2t(:,:) = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin) gdept(:) = getvare3(cn_fzgr, cn_gdept, npk) tim (:) = getvare3(cf_tfil, cn_vtimec, npt) IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk) DO jt=1,npt dvol = 0.d0 dsum = 0.d0 PRINT * ,'TIME : ', tim(jt)/86400.,' days' DO jk = 1,nvpk ik = jk + ikmin -1 ! Get velocities v at ik temp( :,:) = getvar(cf_tfil, cn_votemper, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jt) tmask(:,:) = getvar(cn_fmsk, 'tmask', ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin ) ! get e3t at level ik ( ps...) IF ( lfull ) THEN e3t(:,:) = e31d(jk) ELSE e3t(:,:) = getvar(cn_fzgr, 'e3t_ps', ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ldiom=.TRUE.) ENDIF dsurf = SUM(e1t * e2t * tmask) dvol2d = SUM(e1t * e2t * e3t * tmask) dvol = dvol + dvol2d dsum2d = SUM(e1t * e2t * e3t * temp * tmask) dsum = dsum + dsum2d IF (dvol2d /= 0 )THEN PRINT *, ' Heat Content at level ',ik,'(',gdept(ik),' m) ',pprho0*ppcp*dsum2d, 'surface = ',dsurf/1.e6,' km^2' ELSE PRINT *, ' No points in the water at level ',ik,'(',gdept(ik),' m) ' ENDIF END DO PRINT * ,' Total Heat content : ', pprho0*ppcp*dsum ,' Joules' PRINT * ,' Total Heat content/volume : ', pprho0*ppcp*dsum/dvol ,' Joules/m3 ' END DO END PROGRAM cdfheatc cdftools-3.0/cdfbuoyflx.f900000644000175000017500000004101212241227304017003 0ustar amckinstryamckinstryPROGRAM cdfbuoyflx !!====================================================================== !! *** PROGRAM cdfbuoyflx *** !!===================================================================== !! ** Purpose : Produce a file with the water flux separated into 4 components: !! E (evap), P (precip), R (runoff), dmp (sssdmp). !! The total water flux is E -P -R + dmp. Units in this program !! are mm/days. (Up to that it is the same than cdfwflx) !! !! It also produces un the same file the component of the heat flux !! Latent Heat FLux, Sensible Heat flux, Long Wave HF, Short Wave HF, !! Net HF !! !! Buoyancy fluxes are also computed, as a net value but also with the !! contribution of each term. !! !! ** Method : Evap is computed from the latent heat flux : evap=-qla/Lv !! Runoff is read from the climatological input file !! dmp is read from the file (sowafldp) !! Precip is then computed as the difference between the !! total water flux (sowaflup) and the E-R+dmp. In the high latitudes !! this precip includes the effect of snow (storage/melting). Therefore !! it may differ slightly from the input precip file. !! !! Heat fluxes are directly copied from the gridT files, same name, same units !! We also add sst and SSS for convenience. !! !! Buoyancy fluxes are also computed as : !! BF = -1/rho (alpha x TF - beta SF ) !! (TF = thermal part, SF = haline part ) !! TF = 1/(rho x Cp)* Q !! SF = 1/(1-SSS) x (E-P) x SSS !! !! History : 2.1 : 01/2008 : J.M. Molines : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4), PARAMETER :: jp_varout=25 INTEGER(KIND=4) :: ncout, ierr INTEGER(KIND=4) :: jt ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: npiglo, npjglo, npt ! size of the domain INTEGER(KIND=4), DIMENSION(jp_varout) :: ipk, id_varout ! Physical constants REAL(KIND=4) :: Lv = 2.5e6 ! latent HF <--> evap conversion REAL(KIND=4) :: Cp = 4000. ! specific heat of water REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim, zdep ! time counter, deptht REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask, zcoefq, zcoefw ! work array REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zalbet, zbeta ! work array REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: evap, precip, runoff, wdmp, wnet ! water flux components REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: wice, precip_runoff ! water flux components REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: qlat, qsb, qlw, qsw, qnet ! heat flux components REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: b_evap, b_precip, b_runoff ! BF water flux components REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: b_wdmp, bw_net ! BF water flux components REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: b_qlat, b_qsb, b_qlw ! BF heat flux components REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: b_qsw , bh_net ! BF heat flux components REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsst, zsss, buoyancy_fl ! Total buoyancy flux CHARACTER(LEN=256) :: cf_tfil , cf_rnfil ! input file gridT and runoff CHARACTER(LEN=256) :: cf_out='buoyflx.nc' ! output file TYPE(variable), DIMENSION(jp_varout) :: stypvar ! structure for attributes LOGICAL :: lchk !!---------------------------------------------------------------------- CALL ReadCdfNames() !! Read command line and output usage message if not compliant. narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfbuoyflx T-file RNF-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute (or read) the heat and water fluxes components.' PRINT *,' Compute (or read) the net heat and water fluxes.' PRINT *,' Compute the buoyancy heat and water fluxes components.' PRINT *,' Compute the net buoyancy fluxes.' PRINT *,' Save sss and sst.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with ' PRINT *,' RNF-file : netcdf file with runoff ' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : 25 variables (2D)' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' ' PRINT *,' ' STOP ENDIF CALL getarg (1, cf_tfil) CALL getarg (2, cf_rnfil) lchk = chkfile (cf_tfil ) lchk = lchk .OR. chkfile (cf_rnfil) IF (lchk ) STOP ! missing files npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npt = getdim (cf_tfil,cn_t) ! prepare output variables ALLOCATE (zdep(1), tim(npt) ) zdep(1) = 0. ipk(:) = 1 ! all variables ( output are 2D) stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' ! 1--> 7 water fluxes ; ! 8 --> 12 heat fluxes stypvar(1)%cname= 'evap' ; stypvar(8)%cname= 'latent' stypvar(2)%cname= 'precip' ; stypvar(9)%cname= 'sensible' stypvar(3)%cname= 'runoff' ; stypvar(10)%cname= 'longwave' stypvar(4)%cname= 'sssdmp' ; stypvar(11)%cname= 'solar' stypvar(5)%cname= 'watnet' ; stypvar(12)%cname= 'heatnet' stypvar(6)%cname= 'wice' stypvar(7)%cname= 'precip_runoff' stypvar(1:7)%cunits='mm/day' ; stypvar(8:12)%cunits='W/m2' stypvar(1:7)%rmissing_value=0. ; stypvar(8:12)%rmissing_value=0. stypvar(1:7)%valid_min= -100. ; stypvar(8:12)%valid_min= -500. stypvar(1:7)%valid_max= 100. ; stypvar(8:12)%valid_max= 500. stypvar(1)%clong_name='Evaporation' ; stypvar(8)%clong_name='Latent Heat flux' stypvar(2)%clong_name='Precipitation' ; stypvar(9)%clong_name='Sensible Heat flux' stypvar(3)%clong_name='Runoff' ; stypvar(10)%clong_name='Long Wave Heat flux' stypvar(4)%clong_name='SSS damping' ; stypvar(11)%clong_name='Short Wave Heat flux' stypvar(5)%clong_name='Total water flux' ; stypvar(12)%clong_name='Net Heat Flux' stypvar(6)%clong_name='Ice congelation and melting' stypvar(7)%clong_name='Precip and runoff together' stypvar(1)%cshort_name='evap' ; stypvar(8)%cshort_name='latent' stypvar(2)%cshort_name='precip' ; stypvar(9)%cshort_name='sensible' stypvar(3)%cshort_name='runoff' ; stypvar(10)%cshort_name='longwave' stypvar(4)%cshort_name='sssdmp' ; stypvar(11)%cshort_name='solar' stypvar(5)%cshort_name='watnet' ; stypvar(12)%cshort_name='heatnet' stypvar(6)%cshort_name='wice' stypvar(7)%cshort_name='precip_runoff' ! 13--> 17 buoy water fluxes ; ! 18 --> 22 buoy heat fluxes stypvar(13)%cname= 'evap_b' ; stypvar(18)%cname= 'latent_b' stypvar(14)%cname= 'precip_b' ; stypvar(19)%cname= 'sensible_b' stypvar(15)%cname= 'runoff_b' ; stypvar(20)%cname= 'longwave_b' stypvar(16)%cname= 'sssdmp_b' ; stypvar(21)%cname= 'solar_b' stypvar(17)%cname= 'watnet_b' ; stypvar(22)%cname= 'heatnet_b' stypvar(13:17)%cunits='1e-6 kg/m2/s' ; stypvar(18:22)%cunits='1e-6 kg/m2/s' stypvar(13:17)%rmissing_value=0. ; stypvar(18:22)%rmissing_value=0. stypvar(13:17)%valid_min= -100. ; stypvar(18:22)%valid_min= -500. stypvar(13:17)%valid_max= 100. ; stypvar(18:22)%valid_max= 500. stypvar(13)%clong_name='buoy flx evap' ; stypvar(18)%clong_name='buoy Latent Heat flux' stypvar(14)%clong_name='buoy flx precip' ; stypvar(19)%clong_name='buoy Sensible Heat flux' stypvar(15)%clong_name='buoy flx runoff' ; stypvar(20)%clong_name='buoy Long Wave Heat flux' stypvar(16)%clong_name='buoy flx damping' ; stypvar(21)%clong_name='buoy Short Wave Heat flux' stypvar(17)%clong_name='buoy haline flx' ; stypvar(22)%clong_name='buoy thermo Flux' stypvar(13)%cshort_name='evap_b' ; stypvar(18)%cshort_name='latent_b' stypvar(14)%cshort_name='precip_b' ; stypvar(19)%cshort_name='sensible_b' stypvar(15)%cshort_name='runoff_b' ; stypvar(20)%cshort_name='longwave_b' stypvar(16)%cshort_name='sssdmp_b' ; stypvar(21)%cshort_name='solar_b' stypvar(17)%cshort_name='watnet_b' ; stypvar(22)%cshort_name='heatnet_b' ! total buoyancy flux stypvar(23)%cname= 'buoyancy_fl' stypvar(23)%cunits='1e-6 kg/m2/s' stypvar(23)%rmissing_value=0. stypvar(23)%valid_min= -100. stypvar(23)%valid_max= 100. stypvar(23)%clong_name='buoyancy flux' stypvar(23)%cshort_name='buoyancy_fl' ! SSS ; SST stypvar(24)%cname= 'sss' ; stypvar(25)%cname= 'sst' stypvar(24)%cunits='PSU' ; stypvar(25)%cunits='Celsius' stypvar(24)%rmissing_value=0. ; stypvar(25)%rmissing_value=0. stypvar(24)%valid_min= 0. ; stypvar(25)%valid_min= -2. stypvar(24)%valid_max= 45 ; stypvar(25)%valid_max= 45 stypvar(24)%clong_name='Sea Surface Salinity' ; stypvar(25)%clong_name='Sea Surface Temperature' stypvar(24)%cshort_name='sss ' ; stypvar(25)%cshort_name='sst' PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npt =', npt ALLOCATE ( zmask(npiglo,npjglo), wnet(npiglo,npjglo), zalbet(npiglo,npjglo), zbeta(npiglo, npjglo) ) ALLOCATE ( zcoefq(npiglo,npjglo), zcoefw(npiglo,npjglo) ) ALLOCATE ( evap(npiglo,npjglo), precip(npiglo,npjglo), runoff(npiglo,npjglo), wdmp(npiglo,npjglo) ) ALLOCATE ( wice(npiglo,npjglo), precip_runoff(npiglo,npjglo) ) ALLOCATE ( qlat(npiglo,npjglo), qsb(npiglo,npjglo), qlw(npiglo,npjglo), qsw(npiglo,npjglo), qnet(npiglo,npjglo) ) ALLOCATE ( b_evap(npiglo,npjglo), b_precip(npiglo,npjglo), b_runoff(npiglo,npjglo), b_wdmp(npiglo,npjglo),bw_net(npiglo,npjglo) ) ALLOCATE ( b_qlat(npiglo,npjglo), b_qsb(npiglo,npjglo), b_qlw(npiglo,npjglo), b_qsw(npiglo,npjglo), bh_net(npiglo,npjglo)) ALLOCATE ( buoyancy_fl(npiglo,npjglo), zsst(npiglo,npjglo), zsss(npiglo,npjglo) ) ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, jp_varout, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=zdep) DO jt = 1, npt ! read sss for masking purpose and sst zsss(:,:) = getvar(cf_tfil, cn_vosaline, 1, npiglo, npjglo, ktime=jt) zmask=1. ; WHERE ( zsss == 0 ) zmask=0. zsst(:,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt) ! Evap : qlat(:,:)= getvar(cf_tfil, cn_solhflup, 1, npiglo, npjglo, ktime=jt) *zmask(:,:) ! W/m2 evap(:,:)= -1.* qlat(:,:) /Lv*86400. *zmask(:,:) ! mm/days ! Wdmp wdmp(:,:)= getvar(cf_tfil, cn_sowafldp, 1, npiglo, npjglo, ktime=jt)*86400.*zmask(:,:) ! mm/days ! Runoff ! take care : not a model output (time_counter may disagree ... jmm runoff(:,:)= getvar(cf_rnfil, 'sorunoff', 1, npiglo, npjglo)*86400.*zmask(:,:) ! mm/days ! total water flux (emps) wnet(:,:) = getvar(cf_tfil, cn_sowaflcd, 1, npiglo, npjglo, ktime=jt )*86400.*zmask(:,:) ! mm/days ! fsalt = contribution of ice freezing and melting to salinity ( + = freezing, - = melting )Q wice(:,:) = getvar(cf_tfil, cn_iowaflup, 1, npiglo, npjglo, ktime=jt )*86400.*zmask(:,:) ! mm/days ! Precip: precip(:,:)= evap(:,:)-runoff(:,:)+wdmp(:,:)-wnet(:,:)+wice(:,:) ! mm/day ! Precip+runoff : (as a whole ) (interpolated on line) precip_runoff(:,:)= evap(:,:)+wdmp(:,:)-wnet(:,:)+wice(:,:) ! mm/day ! other heat fluxes qsb(:,:)= getvar(cf_tfil, cn_sosbhfup, 1, npiglo, npjglo, ktime = jt )*zmask(:,:) ! W/m2 qlw(:,:)= getvar(cf_tfil, cn_solwfldo, 1, npiglo, npjglo, ktime = jt )*zmask(:,:) ! W/m2 qsw(:,:)= getvar(cf_tfil, cn_soshfldo, 1, npiglo, npjglo, ktime = jt )*zmask(:,:) ! W/m2 qnet(:,:)=getvar(cf_tfil, cn_sohefldo, 1, npiglo, npjglo, ktime = jt )*zmask(:,:) ! W/m2 ! buoyancy flux zalbet(:,:)= albet ( zsst, zsss, 0., npiglo, npjglo) zbeta (:,:)= beta ( zsst, zsss, 0., npiglo, npjglo) zcoefq(:,:)= -zbeta * zalbet /Cp * 1.e6 zcoefw(:,:)= zbeta * zsss/(1-zsss/1000.)/86400. *1.e6 ! division by 86400 to get back water fluxes in kg/m2/s buoyancy_fl=0. ; bh_net=0. ; b_qlat=0. ; b_qlw=0. ; b_qsw=0. ; b_qsb=0. bw_net=0. ; b_evap=0. ; b_precip=0.; b_wdmp=0. ; b_runoff=0. WHERE (zsss /= 0 ) bh_net(:,:)= zcoefq * qnet b_qlat(:,:)= zcoefq * qlat b_qlw (:,:)= zcoefq * qlw b_qsw (:,:)= zcoefq * qsw b_qsb (:,:)= zcoefq * qsb bw_net(:,:)= zcoefw * wnet b_evap(:,:)= zcoefw * evap b_precip(:,:)= -zcoefw * precip b_runoff(:,:)= -zcoefw * runoff b_wdmp(:,:)= zcoefw * wdmp ! buoyancy_fl(:,:) = zcoefq * qnet +zcoefw * wnet buoyancy_fl(:,:) = bh_net + bw_net END WHERE ! Write output file ierr = putvar(ncout, id_varout(1), evap, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(2), precip, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(3), runoff, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(4), wdmp, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(5), wnet, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(6), wice, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(7), precip_runoff, 1,npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(8), qlat, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(9), qsb, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(10),qlw, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(11),qsw, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(12),qnet, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(13),b_evap, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(14),b_precip,1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(15),b_runoff,1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(16),b_wdmp, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(17),bw_net, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(18),b_qlat, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(19),b_qsb, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(20),b_qlw, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(21),b_qsw, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(22),bh_net, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(23),buoyancy_fl, 1,npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(24), zsss, 1, npiglo, npjglo, ktime=jt ) ierr = putvar(ncout, id_varout(25), zsst, 1, npiglo, npjglo, ktime=jt ) END DO ! time loop tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr=closeout(ncout) END PROGRAM cdfbuoyflx cdftools-3.0/License/0000755000175000017500000000000012241227304015702 5ustar amckinstryamckinstrycdftools-3.0/License/CDFTOOLSCeCILL.txt0000644000175000017500000000373412241227304020603 0ustar amckinstryamckinstryThe following licence information concerns ONLY the CDFTOOLS package ======================================================================= Copyright © LEGI-MEOM (Jean-Marc.Molines@legi.grenoble-inp.fr ) Contributors : M. Balmaseda, E. Behrens, F. Castruccio, J. Deshayes, N. Djath, C. Dufour, R. Dussin, N. Ferry, F. Hernandez, M. Juza, A. Lecointre, P. Mathiot, A. Melet, G. Moreau, A.M. Treguier This software is a computer program for analysis of NEMO model output produced in the frame of the DRAKKAR project. It is designed for the treatment of the NetCdf files produced by NEMO-DRAKKAR. This software is governed by the CeCILL license under French law and abiding by the rules of distribution of free software. You can use, modify and/ or redistribute the software under the terms of the CeCILL license as circulated by CEA, CNRS and INRIA at the following URL "http://www.cecill.info". As a counterpart to the access to the source code and rights to copy, modify and redistribute granted by the license, users are provided only with a limited warranty and the software's author, the holder of the economic rights, and the successive licensors have only limited liability. In this respect, the user's attention is drawn to the risks associated with loading, using, modifying and/or developing or reproducing the software by the user in light of its specific status of free software, that may mean that it is complicated to manipulate, and that also therefore means that it is reserved for developers and experienced professionals having in-depth computer knowledge. Users are therefore encouraged to load and test the software's suitability as regards their requirements in conditions enabling the security of their systems and/or data to be ensured and, more generally, to use and operate it in the same conditions as regards security. The fact that you are presently reading this means that you have had knowledge of the CeCILL license and that you accept its terms. cdftools-3.0/cdfmoy.f900000644000175000017500000005341212241227304016126 0ustar amckinstryamckinstryPROGRAM cdfmoy !!====================================================================== !! *** PROGRAM cdfmoy *** !!===================================================================== !! ** Purpose : Compute mean values for all the variables in a bunch !! of cdf files given as argument !! Store the results on a 'similar' cdf file. !! !! ** Method : Also store the mean squared values for the nn_sqdvar !! variables belonging to cn_sqdvar(:), than can be changed !! in the nam_cdf_names namelist if wished. !! Optionally order 3 moments for some variables can be !! computed. !! !! History : 2.0 : 11/2004 : J.M. Molines : Original code !! : 2.1 : 06/2007 : P. Mathiot : Modif for forcing fields !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! varchk2 : check if variable is candidate for square mean !! varchk3 : check if variable is candidate for cubic mean !! zeromean : substract mean value from input field !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!----------------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jfil ! dummy loop index INTEGER(KIND=4) :: jvar, jv, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! browsing command line INTEGER(KIND=4) :: nfil ! number of files to average INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! number of variables in a file INTEGER(KIND=4) :: ntframe ! cumul of time frame INTEGER(KIND=4) :: ncout ! ncid of output files INTEGER(KIND=4) :: ncout2 ! ncid of output files INTEGER(KIND=4) :: ncout3 ! ncid of output files INTEGER(KIND=4) :: nperio=4 ! ncid of output files INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! varid's of average vars INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout2 ! varid's of sqd average vars INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout3 ! varid's of cub average vars REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! array to read a layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rmean ! average REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rmean2 ! squared average REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rmean3 ! cubic average REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zspval_in ! time counter REAL(KIND=4), DIMENSION(1) :: timean ! mean time REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtab, dtab2 ! arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtab3 ! arrays for cumulated values REAL(KIND=8) :: dtotal_time ! to compute mean time CHARACTER(LEN=256) :: cf_in ! input file names CHARACTER(LEN=256) :: cf_out = 'cdfmoy.nc' ! output file for average CHARACTER(LEN=256) :: cf_out2 = 'cdfmoy2.nc' ! output file for squared average CHARACTER(LEN=256) :: cf_out3 = 'cdfmoy3.nc' ! output file for squared average CHARACTER(LEN=256) :: cv_dep ! depth dimension name CHARACTER(LEN=256) :: cldum ! dummy string argument CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cf_list ! list of input files CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nam ! array of var name CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nam2 ! array of var2 name for output CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nam3 ! array of var3 name for output TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! attributes for average values TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar2 ! attributes for square averaged values TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar3 ! attributes for cubic averaged values LOGICAL :: lcaltmean ! mean time computation flag LOGICAL :: lspval0 = .false. ! cdfmoy_chsp flag LOGICAL :: lcubic = .false. ! 3rd momment computation LOGICAL :: lzermean = .false. ! flag for zero-mean process LOGICAL :: lchk = .false. ! flag for missing files !!---------------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmoy list_of_model_files [-spval0] [-cub ] [-zeromean]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the time average of a list of files given as arguments.' PRINT *,' The program assume that all files in the list are of same' PRINT *,' type (shape, variables etc...). ' PRINT *,' For some variables, the program also compute the time average ' PRINT *,' of the squared variables, which is used in other cdftools ' PRINT *,' (cdfeke, cdfrmsssh, cdfstdevw, cdfstddevts ... The actual variables' PRINT *,' selected for squared average are :' PRINT '(10x,"- ",a)' , (TRIM(cn_sqdvar(jv)), jv=1, nn_sqdvar) PRINT *,' This selection can be adapted with the nam_cdf_namelist process.' PRINT *,' (See cdfnamelist -i for details).' PRINT *,' If you want to compute the average of already averaged files,' PRINT *,' consider using cdfmoy_weighted instead, in order to take into' PRINT *,' account a particular weight for each file in the list.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' A list of similar model output files. ' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -spval0 ] : set missing_value attribute to 0 for all output' PRINT *,' variables and take care of the input missing_value.' PRINT *,' This option is usefull if missing_values differ from files ' PRINT *,' to files; it was formely done by cdfmoy_chsp).' PRINT *,' [ -cub ] : use this option if you want to compute third order moment' PRINT *,' for the eligible variables, which are at present :' PRINT '(15x,"- ",a)' , (TRIM(cn_cubvar(jv)), jv=1, nn_cubvar) PRINT *,' This selection can be adapted with the nam_cdf_namelist process.' PRINT *,' (See cdfnamelist -i for details).' PRINT *,' [ -zeromean ] : with this option, the spatial mean value for each ' PRINT *,' time frame is substracted from the original field previous ' PRINT *,' averaging, square averaging and eventually cubic averaging' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' If -zeromean option is used, need ', TRIM(cn_fhgr),' and ',TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out),' and ',TRIM(cf_out2) PRINT *,' variables : are the same than in the input files. For squared averages' PRINT *,' _sqd is append to the original variable name.' PRINT *,' IF -cub option is used, the file ', TRIM(cf_out3),' is also created' PRINT *,' with _cub append to the original variable name.' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfmoy_weighted, cdfstdev' PRINT *,' ' STOP ENDIF ALLOCATE ( cf_list(narg) ) ! look for -spval0 option and set up cf_list, nfil ijarg = 1 nfil = 0 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-spval0' ) ! option to reset spval to 0 in the output files lspval0 = .true. CASE ( '-cub' ) ! option to reset spval to 0 in the output files lcubic = .true. CASE ( '-zeromean' ) ! option to reset spval to 0 in the output files lzermean = .true. CASE DEFAULT ! then the argument is a file nfil = nfil + 1 cf_list(nfil) = TRIM(cldum) END SELECT END DO IF ( lzermean ) THEN lchk = lchk .OR. chkfile ( cn_fhgr ) lchk = lchk .OR. chkfile ( cn_fmsk ) IF ( lchk ) STOP ! missing files ENDIF ! Initialisation from 1rst file (all file are assume to have the same geometry) ! time counter can be different for each file in the list. It is read in the ! loop for files cf_in = cf_list(1) IF ( chkfile (cf_in) ) STOP ! missing file npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in, 'z',cdtrue=cv_dep,kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'nav_lev',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'levels',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF ENDIF ENDIF PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk ALLOCATE( dtab(npiglo,npjglo), dtab2(npiglo,npjglo), v2d(npiglo,npjglo) ) ALLOCATE( rmean(npiglo,npjglo), rmean2(npiglo,npjglo) ) IF ( lcubic ) THEN ALLOCATE( dtab3(npiglo,npjglo), rmean3(npiglo,npjglo) ) ENDIF nvars = getnvar(cf_in) PRINT *,' nvars = ', nvars ALLOCATE (cv_nam(nvars), cv_nam2(nvars) ) ALLOCATE (stypvar(nvars), stypvar2(nvars) ) ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars), id_varout2(nvars) ) IF ( lcubic ) THEN ALLOCATE (cv_nam3(nvars), stypvar3(nvars), id_varout3(nvars) ) ENDIF ! get list of variable names and collect attributes in stypvar (optional) cv_nam(:) = getvarname(cf_in,nvars,stypvar) IF ( lspval0 ) THEN ALLOCATE ( zspval_in(nvars) ) zspval_in(:) = stypvar(:)%rmissing_value stypvar(:)%rmissing_value = 0. ENDIF IF ( lcubic) THEN ! force votemper to be squared saved nn_sqdvar = nn_sqdvar + 1 cn_sqdvar(nn_sqdvar) = TRIM(cn_votemper) ENDIF DO jvar = 1, nvars ! variables that will not be computed or stored are named 'none' IF ( varchk2 ( cv_nam(jvar) ) ) THEN cv_nam2(jvar) = TRIM(cv_nam(jvar))//'_sqd' stypvar2(jvar)%cname = TRIM(stypvar(jvar)%cname)//'_sqd' ! name stypvar2(jvar)%cunits = '('//TRIM(stypvar(jvar)%cunits)//')^2' ! unit stypvar2(jvar)%rmissing_value = stypvar(jvar)%rmissing_value ! missing_value stypvar2(jvar)%valid_min = 0. ! valid_min = zero stypvar2(jvar)%valid_max = stypvar(jvar)%valid_max**2 ! valid_max *valid_max stypvar2(jvar)%scale_factor = 1. stypvar2(jvar)%add_offset = 0. stypvar2(jvar)%savelog10 = 0. stypvar2(jvar)%clong_name = TRIM(stypvar(jvar)%clong_name)//'_Squared' ! stypvar2(jvar)%cshort_name = TRIM(stypvar(jvar)%cshort_name)//'_sqd' ! stypvar2(jvar)%conline_operation = TRIM(stypvar(jvar)%conline_operation) stypvar2(jvar)%caxis = TRIM(stypvar(jvar)%caxis) ELSE cv_nam2(jvar) = 'none' END IF ! check for cubic average IF ( lcubic ) THEN IF ( varchk3 ( cv_nam(jvar) ) ) THEN cv_nam3(jvar) = TRIM(cv_nam(jvar))//'_cub' stypvar3(jvar)%cname = TRIM(stypvar(jvar)%cname)//'_cub' ! name stypvar3(jvar)%cunits = '('//TRIM(stypvar(jvar)%cunits)//')^3' ! unit stypvar3(jvar)%rmissing_value = stypvar(jvar)%rmissing_value ! missing_value stypvar3(jvar)%valid_min = 0. ! valid_min = zero stypvar3(jvar)%valid_max = stypvar(jvar)%valid_max**3 ! valid_max *valid_max stypvar3(jvar)%scale_factor = 1. stypvar3(jvar)%add_offset = 0. stypvar3(jvar)%savelog10 = 0. stypvar3(jvar)%clong_name = TRIM(stypvar(jvar)%clong_name)//'_Cubed' ! stypvar3(jvar)%cshort_name = TRIM(stypvar(jvar)%cshort_name)//'_cub' ! stypvar3(jvar)%conline_operation = TRIM(stypvar(jvar)%conline_operation) stypvar3(jvar)%caxis = TRIM(stypvar(jvar)%caxis) ELSE cv_nam3(jvar) = 'none' END IF ENDIF END DO id_var(:) = (/(jv, jv=1,nvars)/) ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk (cf_in,nvars,cdep=cv_dep) WHERE( ipk == 0 ) cv_nam='none' stypvar (:)%cname = cv_nam stypvar2(:)%cname = cv_nam2 IF ( lcubic ) stypvar3(:)%cname = cv_nam3 ! create output file taking the sizes in cf_in ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep) ierr = createvar (ncout , stypvar, nvars, ipk, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk, cdep=cv_dep) ncout2 = create (cf_out2, cf_in, npiglo, npjglo, npk, cdep=cv_dep) ierr = createvar (ncout2, stypvar2, nvars, ipk, id_varout2 ) ierr = putheadervar(ncout2, cf_in, npiglo, npjglo, npk, cdep=cv_dep) IF ( lcubic) THEN ncout3 = create (cf_out3, cf_in, npiglo, npjglo, npk, cdep=cv_dep) ierr = createvar (ncout3, stypvar3, nvars, ipk, id_varout3 ) ierr = putheadervar(ncout3, cf_in, npiglo, npjglo, npk, cdep=cv_dep) ENDIF lcaltmean=.TRUE. DO jvar = 1,nvars IF ( cv_nam(jvar) == cn_vlon2d .OR. & ! nav_lon cv_nam(jvar) == cn_vlat2d ) THEN ! nav_lat ! skip these variable ELSE PRINT *,' Working with ', TRIM(cv_nam(jvar)), ipk(jvar) DO jk = 1, ipk(jvar) PRINT *,'level ',jk dtab(:,:) = 0.d0 ; dtab2(:,:) = 0.d0 ; dtotal_time = 0. IF ( lcubic ) THEN ; dtab3(:,:) = 0.d0 ; ENDIF ntframe = 0 DO jfil = 1, nfil cf_in = cf_list(jfil) IF ( jk == 1 ) THEN IF ( chkfile (cf_in) ) STOP ! missing file ENDIF npt = getdim (cf_in, cn_t) IF ( lcaltmean ) THEN ALLOCATE ( tim(npt) ) tim = getvar1d(cf_in, cn_vtimec, npt) dtotal_time = dtotal_time + SUM(DBLE(tim(:))) DEALLOCATE (tim ) END IF DO jt=1,npt ntframe = ntframe + 1 v2d(:,:) = getvar(cf_in, cv_nam(jvar), jk ,npiglo, npjglo,ktime=jt ) IF ( lspval0 ) WHERE (v2d == zspval_in(jvar)) v2d = 0. ! change missing values to 0 IF ( lzermean ) CALL zeromean (jk, v2d ) dtab(:,:) = dtab(:,:) + v2d(:,:)*1.d0 IF (cv_nam2(jvar) /= 'none' ) dtab2(:,:) = dtab2(:,:) + v2d(:,:)*v2d(:,:)*1.d0 IF ( lcubic ) THEN IF (cv_nam3(jvar) /= 'none' ) dtab3(:,:) = dtab3(:,:) + v2d(:,:)*v2d(:,:)*v2d(:,:) *1.d0 ENDIF ENDDO END DO ! finish with level jk ; compute mean (assume spval is 0 ) rmean(:,:) = dtab(:,:)/ntframe IF (cv_nam2(jvar) /= 'none' ) rmean2(:,:) = dtab2(:,:)/ntframe IF ( lcubic ) THEN IF (cv_nam3(jvar) /= 'none' ) rmean3(:,:) = dtab3(:,:)/ntframe ENDIF ! store variable on outputfile ierr = putvar(ncout, id_varout(jvar), rmean, jk, npiglo, npjglo, kwght=ntframe) IF (cv_nam2(jvar) /= 'none' ) THEN ierr = putvar(ncout2, id_varout2(jvar), rmean2, jk, npiglo, npjglo, kwght=ntframe) ENDIF IF ( lcubic) THEN IF (cv_nam3(jvar) /= 'none' ) THEN ierr = putvar(ncout3, id_varout3(jvar), rmean3, jk, npiglo, npjglo, kwght=ntframe) ENDIF ENDIF IF (lcaltmean ) THEN timean(1) = dtotal_time/ntframe ierr = putvar1d(ncout, timean, 1, 'T') ierr = putvar1d(ncout2, timean, 1, 'T') IF (lcubic) ierr = putvar1d(ncout3, timean, 1, 'T') END IF lcaltmean=.FALSE. ! tmean already computed END DO ! loop to next level END IF END DO ! loop to next var in file ierr = closeout(ncout) ierr = closeout(ncout2) IF ( lcubic ) ierr = closeout(ncout3 ) CONTAINS LOGICAL FUNCTION varchk2 ( cd_var ) !!--------------------------------------------------------------------- !! *** FUNCTION varchk2 *** !! !! ** Purpose : Return true if cd_var is candidate for mean squared value !! !! ** Method : List of candidate is established in modcdfnames, and !! can be changed via the nam_cdf_names namelist !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cd_var INTEGER(KIND=4) :: jv !!---------------------------------------------------------------------- varchk2 = .FALSE. DO jv = 1, nn_sqdvar IF ( cd_var == cn_sqdvar(jv) ) THEN varchk2 = .TRUE. exit ENDIF ENDDO END FUNCTION varchk2 LOGICAL FUNCTION varchk3 ( cd_var ) !!--------------------------------------------------------------------- !! *** FUNCTION varchk3 *** !! !! ** Purpose : Return true if cd_var is candidate for cubic mean average !! !! ** Method : List of candidate is established in modcdfnames, and !! can be changed via the nam_cdf_names namelist !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cd_var INTEGER(KIND=4) :: jv !!---------------------------------------------------------------------- varchk3 = .FALSE. DO jv = 1, nn_cubvar IF ( cd_var == cn_cubvar(jv) ) THEN varchk3 = .TRUE. exit ENDIF ENDDO END FUNCTION varchk3 SUBROUTINE zeromean(kk, ptab) !!--------------------------------------------------------------------- !! *** ROUTINE zeromean *** !! !! ** Purpose : Computes the spatial average of argument and !! and substract it from the field !! !! ** Method : requires the horizontal metrics !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT( in) :: kk REAL(KIND=4), DIMENSION(:,:), INTENT(inout) :: ptab REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE, SAVE :: ze2, ze1, tmask, tmask0 REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE, SAVE :: dareas REAL(KIND=8), SAVE :: darea REAL(KIND=8) :: dmean LOGICAL, SAVE :: lfirst=.true. !!---------------------------------------------------------------------- IF (lfirst) THEN lfirst=.false. ! read e1 e2 and tmask ( assuming this prog only deal with T-points) ALLOCATE ( ze1(npiglo, npjglo), ze2(npiglo,npjglo) ) ALLOCATE ( tmask(npiglo,npjglo), tmask0(npiglo,npjglo) ) ALLOCATE ( dareas(npiglo,npjglo) ) ze1(:,:) = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) ze2(:,:) = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) dareas(:,:) = ze1(:,:) * ze2(:,:) *1.d0 ENDIF tmask0(:,:) = getvar(cn_fmsk, 'tmask', kk, npiglo, npjglo) tmask = tmask0 tmask(1,:)=0 ; tmask(npiglo,:)=0 ; tmask(:,1) = 0.; tmask(:,npjglo) = 0 IF ( nperio == 3 .OR. nperio == 4 ) THEN tmask(npiglo/2+1:npiglo,npjglo-1) = 0. ENDIF darea = SUM( dareas * tmask ) IF ( darea /= 0.d0 ) THEN dmean = SUM( ptab * dareas ) / darea ELSE dmean = 0.d0 ENDIF WHERE ( ptab /= 0 ) ptab = ( ptab - dmean ) * tmask0 END SUBROUTINE zeromean END PROGRAM cdfmoy cdftools-3.0/cdfcensus.f900000644000175000017500000003576012241227304016630 0ustar amckinstryamckinstryPROGRAM cdfcensus !!====================================================================== !! *** PROGRAM cdfcensus *** !!===================================================================== !! ** Purpose : Build an array giving the volume of water in a TS cell. !! !! ** Method : T-file and S-file are scanned for a given region !! (eventually limited in depth) and the volume of water in !! a (T,S) cell such that T < Tmodele < T+dt and !! S < Smodele < S+ds. !! If Smodel or T model are out of the bound they are !! cumulated in the nearest (T,S) cell. !! The output is done on a bimg file where S is given as !! the x-direction and T the y-direction, the field value !! being the volume of water. Due to a very large range in !! the water volume over the TS field the field is indeed !! the LOG (1 + VOLUME), and even, the scale can be made !! more non-linear by repeating the LOG operation, ie, for !! example, field=LOG(1 + LOG (1 + VOLUME)). The parameter !! nlog, passed as command argument can be used to fix the !! number of LOG. If nlog = 0, the true volume is saved. !! Depending on the user purpose, limiting values tmin, !! tmax, and smin,smax as well as the increments dt, ds can !! be adjusted. !! output is STILL a dimg file !! !! History : -- : 02/1997 : J.M. Molines as bimgtools in DYNAMO !! -- : 09/1999 : A. de Miranda for OPA !! : 01/2002 : J.M. Molines : DOctor norm !! : 01/2006 : C. Langlais : CDF I and partial cell !! 2.0 : 03/2006 : J.M. Molines : integration in CDFTOOLS !! 2.1 : 12/2006 : J.M. Molines : add sigma-2 and sigma-4 O !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt, jlog INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nlog INTEGER(KIND=4) :: narg, iargc, ijarg INTEGER(KIND=4) :: it, is INTEGER(KIND=4) :: ii1, ii2 INTEGER(KIND=4) :: ij1, ij2 INTEGER(KIND=4) :: ik1, ik2 INTEGER(KIND=4) :: nt, ns INTEGER(KIND=4) :: ncout, ierr INTEGER(KIND=4), DIMENSION(2) :: ijloc INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zt, zs, rsigma0, rsigma2, rsigma4 REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3t REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsx, zty REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: rdumdep, tim REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d REAL(KIND=4) :: ztmin, ztmax, zdt, ztm REAL(KIND=4) :: zsmin, zsmax, zds, zsm REAL(KIND=4) :: ztpoint, zspoint, rcmax REAL(KIND=8) :: dvoltotal, dvolpoint REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcensus, ddump CHARACTER(LEN=256) :: cf_tfil CHARACTER(LEN=256) :: cf_bimg='censusopa.bimg' CHARACTER(LEN=256) :: cf_out='census.nc' CHARACTER(LEN=256) :: cglobal CHARACTER(LEN=256) :: cline1, cline2, cline3, cline4 CHARACTER(LEN=256) :: cldum TYPE(variable), DIMENSION(4) :: stypvar LOGICAL :: lcdf=.TRUE. , lbimg=.FALSE. LOGICAL :: lchk LOGICAL :: lfull = .FALSE. ! flag for full step ! Initialisations DATA ztmin, ztmax, zdt /-2.0, 38.0, 0.05/ DATA zsmin, zsmax, zds /25.0, 40.0, 0.02/ !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfcensus T-file nlog [-zoom imin imax jmin jmax] ...' PRINT *,' ... [-klim kmin kmax] [-full] [-bimg] ... ' PRINT *,' ... [-srange smin smax ds ] ...' PRINT *,' ... [-trange tmin tmax dt ] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the volumetric water mass census: the ocean is divided in' PRINT *,' T,S bins; the program gives the volume of water for each bin.' PRINT *,' A sub-area can be specified, both horizontaly and vertically.' PRINT *,' Temperature and salinity ranges can be also adapted, as well as the' PRINT *,' width of the bins. Default values are provided. In order to attenuate' PRINT *,' the huge maximum values, a log10 operator can be applied many times,' PRINT *,' the number of filter passes being set on the command line.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file name for temperature and salinity' PRINT *,' nlog : number of log10 filter to perform. Can be 0.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-zoom imin imax jmin jmax] : define a model sub-area, in model ' PRINT *,' coordinates' PRINT *,' [-klim ik1 ik2 ] : set limits on the vertical.' PRINT *,' [-srange smin smax ds ] : define the size of the salinity bin' PRINT '(a,2f5.1,x,f6.3)',' defaut is :', zsmin, zsmax, zds PRINT *,' [-trange tmin tmax dt ] : define the size of the temperatude bin' PRINT '(a,2f5.1,x,f6.3)',' defaut is :', ztmin, ztmax, zdt PRINT *,' [-full ] : use for full step computation' PRINT *,' [-bimg ] : output on bimg files (to be deprecated).' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' - netcdf file : ', TRIM(cf_out) PRINT *,' variables : volcensus (10^15 m3 )' PRINT *,' sigma0 (kg/m3 -1000 )' PRINT *,' sigma2 (kg/m3 -1000 )' PRINT *,' sigma3 (kg/m3 -1000 )' PRINT *,' - bimg file : According to options.' STOP ENDIF ijarg = 1 CALL getarg(ijarg, cf_tfil) ; ijarg = ijarg + 1 CALL getarg(ijarg, cldum ) ; ijarg = ijarg + 1 ; READ(cldum,*) nlog cglobal = 'Census computed from '//TRIM(cf_tfil) lchk = chkfile ( cn_fzgr ) lchk = lchk .OR. chkfile ( cn_fhgr ) lchk = lchk .OR. chkfile ( cf_tfil ) IF ( lchk ) STOP ! some compulsory files are missing PRINT *,' TS_FILE = ',TRIM(cf_tfil) PRINT *,' NLOG = ', nlog ! set domain size from TS file npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt ! Allocate memory ALLOCATE (zt(npiglo,npjglo),zs(npiglo,npjglo)) ALLOCATE (e1t(npiglo,npjglo),e2t(npiglo,npjglo),e31d(npk),e3t(npiglo,npjglo)) ! Read metrics e1t(:,:) = getvar (cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e2t(:,:) = getvar (cn_fhgr, cn_ve2t, 1, npiglo, npjglo) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk ) ! used in full step case ! default is full domain, full depth ii1 = 1 ; ii2 = npiglo ij1 = 1 ; ij2 = npjglo ik1 = 1 ; ik2 = npk ! Read additional optional argument (zoom) DO WHILE ( ijarg <= narg ) CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum) CASE ( '-zoom' ) CALL getarg(ijarg,cldum) ; READ(cldum,*) ii1 ; ijarg = ijarg+1 CALL getarg(ijarg,cldum) ; READ(cldum,*) ii2 ; ijarg = ijarg+1 CALL getarg(ijarg,cldum) ; READ(cldum,*) ij1 ; ijarg = ijarg+1 CALL getarg(ijarg,cldum) ; READ(cldum,*) ij2 ; ijarg = ijarg+1 CASE ( '-klim' ) CALL getarg(ijarg,cldum) ; READ(cldum,*) ik1 ; ijarg = ijarg+1 CALL getarg(ijarg,cldum) ; READ(cldum,*) ik2 ; ijarg = ijarg+1 CASE ( '-bimg' ) lbimg = .TRUE. lcdf = .FALSE. CASE ( '-srange' ) CALL getarg(ijarg,cldum) ; READ(cldum,*) zsmin ; ijarg = ijarg+1 CALL getarg(ijarg,cldum) ; READ(cldum,*) zsmax ; ijarg = ijarg+1 CALL getarg(ijarg,cldum) ; READ(cldum,*) zds ; ijarg = ijarg+1 CASE ( '-trange' ) CALL getarg(ijarg,cldum) ; READ(cldum,*) ztmin ; ijarg = ijarg+1 CALL getarg(ijarg,cldum) ; READ(cldum,*) ztmax ; ijarg = ijarg+1 CALL getarg(ijarg,cldum) ; READ(cldum,*) zdt ; ijarg = ijarg+1 CASE ( '-full' ) lfull = .TRUE. CASE DEFAULT PRINT *,' Unknown option :',TRIM(cldum) STOP END SELECT END DO ! Extra checking for over bound ii1 = MAX(ii1,1) ; ii2 = MIN(ii2,npiglo) ij1 = MAX(ij1,1) ; ij2 = MIN(ij2,npjglo) ik1 = MAX(ik1,1) ; ik2 = MIN(ik2,npk ) PRINT '(a,6i5)','indices:',ii1, ii2, ij1, ij2, ik1, ik2 ! Compute the census on the requested domain PRINT *,' Water mass census on the file ' PRINT *, TRIM(cf_tfil) PRINT *, ' running .........' nt = NINT( (ztmax - ztmin )/zdt + 1 ) ns = NINT( (zsmax - zsmin )/zds + 1 ) ! Allocate arrays ALLOCATE ( dcensus (ns,nt), ddump(ns,nt) ) ALLOCATE ( rsigma0(ns,nt), rsigma2(ns,nt), rsigma4(ns,nt) ) ALLOCATE ( zsx (ns,nt), zty(ns,nt), rdumdep(1), tim(npt)) ! fill up rsigma0 array with theoretical density DO ji=1,ns DO jj=1,nt zsx(ji,jj) = zsmin + (ji-1)*zds zty(ji,jj) = ztmin + (jj-1)*zdt END DO END DO rsigma0 = sigma0(zty, zsx, ns, nt) rsigma2 = sigmai(zty, zsx, 2000., ns, nt) rsigma4 = sigmai(zty, zsx, 4000., ns, nt) rdumdep(1) = 0. IF ( lcdf ) THEN ! create output fileset ipk(:)= 1 stypvar%rmissing_value = -100. stypvar%valid_min = 0. stypvar%valid_max = 1.e20 stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' stypvar(1)%cname = 'volcensus' stypvar(2)%cname = 'sigma0' stypvar(3)%cname = 'sigma2' stypvar(4)%cname = 'sigma4' stypvar(1)%cunits = 'm3' stypvar(2:4)%cunits = 'kg/m3' stypvar(1)%clong_name = 'Volume_Census_TS' stypvar(2)%clong_name = 'Sigma0_TS' stypvar(3)%clong_name = 'Sigma2_TS' stypvar(4)%clong_name = 'Sigma4_TS' stypvar(1)%cshort_name = 'volcensus' stypvar(2)%cshort_name = 'sigma0' stypvar(3)%cshort_name = 'sigma2' stypvar(4)%cshort_name = 'sigma4' ncout = create (cf_out, cf_tfil, ns, nt, 1 ) ierr = createvar (ncout, stypvar, 4, ipk, id_varout, cdglobal=cglobal ) ierr = putheadervar(ncout, cf_tfil, ns, nt, 1, pnavlon=zsx, pnavlat=zty, pdep=rdumdep ) ENDIF DO jt = 1, npt ! reset cumulating variables to 0 dcensus(:,:) = 0.d0 dvoltotal = 0.d0 ! Enter main loop DO jk=ik1,ik2 zt(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime = jt) zs(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime = jt) IF ( lfull ) THEN e3t(:,:) = e31d(jk) ELSE e3t(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF DO ji=ii1,ii2 DO jj=ij1,ij2 ztpoint = zt(ji,jj) zspoint = zs(ji,jj) dvolpoint = e1t(ji,jj)*e2t(ji,jj)*e3t(ji,jj)*1.d0 ! salinity = 0 on masked points ( OPA !!! ) IF (zspoint /= 0) THEN it=NINT( (ztpoint-ztmin)/zdt) + 1 is=NINT( (zspoint-zsmin)/zds) + 1 ! check for out of bound values it = MIN ( MAX(it,1), nt ) is = MIN ( MAX(is,1), ns ) dcensus(is,it) = dcensus(is,it) + dvolpoint*1.d-15 dvoltotal = dvoltotal + dvolpoint*1.d-15 END IF END DO END DO END DO ! Main loop ! Computes some statistics rcmax = MAXVAL ( dcensus ) ijloc = MAXLOC ( dcensus ) zsm = zsmin + (ijloc(1) -1 ) * zds ztm = ztmin + (ijloc(2) -1 ) * zdt PRINT *,' Total Volume of the domain in 10^15 m3:', REAL(dvoltotal) PRINT *,' Volume of the most represented water mass :', rcmax PRINT '(a,f6.2,a)' ,' this is about ', rcmax/dvoltotal *100,' % of the total' PRINT *,' Salinity = ', zsm PRINT *,' Temperature= ', ztm ! use a distorsion function ( n x log ) to reduce extrema in the output file. ddump(:,:) = dcensus(:,:) DO jlog = 1, nlog ddump(:,:) = LOG10 (1.d0 + ddump(:,:) ) ENDDO IF ( lcdf ) THEN ! Output on census.nc file ierr = putvar(ncout, id_varout(1), REAL(ddump), 1, ns, nt, ktime=jt) ierr = putvar(ncout, id_varout(2), rsigma0, 1, ns, nt, ktime=jt) ierr = putvar(ncout, id_varout(3), rsigma2, 1, ns, nt, ktime=jt) ierr = putvar(ncout, id_varout(4), rsigma4, 1, ns, nt, ktime=jt) ENDIF ENDDO ! time loop IF ( lcdf ) THEN tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) ENDIF IF (lbimg ) THEN ! Output on bimg file OPEN (10,file=cf_bimg,form='UNFORMATTED') WRITE(cline1,942)' Water Masses Census [10-15 m3] on',ii1,ii2,ij1,ij2 942 FORMAT(a,4i5) cline2 = ' computed from the following T-S files:' cline3 = cf_tfil cline4 = '' ! WRITE(10) cline1 WRITE(10) cline2 WRITE(10) cline3 WRITE(10) cline4 WRITE(10) ns, nt, 1, 1, 4, nlog WRITE(10) zsmin, ztmin, zds, zdt, 0. WRITE(10) 0. WRITE(10) 0. WRITE(10) ((REAL(ddump(ji,jj)),ji=1,ns),jj=1,nt) WRITE(10) ((rsigma0(ji,jj), ji=1,ns),jj=1,nt) WRITE(10) ((rsigma2(ji,jj), ji=1,ns),jj=1,nt) WRITE(10) ((rsigma4(ji,jj), ji=1,ns),jj=1,nt) CLOSE(10) ENDIF PRINT *,' Done.' END PROGRAM cdfcensus cdftools-3.0/cdfmsk.f900000644000175000017500000000544212241227304016114 0ustar amckinstryamckinstryPROGRAM cdfmsk !!====================================================================== !! *** PROGRAM cdfmsk *** !!===================================================================== !! ** Purpose : Computes the number of land points from the mask !! !! History : 2.1 : 05/2005 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk ! dummy loop index INTEGER(KIND=4) :: npoint ! number of points INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain REAL(KIND=4) :: zss ! REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level CHARACTER(LEN=256) :: cf_msk ! file name !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmsk MSK-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the number of ocean points, land points and display' PRINT *,' some statistics.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' MSK-file : input mask file (which contains tmask)' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none apart the mask file passed as argument.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' Standard output' STOP ENDIF IF ( narg == 0 ) THEN PRINT *,' Usage : cdfmsk maskfile ' STOP ENDIF CALL getarg (1, cf_msk) IF ( chkfile(cf_msk) ) STOP ! missing file npiglo = getdim (cf_msk, cn_x) npjglo = getdim (cf_msk, cn_y) npk = getdim (cf_msk, cn_z) ALLOCATE (zmask(npiglo,npjglo)) npoint = 0 DO jk=1, npk zmask(:,:) = getvar(cf_msk, 'tmask', jk ,npiglo, npjglo) zss = SUM(zmask) npoint = npoint + zss END DO PRINT *, ' Number of Ocean points :', npoint ,' ',(1.*npoint )/npiglo/npjglo/npk*100,' %' PRINT *, ' Number of Land points :', npiglo*npjglo*npk - npoint ,' ',(npiglo*npjglo*npk -1.*npoint )/npiglo/npjglo/npk*100,' %' END PROGRAM cdfmsk cdftools-3.0/cdfzoom.f900000644000175000017500000002140212241227304016300 0ustar amckinstryamckinstryPROGRAM cdfzoom !!====================================================================== !! *** PROGRAM cdfzoom *** !!===================================================================== !! ** Purpose : Extract a sub area of a cdf output file and print it !! on the screen with an easy to read format. !! !! ** Method : specify the variable name and file on the command line !! !! History : --- : 1999 : A. de Miranda : Original code in bimgtools !! History : 2.1 : 11/2004 : J.M. Molines : port to CDFTOOLS !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE ! INTEGER(KIND=4) :: ji, jj, jt ! dummy loop index INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line INTEGER(KIND=4) :: ni, nj, nk, nt, ndim ! domain dimension INTEGER(KIND=4) :: niz, njz, nkz ! size of zoom INTEGER(KIND=4) :: iimin, iimax ! i-limits INTEGER(KIND=4) :: ijmin, ijmax ! j-limits INTEGER(KIND=4) :: ikmin, ikmax ! k-limits INTEGER(KIND=4) :: itmin, itmax ! t-limit INTEGER(KIND=4) :: ikext, ierr ! INTEGER(KIND=4) :: iipmin, iipmax ! INTEGER(KIND=4) :: ijpmin, ijpmax ! ! REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! data array REAL(KIND=4) :: fact ! scaling factor ! CHARACTER(LEN=256) :: cldum ! summy character variable CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cv_in='none' ! variable name !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfzoom -f file -zoom imin imax jmin jmax ...' PRINT *,' ... -var cdfvar [-lev kmin kmax ] ...' PRINT *,' ... [ -time tmin tmax ] [ -fact factor] ' PRINT *,' PURPOSE :' PRINT *,' Display the numerical values of a zoomed area. By' PRINT *,' default, all times and levels are shown. If the zoomed' PRINT *,' area is degenerated to a single line, then the vertical' PRINT *,' slab is displayed.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' -f file : name of input file' PRINT *,' -zoom imin imax jmin jmax : spatial window definition' PRINT *,' -var cdfvar : cdf variable name to work with.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-lev kmin kmax ] : vertical limits for display.' PRINT *,' [-time tmin tmax ] : time limits for display.' PRINT *,' [-fact factor ] : use a scaling factor for display.' PRINT *,' Values are DIVIDED by factor' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' display on standard output' STOP ENDIF ! ikext = 1 ; ikmin = 1 ; ikmax = 1 ; itmin = 1 ; itmax = 1 fact = 1 ijarg = 1 ! Read command line DO WHILE (ijarg <= narg) CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-f' ) CALL getarg(ijarg, cf_in) ; ijarg = ijarg + 1 CASE ( '-lev' ) CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmin CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmax CASE ( '-time' ) CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itmin CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itmax CASE ( '-fact' ) CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) fact CASE ( '-zoom' ) CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimin CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax CASE ( '-var' ) CALL getarg(ijarg,cv_in) ; ijarg = ijarg + 1 CASE DEFAULT PRINT *, TRIM(cldum),' : unknown option ' STOP END SELECT END DO IF ( chkfile (cf_in) ) STOP ! missing file ! ni=0 ; nj=0 ; nk=0 ; nt=0 niz = iimax - iimin + 1 njz = ijmax - ijmin + 1 nkz = ikmax - ikmin + 1 ikext= ikmin IF ( nkz > 1 ) THEN !working with vertical slab, either niz or njz must be 1 IF ( niz == 1 ) THEN ! y/z slab ELSE IF ( njz == 1 ) THEN ! x/z slab ELSE PRINT *, 'Either niz or njz must me one' STOP ENDIF ENDIF ni = getdim(cf_in, cn_x, cldum, ierr) IF ( ierr == 1 ) THEN ni = getdim(cf_in, 'lon', cldum, ierr) IF ( ierr == 1 ) THEN PRINT *,' No X or lon dim found ' ; STOP ENDIF ENDIF nj = getdim(cf_in, cn_y, cldum, ierr) IF ( ierr == 1 ) THEN nj = getdim(cf_in, 'lat', cldum, ierr) IF ( ierr == 1 ) THEN PRINT *,' No y or lat dim found ' ; STOP ENDIF ENDIF nk = getdim(cf_in, cn_z, cldum, ierr) IF ( ierr == 1 ) THEN nk = getdim(cf_in, 'z', cldum, ierr) IF ( ierr == 1 ) THEN nk = getdim(cf_in, 'lev', cldum, ierr) IF ( ierr == 1 ) THEN PRINT *,' No dep or z or lev dim found ' ENDIF ENDIF ENDIF nt = getdim(cf_in, cn_t, cldum, ierr) IF ( ierr == 1 ) THEN nt = getdim(cf_in, 'step', cldum, ierr) IF ( ierr == 1 ) THEN PRINT *,' No time or step dim found ' ENDIF ENDIF IF ( itmax > nt ) THEN PRINT *,' Not enough time steps in this file' STOP ENDIF IF (nk == 0 ) THEN ; nk = 1 ; ikext = 1 ; ENDIF ! assume a 2D variable IF (nt == 0 ) THEN ; nt = 1 ; ENDIF ! assume a 1 time frame file IF ( nkz == 1 ) THEN ALLOCATE ( v2d(niz,njz) ) ELSE IF ( niz == 1 ) THEN ALLOCATE( v2d(njz,nkz)) ELSE ALLOCATE( v2d(niz,nkz)) ENDIF ENDIF DO jt = itmin, itmax DO ! for exit statement ndim = getvdim(cf_in, cv_in)+1 ! getvdim gives ndim-1 ! PRINT *,TRIM(cv_in), ndim, ikext SELECT CASE (nkz) CASE (1) iipmin=iimin ; iipmax=iimax; ijpmin=ijmin; ijpmax=ijmax SELECT CASE (ndim) CASE( 2 ) ! assume x,y variable v2d(:,:) = getvar(cf_in, cv_in, 1, niz, njz, iimin, ijmin, ktime=jt) EXIT CASE( 3 ) ! assume x,y,t variable v2d(:,:) = getvar(cf_in, cv_in, 1, niz, njz, iimin, ijmin, ktime=jt) EXIT CASE( 4 ) ! assume x,y,z,t variable v2d(:,:) = getvar(cf_in, cv_in, ikext, niz, njz, iimin, ijmin, ktime=jt) EXIT CASE DEFAULT PRINT *,' Non mapable variables x-y :(' cv_in='none' END SELECT CASE DEFAULT SELECT CASE (ndim) CASE( 4 ) ! assume x,y,z,t variable IF ( njz == 1 ) THEN iipmin=iimin ; iipmax=iimax; ijpmin=ikmin; ijpmax=ikmax v2d(:,:) = getvarxz(cf_in, cv_in, ijmin, niz, nkz, iimin, ikmin, ktime=jt) ELSE iipmin=ijmin ; iipmax=ijmax; ijpmin=ikmin; ijpmax=ikmax v2d(:,:) = getvaryz(cf_in, cv_in, iimin, njz, nkz, ijmin, ikmin, ktime=jt) ENDIF EXIT CASE DEFAULT PRINT *,' Non mapable variables x-z or y-z :(' cv_in='none' END SELECT END SELECT ! nkz ENDDO PRINT *,'IMIN IMAX JMIN JMAX KMIN KMAX TIME', iimin,iimax,ijmin,ijmax,ikmin,ikmax, jt PRINT 9001,' ',(ji,ji=iipmin,iipmax) IF (nkz == 1 ) THEN DO jj=ijpmax,ijpmin,-1 PRINT 9000,jj,' ',(v2d(ji-iipmin+1,jj-ijpmin+1)/fact,ji=iipmin,iipmax) END DO ELSE DO jj=ijpmin,ijpmax PRINT 9000,jj,' ',(v2d(ji-iipmin+1,jj-ijpmin+1)/fact,ji=iipmin,iipmax) END DO ENDIF ENDDO 9000 FORMAT(i4,a,20f12.4) 9001 FORMAT(a,20i12) END PROGRAM cdfzoom cdftools-3.0/cdfvertmean.f900000644000175000017500000002475712241227304017155 0ustar amckinstryamckinstryPROGRAM cdfvertmean !!====================================================================== !! *** PROGRAM cdfvertmean *** !!===================================================================== !! ** Purpose : Compute the vertical average of a scalar quantity !! between 2 z layers. Can handle full step configuration !! using the -full option. !! !! ** Method : compute the sum ( V * e1 *e2 * e3 *mask ) !! !! History : 2.1 : 11/2008 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames USE modutils !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jvar, jt ! dummy loop index INTEGER(KIND=4) :: ik1, ik2 ! vertical limit of integration INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain, INTEGER(KIND=4) :: nvars, ivar ! variables in input INTEGER(KIND=4) :: ncout, ierr ! ncid and error status INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vars REAL(KIND=4) :: rdep_up ! upper level of integration REAL(KIND=4) :: rdep_down ! lower level of integration REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zv ! working variable REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hdep ! depth of the levels REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdep ! vertical levels REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metric full REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth output REAL(KIND=8) :: dvol ! total volume REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dvol2d ! layer volume REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dvertmean ! value of integral CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cf_out='vertmean.nc'! output file CHARACTER(LEN=256) :: cv_in ! variable name CHARACTER(LEN=256) :: cv_out='sovertmean' ! variable name CHARACTER(LEN=256) :: cv_dep ! depth name CHARACTER(LEN=256) :: cv_e3 ! vertical metric name (partial) CHARACTER(LEN=256) :: cv_e31d ! vertical metric name (full) CHARACTER(LEN=256) :: cv_msk ! mask variable name CHARACTER(LEN=256) :: ctype='T' ! position of the variable CHARACTER(LEN=256) :: cglobal ! global attribute CHARACTER(LEN=256) :: cldum ! dummy string CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! name of input variables TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvarin ! stucture for attributes (input) TYPE(variable), DIMENSION(1) :: stypvar ! stucture for attributes (output) LOGICAL :: lfull=.FALSE. ! full step flag LOGICAL :: lchk ! file existence flag (true if missing) !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfvertmean IN-file IN-var v-type dep1 dep2 [-full]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the vertical mean between dep1 and dep2 given in m,' PRINT *,' for variable IN-var in the input file.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : netcdf input file.' PRINT *,' IN-var : netcdf input variable.' PRINT *,' v-type : one of T U V W indicating position of variable on C-grid' PRINT *,' dep1 dep2 : depths limit for vertical integration (meters). ' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-full ] : for full step configurations. Default is partial step.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fzgr),' and ',TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_out),' (same units as input variable)' PRINT *,' ' STOP ENDIF ijarg = 1 ; ireq=0 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum ) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-full' ) ; lfull = .TRUE. CASE DEFAULT ireq=ireq+1 SELECT CASE ( ireq ) CASE ( 1 ) ; cf_in=cldum CASE ( 2 ) ; cv_in=cldum CASE ( 3 ) ; ctype=cldum CASE ( 4 ) ; READ(cldum,*) rdep_up CASE ( 5 ) ; READ(cldum,*) rdep_down CASE DEFAULT PRINT *,' Too many arguments ...' ; STOP END SELECT END SELECT ENDDO lchk = chkfile (cn_fzgr) lchk = chkfile (cn_fmsk) .OR. lchk lchk = chkfile (cf_in ) .OR. lchk IF ( lchk ) STOP ! missing files CALL SetGlobalAtt (cglobal) IF (rdep_down < rdep_up ) THEN PRINT *,'Give depth limits in increasing order !' STOP ENDIF npiglo = getdim (cf_in,cn_x) npjglo = getdim (cf_in,cn_y) npk = getdim (cf_in,cn_z) npt = getdim (cf_in,cn_t) nvars = getnvar(cf_in) ALLOCATE( cv_names(nvars), stypvarin(nvars) ) cv_names(:) = getvarname(cf_in, nvars, stypvarin) ivar=1 DO jvar=1,nvars IF ( TRIM(cv_names(jvar)) == TRIM(cv_in) ) THEN EXIT ENDIF ivar=ivar+1 ENDDO IF ( ivar == nvars+1 ) THEN PRINT *,' Variable ',TRIM(cv_in),' not found in ', TRIM(cf_in) STOP ENDIF rdep(1) = 0. ipk(:) = 1 stypvar(1)%cname = cv_out stypvar(1)%cunits = stypvarin(ivar)%cunits stypvar(1)%rmissing_value = stypvarin(ivar)%rmissing_value stypvar(1)%valid_min = stypvarin(ivar)%valid_min stypvar(1)%valid_max = stypvarin(ivar)%valid_max stypvar(1)%clong_name = 'vertical average of '//TRIM(stypvarin(ivar)%clong_name) stypvar(1)%cshort_name = cv_out stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! Allocate arrays ALLOCATE ( zmask(npiglo,npjglo), dvertmean(npiglo, npjglo) ) ALLOCATE ( zv(npiglo,npjglo), hdep(npiglo,npjglo) ) ALLOCATE ( e3(npiglo,npjglo), dvol2d(npiglo,npjglo) ) ALLOCATE ( gdep(npk), tim(npt) ) IF ( lfull ) ALLOCATE ( e31d(npk) ) ! Initialize output file ncout = create (cf_out, cf_in, npiglo, npjglo, 1) ierr = createvar (ncout, stypvar, 1, ipk, id_varout, cdglobal=cglobal ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, 1, pdep=rdep) tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') SELECT CASE ( ctype) CASE( 'T','U','V','t','u','v'); cv_dep=cn_gdepw ; cv_e3='e3t_ps' ; cv_e31d=cn_ve3t CASE( 'W' ,'w') ; cv_dep=cn_gdept ; cv_e3='e3w_ps' ; cv_e31d=cn_ve3w CASE DEFAULT ; PRINT *,'Point type ', TRIM(ctype),' not known! ' ; STOP END SELECT gdep(:) = getvare3(cn_fzgr, cv_dep, npk) IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cv_e31d, npk) ! set mask variable name SELECT CASE (ctype ) CASE ('T','t','W','w') ; cv_msk='tmask' CASE ('U','u') ; cv_msk='umask' CASE ('V','v') ; cv_msk='vmask' END SELECT ! Look for ik1 and ik2 as nearest level of rdep_up and rdep_down ik1 = 1; ik2 = npk DO jk=1,npk IF ( gdep(jk) <= rdep_up ) ik1 = jk IF ( gdep(jk) <= rdep_down ) ik2 = jk ENDDO PRINT '(a,2f8.3)', 'depth limit of integration : ', rdep_up, rdep_down PRINT '(a,2i8 )', 'nearest level found : ', ik1, ik2 PRINT '(a,2f8.3)', 'corresponding depth : ', gdep(ik1), gdep(ik2+1) DO jt=1,npt dvol = 0.d0 dvol2d(:,:) = 0.d0 dvertmean(:,:) = 0.d0 DO jk = ik1, ik2 ! Get values at jk zv( :,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt) zmask(:,:) = getvar(cn_fmsk, cv_msk, jk, npiglo, npjglo ) ! get e3 at level jk ( ps...) IF ( lfull ) THEN ; e3(:,:) = e31d(jk) ELSE ; e3(:,:) = getvar(cn_fzgr, cv_e3, jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF IF ( jk == ik1 ) THEN hdep(:,:) = gdep(jk) + e3(:,:) e3( :,:) = MIN(e3, hdep -rdep_up ) ENDIF IF ( jk == ik2 ) THEN e3( :,:) = MIN(e3, (rdep_down) - gdep(jk) ) ENDIF dvol = SUM( DBLE(e3 * zmask) ) dvol2d = e3 * zmask * 1.d0 + dvol2d dvertmean = zv * e3 * zmask * 1.d0 + dvertmean IF (dvol == 0 )THEN ! no more layer below ! EXIT ! get out of the jk loop ENDIF END DO ! Output to netcdf file WHERE ( dvol2d /= 0 ) dvertmean = dvertmean/dvol2d ierr = putvar(ncout, id_varout(1), REAL(dvertmean), 1, npiglo, npjglo, ktime=jt) END DO ! loop on time ierr = closeout(ncout) END PROGRAM cdfvertmean cdftools-3.0/cdfchgrid.f900000644000175000017500000002163612241227304016565 0ustar amckinstryamckinstryPROGRAM cdfchgrid !!====================================================================== !! *** PROGRAM cdfchgrid *** !!====================================================================== !! ** Purpose : Transform an 1442x1021 ORCA025 grid variable into an !! 4322x3059 ORCA12 grid variable. !! No interpolation, only copying one grid cell into 9 grid cells. !! !! ** Method : Store the result on a 'cdfchgrid.nc' file similar to the input file !! (except x and y dimension) !! !! ** Restriction : Caution for mask coherence ! !! This tool is only adapted for drowned field !! !! History : 3.0 ! 08/2012 A. Lecointre : Original code with Full Doctor form + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! chgrid : Convert 1442x1021 ORCA025 2D var into 4322x3059 ORCA12 var !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id: cdfchgrid.f90 XXX YYYY-MM-DD MM:MM:SSZ molines $ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: jvar,jjvar ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! argument on line INTEGER(KIND=4) :: npiglo, npjglo ! size of the input domain INTEGER(KIND=4), PARAMETER :: npigloout=4322, npjgloout=3059 ! size of the output domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! number of variables in the input file INTEGER(KIND=4) :: ncout ! ncid of output ncdf file INTEGER(KIND=4), DIMENSION(1) :: ipk ! output variable : number of levels INTEGER(KIND=4), DIMENSION(1) :: id_varout ! ncdf varid's REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! array to read a layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: u2d ! array onto ORCA12-grid REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter of the file REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: dep ! depth of the file CHARACTER(LEN=256) :: cf_out='cdfchgrid.nc' ! output file name CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cv_in ! variable name CHARACTER(LEN=256) :: cldum ! working string CHARACTER(LEN=256) :: cv_dep ! true name of dep dimension CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for variable attribute !!-------------------------------------------------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfchgrid -f IN-file -var IN-var' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Convert ORCA025-grid variable into ORCA12-grid variable' PRINT *,' No interpolation, only copying one grid cell into nine grid cells' PRINT *,' ' PRINT *,' RESTRICTION :' PRINT *,' Caution for mask coherence !' PRINT *,' This tool is only adapted for drowned field' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' -f IN-var : input ORCA025-grid file' PRINT *,' -var IN-var : input ORCA025-grid variable to be converted' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none ' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variable : same name as in input file' STOP ENDIF !! ijarg = 1 ! Read command line DO WHILE (ijarg <= narg) CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-f' ) CALL getarg(ijarg, cf_in) ; ijarg = ijarg + 1 CASE ( '-var' ) CALL getarg(ijarg,cv_in) ; ijarg = ijarg + 1 CASE DEFAULT PRINT *, TRIM(cldum),' : unknown option ' STOP END SELECT END DO IF ( chkfile(cf_in) ) STOP ! missing files ! get domain dimension from input file npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr) ! defautl cn_z is depth npt = getdim (cf_in, cn_t) IF ( npk == 0 ) npk = 1 ! assume a 2D variable IF ( npt == 0 ) npt = 1 ! assume a 1 time frame file PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE ( v2d(npiglo,npjglo) ) ALLOCATE ( u2d(npigloout,npjgloout) ) ALLOCATE ( tim(npt) ) ALLOCATE ( dep(npk) ) ! look for the number of variables in the input file nvars = getnvar(cf_in) ALLOCATE (cv_names(nvars) ,stypvar(nvars)) cv_names(:)=getvarname(cf_in,nvars,stypvar) ! find the number of variable we are interested in jvar=0 DO WHILE (jvar <= nvars) jvar=jvar+1 IF ( cv_names(jvar) == cv_in ) jjvar=jvar END DO ipk(1)=npk ncout = create (cf_out, cf_in , npigloout, npjgloout, npk ) ierr = createvar (ncout , stypvar(jjvar), 1 , ipk , id_varout ) ! get time and write time and get deptht and write deptht tim=getvar1d(cf_in,cn_t,npt) ; ierr=putvar1d(ncout,tim,npt,'T') dep=getvar1d(cf_in,cv_dep,npk) ; ierr=putvar1d(ncout,dep,npk,'D') PRINT *,' Working with ', TRIM(cv_in), npk DO jt = 1, npt DO jk = 1, npk v2d(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt) PRINT *,'level ',jk, 'time ',jt CALL chgrid(v2d,u2d,'025to12') ierr = putvar ( ncout , id_varout(1), REAL(u2d), jk, npigloout, npjgloout, ktime=jt) ENDDO ENDDO ierr = closeout(ncout) CONTAINS SUBROUTINE chgrid (invar,outvar,cc) REAL(KIND=4), DIMENSION(npiglo,npjglo), INTENT(in) :: invar REAL(KIND=4), DIMENSION(npigloout,npjgloout), INTENT(out) :: outvar CHARACTER(LEN=*), INTENT(in) :: cc INTEGER(KIND=4) :: iin,jin,iout,jout ! dummy loop index SELECT CASE (cc) CASE ('025to12') DO iin = 2, 1441 iout=3*iin-4 jin=1 ! Fill only NORTH and EAST and WEST jout=3*jin-2 outvar(iout ,jout ) = invar(iin,jin) outvar(iout ,jout+1) = invar(iin,jin) outvar(iout-1,jout ) = invar(iin,jin) outvar(iout+1,jout ) = invar(iin,jin) outvar(iout+1,jout+1) = invar(iin,jin) outvar(iout-1,jout+1) = invar(iin,jin) DO jin = 2, 1020 ! Fill all: NORTH and SOUTH and EAST and WEST jout=3*jin-2 outvar(iout ,jout ) = invar(iin,jin) outvar(iout+1,jout ) = invar(iin,jin) outvar(iout-1,jout ) = invar(iin,jin) outvar(iout ,jout-1) = invar(iin,jin) outvar(iout ,jout+1) = invar(iin,jin) outvar(iout+1,jout+1) = invar(iin,jin) outvar(iout+1,jout-1) = invar(iin,jin) outvar(iout-1,jout+1) = invar(iin,jin) outvar(iout-1,jout-1) = invar(iin,jin) ENDDO ENDDO iin=1442 iout=3*iin-4 jin=1 ! Fill only NORTH and WEST jout=3*jin-2 outvar(iout ,jout ) = invar(iin,jin) outvar(iout ,jout+1) = invar(iin,jin) outvar(iout-1,jout ) = invar(iin,jin) outvar(iout-1,jout+1) = invar(iin,jin) DO jin = 2, 1020 ! Fill only NORTH and SOUTH and WEST jout=3*jin-2 outvar(iout ,jout ) = invar(iin,jin) outvar(iout ,jout-1) = invar(iin,jin) outvar(iout ,jout+1) = invar(iin,jin) outvar(iout-1,jout ) = invar(iin,jin) outvar(iout-1,jout-1) = invar(iin,jin) outvar(iout-1,jout+1) = invar(iin,jin) ENDDO CASE ('05to025') ! to do ... CASE ('05to12') ! to do ... CASE DEFAULT PRINT *, TRIM(cc),' is not recognized !' PRINT *, 'No conversion will be performed' END SELECT END SUBROUTINE chgrid END PROGRAM cdfchgrid cdftools-3.0/cdfwhereij.f900000644000175000017500000001134712241227304016760 0ustar amckinstryamckinstryPROGRAM cdfwhereij !!====================================================================== !! *** PROGRAM cdfwhereij *** !!===================================================================== !! ** Purpose : Give the values of longitude latitude for a given i, j !! !! ** Method : Read the coordinate/mesh_hgr file and look for the glam, !! gphi variables. The point type ( T U V F ) is specified !! on the command line. !! !! History : 2.1 : 05/2005 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: ijarg, ireq ! browse line INTEGER(KIND=4) :: iimin, iimax ! i-zoom limit INTEGER(KIND=4) :: ijmin, ijmax ! j-zoom limit INTEGER(KIND=4) :: npiglo, npjglo ! global size REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glam, gphi ! longitude, latitude CHARACTER(LEN=256) :: cv_lam ! longitude name CHARACTER(LEN=256) :: cv_phi ! latitude name CHARACTER(LEN=256) :: ctype='T' ! type of point on C-grid CHARACTER(LEN=256) :: cldum ! dummmy string CHARACTER(LEN=256) :: clcoo ! dummy character variable !!---------------------------------------------------------------------- CALL ReadCdfNames() clcoo = cn_fcoo narg= iargc() IF ( narg < 4 ) THEN PRINT *,' usage : cdfwhereij imin imax jmin jmax [-c COOR-file ] [ -p point_type]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Return the geographical coordinates of a model sub-area specified' PRINT *,' in i,j space on the command line.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' imin imax jmin jmax : (i,j) space window coordinates' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-c COOR_file ] : specify a coordinates file.' PRINT *,' default is ', TRIM(cn_fcoo) PRINT *,' [-p point type ] : specify a point type on the C-grid (T U V F) ' PRINT *,' default is ', TRIM(ctype) PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fcoo),' or COOR-file given in the -c option' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' Standard output' STOP ENDIF ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg) CALL getarg( ijarg, cldum ) ; ijarg= ijarg+1 SELECT CASE ( cldum ) CASE ( '-c' ) ; CALL getarg(ijarg, clcoo ) ; ijarg=ijarg+1 CASE ( '-p' ) ; CALL getarg(ijarg, ctype ) ; ijarg=ijarg+1 CASE DEFAULT ireq=ireq+1 SELECT CASE (ireq) CASE ( 1 ) ; READ(cldum,*) iimin CASE ( 2 ) ; READ(cldum,*) iimax CASE ( 3 ) ; READ(cldum,*) ijmin CASE ( 4 ) ; READ(cldum,*) ijmax CASE DEFAULT PRINT *,' Too many arguments !' ; STOP END SELECT END SELECT END DO IF ( chkfile(clcoo) ) STOP ! missing file npiglo = getdim (clcoo, cn_x) npjglo = getdim (clcoo, cn_y) IF ( iimax > npiglo ) THEN PRINT *,' ERROR : imax is greater than the maximum size ', iimax, npiglo STOP ENDIF IF ( ijmax > npjglo ) THEN PRINT *,' ERROR : jmax is greater than the maximum size ', ijmax, npjglo STOP END IF ALLOCATE (glam(npiglo,npjglo), gphi(npiglo,npjglo) ) SELECT CASE ( ctype ) CASE ('T' , 't' ) ; cv_lam = cn_glamt ; cv_phi = cn_gphit CASE ('U' , 'u' ) ; cv_lam = cn_glamu ; cv_phi = cn_gphiu CASE ('V' , 'v' ) ; cv_lam = cn_glamv ; cv_phi = cn_gphiv CASE ('F' , 'f' ) ; cv_lam = cn_glamf ; cv_phi = cn_gphif CASE DEFAULT PRINT *,' ERROR : type of point not known: ', TRIM(ctype) END SELECT glam(:,:) = getvar(clcoo, cv_lam, 1, npiglo, npjglo) gphi(:,:) = getvar(clcoo, cv_phi, 1, npiglo, npjglo) PRINT '(2a)' ,' Type of point : ', TRIM(ctype) PRINT '(a,4i6)' ,' I J zoom : ', iimin, iimax, ijmin, ijmax PRINT '(a,4f9.3)',' LON LAT zoom : ', glam(iimin,ijmin), glam(iimax,ijmax), gphi(iimin,ijmin), gphi(iimax,ijmax) END PROGRAM cdfwhereij cdftools-3.0/cdfovide.f900000644000175000017500000007621012241227304016431 0ustar amckinstryamckinstryPROGRAM cdfovide !!====================================================================== !! *** PROGRAM cdfovide *** !!===================================================================== !! ** Purpose : Easy tool to perform Temperature, Salinity and velocity !! plots along OVIDE section !! PARTIAL STEPS version !! !! ** Method : Works as a standalone file once compiled !! Inspired by cdffindij, cdftransportiz !! !! History : 2.1 : 12/2009 : R. Dussin : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain INTEGER(KIND=4) :: niter INTEGER(KIND=4) :: imin, imax, jmin, jmax, k, ik, jk, jclass INTEGER(KIND=4) :: iloc, jloc INTEGER(KIND=4) :: iloop, jloop INTEGER(KIND=4) :: nsec=0 ! nb total de points le long de la section INTEGER(KIND=4), DIMENSION (:), ALLOCATABLE :: isec, jsec ! indices des points a recuperer INTEGER(KIND=4), PARAMETER :: nsta=4 INTEGER(KIND=4), DIMENSION(nsta) :: ista, jsta INTEGER(KIND=4), DIMENSION(nsta-1) :: ikeepn ! broken line stuff INTEGER(KIND=4), PARAMETER :: jpseg=10000 INTEGER(KIND=4) :: i0,j0,i1,j1, i, j INTEGER(KIND=4) :: n,nn, jseg, kk INTEGER(KIND=4) :: norm_u, norm_v, ist, jst INTEGER(KIND=4) :: nxtarg INTEGER(KIND=4), DIMENSION(nsta-1,jpseg) :: legs1=0, legs2=0 REAL(KIND=8), DIMENSION(nsta) :: rlonsta, rlatsta REAL(KIND=8) :: xmin, xmax, ymin, ymax, rdis REAL(KIND=4) :: glamfound, glamin, glamax REAL(KIND=8) :: glam0, emax REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: glam, gphi, e1, e2 REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t, e1u, e2v, e3t REAL(KIND=4) :: rxi0, ryj0, rxi1, ryj1 REAL(KIND=4) :: ai, bi, aj,bj,d REAL(KIND=4) :: rxx(jpseg), ryy(jpseg) REAL(KIND=4), DIMENSION(jpseg) :: gla !, gphi REAL(KIND=8), DIMENSION(jpseg) :: voltrp, heatrp, saltrp REAL(KIND=8) :: voltrpsum, heatrpsum, saltrpsum COMPLEX yypt(jpseg), yypti REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e3v ,gphiv, zv, zvt, zvs !: mask, metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2u, e3u ,gphiu, zu, zut, zus !: mask, metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temper, saline, zonalu, meridv, navlon, navlat REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ovidetemper, ovidesaline, ovidezonalu, ovidemeridv REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: lonsec, latsec, dumisec, dumjsec REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1tsec, e1usec, e1vsec, e2tsec, e2usec, e2vsec REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3tsec, e3usec, e3vsec REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamu, glamv REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! constants REAL(KIND=4) :: rau0=1000., rcp=4000. CHARACTER(LEN=80) :: ctype='F' CHARACTER(LEN=80) :: cfilet , cfileu, cfilev, csection LOGICAL :: lagain, lbord LOGICAL :: ltest=.FALSE. LOGICAL :: lchk ! cdf output stuff CHARACTER(LEN=80) :: cfileoutnc='ovide.nc' TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar INTEGER(KIND=4) :: ierr, ncout REAL(KIND=4), DIMENSION(1) :: tim INTEGER(KIND=4) :: nfield=10 INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg < 3 ) THEN PRINT *,'usage : cdfovide gridTfile gridUfile gridVfile ' PRINT *,' Files ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr),' must be in te current directory ' PRINT *,' Output on netcdf file ',TRIM(cfileoutnc) STOP ENDIF CALL getarg (1, cfilet) CALL getarg (2, cfileu) CALL getarg (3, cfilev) lchk = chkfile(cn_fhgr) lchk = chkfile(cn_fzgr) .OR. lchk lchk = chkfile(cfilet ) .OR. lchk lchk = chkfile(cfileu ) .OR. lchk lchk = chkfile(cfilev ) .OR. lchk IF ( lchk ) STOP ! missing files ! Location of leg points that define the 3 legs of OVIDE section rlonsta(1) = -43.00 ; rlatsta(1) = 60.60 ! Greenland rlonsta(2) = -31.30 ; rlatsta(2) = 58.90 ! Reykjanes Ridge rlonsta(3) = -12.65 ; rlatsta(3) = 40.33 ! Off Portugal rlonsta(4) = -8.70 ; rlatsta(4) = 40.33 ! Lisboa PRINT *, '###########################################################' PRINT *, '# ' PRINT *, '# CDF ovide ' PRINT *, '# ' PRINT *, '# \___________________' PRINT *, '# \ ' PRINT *, '# \ ' PRINT *, '# \________________' PRINT *, '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' !!--------------------------------------------------------------------- !! Find the indexes of the 3 legs (from cdffindij) !!--------------------------------------------------------------------- npiglo = getdim (cn_fhgr,cn_x) npjglo = getdim (cn_fhgr,cn_y) ALLOCATE (glam(npiglo,npjglo), gphi(npiglo,npjglo) ) ALLOCATE (e1(npiglo,npjglo), e2(npiglo,npjglo) ) SELECT CASE ( ctype ) CASE ('T' , 't' ) glam(:,:) = getvar(cn_fhgr, 'glamt',1,npiglo,npjglo) gphi(:,:) = getvar(cn_fhgr, 'gphit',1,npiglo,npjglo) e1 (:,:) = getvar(cn_fhgr, 'e1t' ,1,npiglo,npjglo) e2 (:,:) = getvar(cn_fhgr, 'e2t' ,1,npiglo,npjglo) CASE ('U','u' ) glam(:,:) = getvar(cn_fhgr, 'glamu',1,npiglo,npjglo) gphi(:,:) = getvar(cn_fhgr, 'gphiu',1,npiglo,npjglo) e1 (:,:) = getvar(cn_fhgr, 'e1u' ,1,npiglo,npjglo) e2 (:,:) = getvar(cn_fhgr, 'e2u' ,1,npiglo,npjglo) CASE ('V','v' ) glam(:,:) = getvar(cn_fhgr, 'glamv',1,npiglo,npjglo) gphi(:,:) = getvar(cn_fhgr, 'gphiv',1,npiglo,npjglo) e1 (:,:) = getvar(cn_fhgr, 'e1v' ,1,npiglo,npjglo) e2 (:,:) = getvar(cn_fhgr, 'e2v' ,1,npiglo,npjglo) CASE ('F','f' ) glam(:,:) = getvar(cn_fhgr, 'glamf',1,npiglo,npjglo) gphi(:,:) = getvar(cn_fhgr, 'gphif',1,npiglo,npjglo) e1 (:,:) = getvar(cn_fhgr, 'e1f' ,1,npiglo,npjglo) e2 (:,:) = getvar(cn_fhgr, 'e2f' ,1,npiglo,npjglo) CASE DEFAULT PRINT *,' ERROR : type of point not known: ', TRIM(ctype) END SELECT ! work with longitude between 0 and 360 to avoid the date line. WHERE( glam < 0 ) glam=glam+360. ! For Orca grid, the longitude of ji=1 is about 70 E glam0=glam(1, npjglo/2) WHERE( glam < glam0 ) glam=glam+360. !! loop on the 3 legs DO k = 1,nsta-1 xmin=rlonsta(k) ymin=rlatsta(k) xmax=rlonsta(k+1) ymax=rlatsta(k+1) IF (xmin < 0.) xmin = xmin +360. IF (xmax < 0.) xmax = xmax +360. IF (xmin < glam0) xmin = xmin +360. IF (xmax < glam0) xmax = xmax +360. lagain = .TRUE. niter = 0 !! --- while loop ----------------------------------------------------------- DO WHILE (lagain) CALL Nearestpoint(xmin,ymin,npiglo,npjglo,glam,gphi,iloc,jloc,lbord) ! distance between the target point and the nearest point rdis=dist(xmin,glam(iloc,jloc),ymin,gphi(iloc,jloc) ) ! in km ! typical grid size (diagonal) in the vicinity of nearest point emax= MAX(e1(iloc,jloc),e2(iloc,jloc))/1000.*SQRT(2.) ! in km !! rdis = (xmin - glam(iloc,jloc))**2 + (ymin - gphi(iloc,jloc))**2 !! rdis = SQRT(rdis) IF (rdis > emax ) THEN glamfound=glam(iloc,jloc) ; IF (glamfound > 180.) glamfound=glamfound -360. PRINT 9000, 'Long= ',glamfound,' Lat = ',gphi(iloc,jloc)& & , iloc, jloc PRINT *,' Algorithme ne converge pas ', rdis IF ( niter >= 1 ) STOP ' pas de convergence apres iteration' lagain = .TRUE. jloc = npjglo niter = niter +1 ELSE !PRINT '("# rdis= ",f8.3," km")', rdis lagain = .FALSE. END IF END DO !!-------------------------------------------------------------------------- IF (lbord) THEN WRITE (*,*)'Point Out of domain or on boundary' ELSE imin=iloc jmin=jloc ! PRINT 9000, 'Long= ',glam(iloc,jloc),' lat = ',gphi(iloc,jloc), iloc, jloc ENDIF lagain = .TRUE. niter = 0 !! --- while loop ---------------------------------------------------------------- DO WHILE (lagain) CALL Nearestpoint(xmax,ymax,npiglo,npjglo,glam,gphi,iloc,jloc,lbord) ! distance between the target point and the nearest point rdis=dist(xmax,glam(iloc,jloc),ymax,gphi(iloc,jloc) ) ! in km ! typical grid size (diagonal) in the vicinity of nearest point emax= MAX(e1(iloc,jloc),e2(iloc,jloc))/1000.*SQRT(2.) ! in km !! rdis = (xmax - glam(iloc,jloc))**2 + (ymax - gphi(iloc,jloc))**2 !! rdis = SQRT(rdis) IF (rdis > emax ) THEN glamfound=glam(iloc,jloc) ; IF (glamfound > 180.) glamfound=glamfound -360. PRINT 9000, 'Long= ',glamfound,' Lat = ',gphi(iloc,jloc) & & , iloc, jloc PRINT *,' Algorithme ne converge pas ', rdis IF ( niter >= 1 ) STOP ' pas de convergence avres iteration' lagain = .TRUE. jloc = npjglo niter = niter +1 ELSE !PRINT '("# rdis= ",f8.3," km")', rdis lagain = .FALSE. END IF END DO !! --------------------------------------------------------------------- IF (lbord) THEN WRITE (*,*) 'Point Out of domain or on boundary' ELSE imax=iloc jmax=jloc ! PRINT 9000, 'Long= ',glam(iloc,jloc),' lat = ',gphi(iloc,jloc), iloc, jloc ENDIF ista(k)=imin jsta(k)=jmin ista(k+1)=imax jsta(k+1)=jmax ! PRINT 9001, imin,imax, jmin, jmax ! glamin=glam(imin,jmin) ;glamax=glam(imax,jmax) ! IF ( glamin > 180 ) glamin=glamin-360. ! IF ( glamax > 180 ) glamax=glamax-360. ! PRINT 9002, glamin, glamax, gphi(imin,jmin),gphi(imax,jmax) 9000 FORMAT(a,f8.2,a,f8.2,2i5) 9001 FORMAT(4i10) 9002 FORMAT(4f10.4) !! Find the broken line between P1 (imin,jmin) and P2 (imax, jmax) !! --------------------------------------------------------------- ! ... Initialization i0=imin; j0=jmin; i1=imax; j1=jmax rxi1=i1; ryj1=j1; rxi0=i0; ryj0=j0 ! .. Compute equation: ryj = aj rxi + bj IF ( (rxi1 -rxi0) /= 0 ) THEN aj = (ryj1 - ryj0 ) / (rxi1 -rxi0) bj = ryj0 - aj * rxi0 ELSE aj=10000. bj=0. END IF ! .. Compute equation: rxi = ai ryj + bi IF ( (ryj1 -ryj0) /= 0 ) THEN ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 ) bi = rxi0 - ai * ryj0 ELSE ai=10000. bi=0. END IF ! .. Compute the integer pathway: n=0 ! .. Chose the strait line with the smallest slope IF (ABS(aj) <= 1 ) THEN ! ... Here, the best line is y(x) ! ... If i1 < i0 swap points and remember it has been swapped IF (i1 < i0 ) THEN i = i0 ; j = j0 i0 = i1 ; j0 = j1 i1 = i ; j1 = j END IF IF ( j1 >= j0 ) THEN ist = 1 ; jst = 1 norm_u = 1 ; norm_v = -1 ELSE ist = 1 ; jst = 0 norm_u = -1 ; norm_v = -1 END IF ! ... compute the nearest j point on the line crossing at i DO i=i0,i1 n=n+1 IF (n > jpseg) STOP 'n > jpseg !' j=NINT(aj*i + bj ) yypt(n) = CMPLX(i,j) END DO ELSE ! ... Here, the best line is x(y) ! ... If j1 < j0 swap points and remember it has been swapped IF (j1 < j0 ) THEN i = i0 ; j = j0 i0 = i1 ; j0 = j1 i1 = i ; j1 = j END IF IF ( i1 >= i0 ) THEN ist = 1 ; jst = 1 norm_u = 1 ; norm_v = -1 ELSE ist = 0 jst = 1 norm_u = 1 norm_v = 1 END IF ! ... compute the nearest i point on the line crossing at j DO j=j0,j1 n=n+1 IF (n > jpseg) STOP 'n>jpseg !' i=NINT(ai*j + bi) yypt(n) = CMPLX(i,j) END DO END IF !! !! Look for intermediate points to be added. ! .. The final positions are saved in rxx,ryy rxx(1)=REAL(yypt(1)) ryy(1)=IMAG(yypt(1)) nn=1 DO kk=2,n ! .. distance between 2 neighbour points d=ABS(yypt(kk)-yypt(kk-1)) ! .. intermediate points required if d > 1 IF ( d > 1 ) THEN CALL interm_pt(yypt,kk,ai,bi,aj,bj,yypti) nn=nn+1 IF (nn > jpseg) STOP 'nn>jpseg !' rxx(nn)=REAL(yypti) ryy(nn)=IMAG(yypti) END IF nn=nn+1 IF (nn > jpseg) STOP 'nn>jpseg !' rxx(nn)=REAL(yypt(kk)) ryy(nn)=IMAG(yypt(kk)) END DO IF (rxx(1) < rxx(nn) ) THEN ; legs1(k,:)=rxx legs2(k,:)=ryy ELSE DO iloop=1,nn legs1(k,iloop)=rxx(nn-iloop+1) legs2(k,iloop)=ryy(nn-iloop+1) END DO END IF ! compute the number of total points ikeepn(k)=nn nsec = nsec + nn END DO !! loop on the 3 legs ! fancy control print WRITE(*,*) '------------------------------------------------------------' WRITE(*,9100) 'leg 1 start at ', rlonsta(1) ,'°N ', rlatsta(1), '°W and ends at ', rlonsta(2) ,'°N ', rlatsta(2), '°W' WRITE(*,9101) 'corresponding to F-gridpoints(', ista(1),',',jsta(1),') and (', ista(2),',',jsta(2),')' WRITE(*,*) '------------------------------------------------------------' WRITE(*,*) '------------------------------------------------------------' WRITE(*,9100) 'leg 2 start at ', rlonsta(2) ,'°N ', rlatsta(2), '°W and ends at ', rlonsta(3) ,'°N ', rlatsta(3), '°W' WRITE(*,9101) 'corresponding to F-gridpoints(', ista(2),',',jsta(2),') and (', ista(3),',',jsta(3),')' WRITE(*,*) '------------------------------------------------------------' WRITE(*,*) '------------------------------------------------------------' WRITE(*,9100) 'leg 3 start at ', rlonsta(3) ,'°N ', rlatsta(3), '°W and ends at ', rlonsta(4) ,'°N ', rlatsta(4), '°W' WRITE(*,9101) 'corresponding to F-gridpoints(', ista(3),',',jsta(3),') and (', ista(4),',',jsta(4),')' WRITE(*,*) '------------------------------------------------------------' 9100 FORMAT(a,f6.2,a,f6.2,a,f6.2,a,f6.2,a) 9101 FORMAT(a,i4,a,i4,a,i4,a,i4,a) ALLOCATE (isec(nsec), jsec(nsec)) DO k=1, nsta-1 DO iloop=1, ikeepn(k) jloop=iloop + SUM(ikeepn(1:k)) -ikeepn(k) isec(jloop)=legs1(k,iloop) jsec(jloop)=legs2(k,iloop) END DO END DO npk = getdim (cfilet,'deptht') ! input fields ALLOCATE(navlon(npiglo,npjglo), navlat(npiglo,npjglo)) ALLOCATE(temper(npiglo,npjglo), saline(npiglo,npjglo)) ALLOCATE(zonalu(npiglo,npjglo), meridv(npiglo,npjglo)) ALLOCATE(e1v(npiglo,npjglo)) ALLOCATE(e2u(npiglo,npjglo)) ALLOCATE(e3u(npiglo,npjglo), e3v(npiglo,npjglo)) ! output fields ALLOCATE(lonsec(1,nsec), latsec(1,nsec) ) ALLOCATE(dumisec(1,nsec), dumjsec(1,nsec) ) ALLOCATE(e2usec(1,nsec-1), e3usec(nsec-1,npk) ) ALLOCATE(e1vsec(1,nsec-1), e3vsec(nsec-1,npk) ) ALLOCATE(ovidetemper(nsec-1,npk), ovidesaline(nsec-1,npk) ) ALLOCATE(ovidezonalu(nsec-1,npk), ovidemeridv(nsec-1,npk) ) dumisec(:,:)=0 dumjsec(:,:)=0 navlon(:,:) = getvar(cfilet, 'nav_lon' ,1,npiglo,npjglo) navlat(:,:) = getvar(cfilet, 'nav_lat' ,1,npiglo,npjglo) e1v(:,:) = getvar(cn_fhgr, 'e1v',1,npiglo,npjglo) e2u(:,:) = getvar(cn_fhgr, 'e2u',1,npiglo,npjglo) ! il faut faire un test sur la continuité des segements ! on va prendre T et S comme etant la moyenne du point ! en dessous et au-dessus du segment pour pouvoir calculer ! les fluxs de maniere optimales... ! loop on 2d arrays DO iloop=1,nsec lonsec(1,iloop) = navlon(isec(iloop),jsec(iloop)) latsec(1,iloop) = navlat(isec(iloop),jsec(iloop)) dumisec(1,iloop)= isec(iloop) dumjsec(1,iloop)= jsec(iloop) END DO DO iloop=1,nsec-1 IF ( jsec(iloop+1) == jsec(iloop) ) THEN ! horizontal segment IF ( isec(iloop+1) > isec(iloop) ) THEN ! eastward e2usec(iloop,jk) = 0. e1vsec(iloop,jk) = e1v(isec(iloop)+1,jsec(iloop)) ELSE e2usec(iloop,jk) = 0. e1vsec(iloop,jk) = e1v(isec(iloop),jsec(iloop)) ENDIF ELSEIF ( isec(iloop+1) == isec(iloop) ) THEN ! vertical segment IF ( jsec(iloop+1) < jsec(iloop) ) THEN ! southward e2usec(iloop,jk) = e2u(isec(iloop),jsec(iloop)) e1vsec(iloop,jk) = 0. ELSE e2usec(iloop,jk) = e2u(isec(iloop),jsec(iloop)+1) e1vsec(iloop,jk) = 0. ENDIF ELSE PRINT *, 'problem' exit ENDIF END DO ! loop on 3d arrays DO jk=1,npk temper(:,:) = getvar(cfilet, 'votemper',jk,npiglo,npjglo) saline(:,:) = getvar(cfilet, 'vosaline',jk,npiglo,npjglo) zonalu(:,:) = getvar(cfileu, 'vozocrtx',jk,npiglo,npjglo) meridv(:,:) = getvar(cfilev, 'vomecrty',jk,npiglo,npjglo) e3u(:,:) = getvar(cn_fzgr, 'e3u_ps',jk,npiglo,npjglo, ldiom=.true.) e3v(:,:) = getvar(cn_fzgr, 'e3v_ps',jk,npiglo,npjglo, ldiom=.true.) DO iloop=1,nsec-1 IF ( jsec(iloop+1) == jsec(iloop) ) THEN ! horizontal segment IF ( isec(iloop+1) > isec(iloop) ) THEN ! eastward IF ( min( temper(isec(iloop)+1,jsec(iloop)) , temper(isec(iloop)+1,jsec(iloop)+1) ) == 0. ) THEN ovidetemper(iloop,jk) = 0. ; ovidesaline(iloop,jk) = 0. ELSE ovidetemper(iloop,jk) = 0.5 * ( temper(isec(iloop)+1,jsec(iloop)) + temper(isec(iloop)+1,jsec(iloop)+1) ) ovidesaline(iloop,jk) = 0.5 * ( saline(isec(iloop)+1,jsec(iloop)) + saline(isec(iloop)+1,jsec(iloop)+1) ) ENDIF ovidezonalu(iloop,jk) = 0. ovidemeridv(iloop,jk) = meridv(isec(iloop)+1,jsec(iloop)) e3usec(iloop,jk) = 0. e3vsec(iloop,jk) = e3v(isec(iloop)+1,jsec(iloop)) ELSE ! westward IF ( min( temper(isec(iloop),jsec(iloop)) , temper(isec(iloop),jsec(iloop)+1) ) == 0. ) THEN ovidetemper(iloop,jk) = 0. ; ovidesaline(iloop,jk) = 0. ELSE ovidetemper(iloop,jk) = 0.5 * ( temper(isec(iloop),jsec(iloop)) + temper(isec(iloop),jsec(iloop)+1) ) ovidesaline(iloop,jk) = 0.5 * ( saline(isec(iloop),jsec(iloop)) + saline(isec(iloop),jsec(iloop)+1) ) ENDIF ovidezonalu(iloop,jk) = 0. ovidemeridv(iloop,jk) = meridv(isec(iloop),jsec(iloop)) e3usec(iloop,jk) = 0. e3vsec(iloop,jk) = e3v(isec(iloop),jsec(iloop)) ENDIF ELSEIF ( isec(iloop+1) == isec(iloop) ) THEN ! vertical segment IF ( jsec(iloop+1) < jsec(iloop) ) THEN ! southward IF ( min( temper(isec(iloop),jsec(iloop)) , temper(isec(iloop)+1,jsec(iloop)) ) == 0. ) THEN ovidetemper(iloop,jk) = 0. ; ovidesaline(iloop,jk) = 0. ELSE ovidetemper(iloop,jk) = 0.5 * ( temper(isec(iloop),jsec(iloop)) + temper(isec(iloop)+1,jsec(iloop)) ) ovidesaline(iloop,jk) = 0.5 * ( saline(isec(iloop),jsec(iloop)) + saline(isec(iloop)+1,jsec(iloop)) ) ENDIF ovidezonalu(iloop,jk) = zonalu(isec(iloop),jsec(iloop)) ovidemeridv(iloop,jk) = 0. e3usec(iloop,jk) = e3u(isec(iloop),jsec(iloop)) e3vsec(iloop,jk) = 0. ELSE ! northward IF ( min( temper(isec(iloop),jsec(iloop)+1) , temper(isec(iloop)+1,jsec(iloop)+1) ) == 0. ) THEN ovidetemper(iloop,jk) = 0. ; ovidesaline(iloop,jk) = 0. ELSE ovidetemper(iloop,jk) = 0.5 * ( temper(isec(iloop),jsec(iloop)+1) + temper(isec(iloop)+1,jsec(iloop)+1) ) ovidesaline(iloop,jk) = 0.5 * ( saline(isec(iloop),jsec(iloop)+1) + saline(isec(iloop)+1,jsec(iloop)+1) ) ENDIF ovidezonalu(iloop,jk) = zonalu(isec(iloop),jsec(iloop)+1) ovidemeridv(iloop,jk) = 0. e3usec(iloop,jk) = e3u(isec(iloop),jsec(iloop)+1) e3vsec(iloop,jk) = 0. ENDIF ELSE PRINT *, 'problem' exit ENDIF END DO END DO ALLOCATE ( stypvar(nfield), ipk(nfield), id_varout(nfield) ) DO iloop=1,nfield ipk(iloop) = npk END DO ! define new variables for output stypvar(1)%cname= 'votemper' stypvar(1)%cunits='deg C' stypvar%rmissing_value=0. stypvar(1)%valid_min= -2. stypvar(1)%valid_max= 40. stypvar%scale_factor= 1. stypvar%add_offset= 0. stypvar%savelog10= 0. stypvar(1)%clong_name='Temperature along OVIDE section' stypvar(1)%cshort_name='votemper' stypvar%conline_operation='N/A' stypvar%caxis='TYZ' stypvar(2)%cname= 'vosaline' stypvar(2)%cunits='PSU' stypvar(2)%valid_min= 0. stypvar(2)%valid_max= 50. stypvar(2)%clong_name='Salinity along OVIDE section' stypvar(2)%cshort_name='vosaline' stypvar(3)%cname= 'vozocrtx' stypvar(3)%cunits='m.s-1' stypvar(3)%valid_min= -20. stypvar(3)%valid_max= 20. stypvar(3)%clong_name='Zonal velocity along OVIDE section' stypvar(3)%cshort_name='vozocrtx' stypvar(4)%cname= 'vomecrty' stypvar(4)%cunits='m.s-1' stypvar(4)%valid_min= -20. stypvar(4)%valid_max= 20. stypvar(4)%clong_name='Meridionnal velocity along OVIDE section' stypvar(4)%cshort_name='vomecrty' stypvar(5)%cname= 'isec' stypvar(5)%valid_min= 0. stypvar(5)%valid_max= npiglo stypvar(6)%cname= 'jsec' stypvar(6)%valid_min= 0. stypvar(6)%valid_max= npjglo stypvar(7)%cname= 'e2u' stypvar(7)%valid_min= MINVAL(e2usec(1,:)) stypvar(7)%valid_max= MAXVAL(e2usec(1,:)) stypvar(8)%cname= 'e1v' stypvar(8)%valid_min= MINVAL(e1vsec(1,:)) stypvar(8)%valid_max= MAXVAL(e1vsec(1,:)) stypvar(9)%cname= 'e3u' stypvar(9)%valid_min= MINVAL(e3usec(:,:)) stypvar(9)%valid_max= MAXVAL(e3usec(:,:)) stypvar(10)%cname= 'e3v' stypvar(10)%valid_min= MINVAL(e3vsec(:,:)) stypvar(10)%valid_max= MAXVAL(e3vsec(:,:)) ! create output fileset ncout =create(cfileoutnc, 'none', 1,nsec,npk,cdep='depthw') ierr= createvar(ncout ,stypvar,nfield, ipk,id_varout ) ierr= putheadervar(ncout, cfilet,1, nsec,npk,pnavlon=lonsec,pnavlat=latsec,pdep=gdepw) tim=getvar1d(cfilet,'time_counter',1) ierr=putvar1d(ncout,tim,1,'T') ! netcdf output DO jk =1, npk ierr = putvar (ncout, id_varout(1), REAL(ovidetemper(:,jk)), jk,1,nsec-1) ierr = putvar (ncout, id_varout(2), REAL(ovidesaline(:,jk)), jk,1,nsec-1) ierr = putvar (ncout, id_varout(3), REAL(ovidezonalu(:,jk)), jk,1,nsec-1) ierr = putvar (ncout, id_varout(4), REAL(ovidemeridv(:,jk)), jk,1,nsec-1) ierr = putvar (ncout, id_varout(5), REAL(dumisec(1,:)), jk,1,nsec) ierr = putvar (ncout, id_varout(6), REAL(dumjsec(1,:)), jk,1,nsec) ierr = putvar (ncout, id_varout(7),REAL(e2usec(1,:)), jk,1,nsec-1) ierr = putvar (ncout, id_varout(8),REAL(e1vsec(1,:)), jk,1,nsec-1) ierr = putvar (ncout, id_varout(9),REAL(e3usec(:,jk)), jk,1,nsec-1) ierr = putvar (ncout, id_varout(10),REAL(e3vsec(:,jk)), jk,1,nsec-1) END DO ierr = closeout(ncout) !!-------------------------------------------------------------------- !! !! SUBROUTINES USED !! !!-------------------------------------------------------------------- CONTAINS SUBROUTINE Nearestpoint(pplon,pplat,kpi,kpj,plam,pphi,kpiloc,kpjloc,ldbord) !!---------------------------------------------------------------------------- !! *** SUBROUTINE NEARESTPOINT *** !! !! ** Purpose: Computes the positions of the nearest i,j in the grid !! from the given longitudes and latitudes !! !! ** Method : Starts on the middle of the grid, search in a 20x20 box, and move !! the box in the direction where the distance between the box and the !! point is minimum !! Iterates ... !! Stops when the point is outside the grid. !! This algorithm does not work on the Mediteranean grid ! !! !! * history: !! Anne de Miranda et Pierre-Antoine Darbon Jul. 2000 (CLIPPER) !! Jean-Marc Molines : In NEMO form !!---------------------------------------------------------------------------- IMPLICIT NONE !* arguments REAL(KIND=8),INTENT(in) :: pplon,pplat !: lon and lat of target point INTEGER(KIND=4),INTENT (in) :: kpi,kpj !: grid size INTEGER(KIND=4),INTENT (inout) :: kpiloc,kpjloc !: nearest point location REAL(KIND=8),DIMENSION(kpi,kpj),INTENT(in) :: pphi,plam !: model grid layout LOGICAL :: ldbord !: reach boundary flag ! * local variables INTEGER(KIND=4) :: ji,jj,i0,j0,i1,j1 INTEGER(KIND=4) :: itbl REAL(KIND=4) :: zdist,zdistmin,zdistmin0 LOGICAL, SAVE :: lbordcell, lfirst=.TRUE. !! ! Initial values kpiloc = kpi/2 ; kpjloc = kpj/2 ! seek from the middle of domain itbl = 10 ! block size for search zdistmin=1000000. ; zdistmin0=1000000. i0=kpiloc ; j0=kpjloc lbordcell=.TRUE.; ldbord=.FALSE. ! loop until found or boundary reach DO WHILE ( lbordcell .AND. .NOT. ldbord) i0=kpiloc-itbl ; i1=kpiloc+itbl j0=kpjloc-itbl ; j1=kpjloc+itbl ! search only the inner domain IF (i0 <= 0) i0=2 IF (i1 > kpi) i1=kpi-1 IF (j0 <= 0) j0=2 IF( j1 > kpj) j1=kpj-1 ! within a block itbl+1 x itbl+1: DO jj=j0,j1 DO ji=i0,i1 ! compute true distance (orthodromy) between target point and grid point zdist=dist(pplon,plam(ji,jj),pplat,pphi(ji,jj) ) zdistmin=MIN(zdistmin,zdist) ! update kpiloc, kpjloc if distance decreases IF (zdistmin .NE. zdistmin0 ) THEN kpiloc=ji kpjloc=jj ENDIF zdistmin0=zdistmin END DO END DO lbordcell=.FALSE. ! if kpiloc, kpjloc belong to block boundary proceed to next block, centered on kpiloc, kpjloc IF (kpiloc == i0 .OR. kpiloc == i1) lbordcell=.TRUE. IF (kpjloc == j0 .OR. kpjloc == j1) lbordcell=.TRUE. ! boundary reach ---> not found IF (kpiloc == 2 .OR. kpiloc ==kpi-1) ldbord=.TRUE. IF (kpjloc == 2 .OR. kpjloc ==kpj-1) ldbord=.TRUE. END DO END SUBROUTINE NEARESTPOINT SUBROUTINE interm_pt (ydpt,k,pai,pbi,paj,pbj,ydpti) !! ----------------------------------------------------- !! SUBROUTINE INTERM_PT !! ******************** !! !! PURPOSE: !! -------- !! Find the best intermediate points on a pathway. !! !! ARGUMENTS: !! ---------- !! ydpt : complex vector of the positions of the nearest points !! k : current working index !! pai ,pbi : slope and original ordinate of x(y) !! paj ,pbj : slope and original ordinate of y(x) !! ydpti : Complex holding the position of intermediate point !! !! AUTHOR: !! ------- !! 19/07/1999 : Jean-Marc MOLINES !! 14/01/2005 : J M M in F90 !! !!-------------------------------------------------------------- !! !! 0. Declarations: !! ---------------- IMPLICIT NONE COMPLEX, INTENT(in) :: ydpt(*) COMPLEX, INTENT(out) :: ydpti REAL(KIND=4), INTENT(IN) :: pai,pbi,paj,pbj INTEGER(KIND=4) ,INTENT(in) :: k ! ... local COMPLEX :: ylptmp1, ylptmp2 REAL(KIND=4) :: za0,zb0,za1,zb1,zd1,zd2 REAL(KIND=4) :: zxm,zym REAL(KIND=4) :: zxp,zyp !! !! 1. Compute intermediate points !! ------------------------------ ! ! ... Determines whether we use y(x) or x(y): IF (ABS(paj) <= 1) THEN ! ..... y(x) ! ... possible intermediate points: ylptmp1=ydpt(k-1)+(1.,0.) ylptmp2=ydpt(k-1)+CMPLX(0.,SIGN(1.,paj)) ! ! ... M is the candidate point: zxm=REAL(ylptmp1) zym=IMAG(ylptmp1) za0=paj zb0=pbj ! za1=-1./za0 zb1=zym - za1*zxm ! ... P is the projection of M on the strait line zxp=-(zb1-zb0)/(za1-za0) zyp=za0*zxp + zb0 ! ... zd1 is the distance MP zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp) ! ! ... M is the candidate point: zxm=REAL(ylptmp2) zym=IMAG(ylptmp2) za1=-1./za0 zb1=zym - za1*zxm ! ... P is the projection of M on the strait line zxp=-(zb1-zb0)/(za1-za0) zyp=za0*zxp + zb0 ! ... zd2 is the distance MP zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp) ! ... chose the smallest (zd1,zd2) IF (zd2 <= zd1) THEN ydpti=ylptmp2 ELSE ydpti=ylptmp1 END IF ! ELSE ! ! ... x(y) ylptmp1=ydpt(k-1)+CMPLX(SIGN(1.,pai),0.) ylptmp2=ydpt(k-1)+(0.,1.) zxm=REAL(ylptmp1) zym=IMAG(ylptmp1) za0=pai zb0=pbi ! za1=-1./za0 zb1=zxm - za1*zym zyp=-(zb1-zb0)/(za1-za0) zxp=za0*zyp + zb0 zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp) ! zxm=REAL(ylptmp2) zym=IMAG(ylptmp2) za1=-1./za0 zb1=zxm - za1*zym zyp=-(zb1-zb0)/(za1-za0) zxp=za0*zyp + zb0 zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp) IF (zd2 <= zd1) THEN ydpti=ylptmp2 ELSE ydpti=ylptmp1 END IF END IF END SUBROUTINE interm_pt FUNCTION dist(plona,plonb,plata,platb) !!---------------------------------------------------------- !! *** FUNCTION DIST *** !! !! ** Purpose : Compute the distance (km) between !! point A (lona, lata) and B(lonb,latb) !! !! ** Method : Compute the distance along the orthodromy !! !! * history : J.M. Molines in CHART, f90, may 2007 !!---------------------------------------------------------- IMPLICIT NONE ! Argument REAL(KIND=8), INTENT(in) :: plata, plona, platb, plonb REAL(KIND=8) :: dist ! Local variables REAL(KIND=8),SAVE :: zlatar, zlatbr, zlonar, zlonbr REAL(KIND=8) :: zpds REAL(KIND=8),SAVE :: zux, zuy, zuz REAL(KIND=8) :: zvx, zvy, zvz REAL(KIND=8), SAVE :: prevlat=-1000., prevlon=-1000, zr, zpi, zconv LOGICAL :: lfirst=.TRUE. ! initialise some values at first call IF ( lfirst ) THEN lfirst=.FALSE. ! constants zpi=ACOS(-1.) zconv=zpi/180. ! for degree to radian conversion ! Earth radius zr=(6378.137+6356.7523)/2.0 ! km ENDIF ! compute these term only if they differ from previous call IF ( plata /= prevlat .OR. plona /= prevlon) THEN zlatar=plata*zconv zlonar=plona*zconv zux=COS(zlonar)*COS(zlatar) zuy=SIN(zlonar)*COS(zlatar) zuz=SIN(zlatar) prevlat=plata prevlon=plona ENDIF zlatbr=platb*zconv zlonbr=plonb*zconv zvx=COS(zlonbr)*COS(zlatbr) zvy=SIN(zlonbr)*COS(zlatbr) zvz=SIN(zlatbr) zpds=zux*zvx+zuy*zvy+zuz*zvz IF (zpds >= 1.) THEN dist=0. ELSE dist=zr*ACOS(zpds) ENDIF END FUNCTION dist END PROGRAM cdfovide cdftools-3.0/cdfbotpressure.f900000644000175000017500000002152312241227304017675 0ustar amckinstryamckinstryPROGRAM cdfbotpressure !!====================================================================== !! *** PROGRAM cdfbotpressure *** !!===================================================================== !! ** Purpose : Compute bottom pressure from insitu density !! !! ** Method : Vertical integral of rho g dz !! eventually takes into account the SSH, and full step !! !! History : 3.0 : 01/2013 : J.M. Molines : Original code from cdfvint !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames USE modutils !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2012 !! $Id$ !! Copyright (c) 2012, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr, ij, iko ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! only one output variable INTEGER(KIND=4) :: ncout REAL(KIND=4), PARAMETER :: pp_grav = 9.81 ! Gravity REAL(KIND=4), PARAMETER :: pp_rau0 = 1035.e0 ! Reference density (as in NEMO) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3t ! vertical metric REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hdept ! vertical metric REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zt ! Temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zs ! Salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! npiglo x npjglo REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics in case of full step REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_psurf ! Surface pressure REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_bpres ! Bottom pressure REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_sigi ! insitu density CHARACTER(LEN=256) :: cf_in, cf_out ! input/output file CHARACTER(LEN=256) :: cldum ! dummy string for command line browsing CHARACTER(LEN=256) :: cglobal ! Global attribute LOGICAL :: lfull =.FALSE. ! flag for full step computation LOGICAL :: lssh =.FALSE. ! Use ssh and cst surf. density in the bot pressure LOGICAL :: lssh2 =.FALSE. ! Use ssh and variable surf.density in the bot pressure LOGICAL :: lchk =.FALSE. ! flag for missing files TYPE(variable), DIMENSION(1) :: stypvar ! extension for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfbotpressure T-file [-full] [-ssh] [-ssh2 ] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the vertical bottom pressure (pa) from in situ density' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : gridT file holding either Temperature and salinity ' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' -full : for full step computation ' PRINT *,' -ssh : Also take SSH into account in the computation' PRINT *,' In this case, use rau0=',pp_rau0,' kg/m3 for ' PRINT *,' surface density (as in NEMO)' PRINT *,' If you want to use 2d surface density from ' PRINT *,' the model, use option -ssh2' PRINT *,' -ssh2 : as option -ssh but surface density is taken from ' PRINT *,' the model instead of a constant' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fmsk),' and ', TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : botpressure.nc' PRINT *,' variables : sobotpres' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfvint' PRINT *,' ' STOP ENDIF ! browse command line ijarg = 1 ; ij = 0 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum) CASE ( '-ssh' ) ; lssh = .TRUE. CASE ( '-ssh2' ) ; lssh2 = .TRUE. CASE ( '-full' ) ; lfull = .TRUE. CASE DEFAULT ij = ij + 1 SELECT CASE ( ij) CASE ( 1 ) ; cf_in = cldum CASE DEFAULT ; PRINT *, ' ERROR: Too many arguments ! ' ; STOP END SELECT END SELECT END DO CALL SetGlobalAtt(cglobal) ! Security check lchk = chkfile ( cf_in ) lchk = chkfile ( cn_fmsk ) .OR. lchk lchk = chkfile ( cn_fzgr ) .OR. lchk IF ( lchk ) STOP ! missing files ! log information so far cf_out = 'botpressure.nc' npiglo = getdim (cf_in, cn_x ) npjglo = getdim (cf_in, cn_y ) npk = getdim (cf_in, cn_z ) npt = getdim (cf_in, cn_t ) PRINT *, ' NPIGLO = ', npiglo PRINT *, ' NPJGLO = ', npjglo PRINT *, ' NPK = ', npk PRINT *, ' NPT = ', npt ! Allocate arrays ALLOCATE ( tim(npt) ) ALLOCATE ( tmask(npiglo,npjglo) ) ALLOCATE ( zt(npiglo,npjglo) ) ALLOCATE ( zs(npiglo,npjglo) ) ALLOCATE ( e3t(npiglo,npjglo) ) ALLOCATE ( hdept(npiglo,npjglo) ) ALLOCATE ( e31d(npk) ) ALLOCATE ( gdepw(npk)) ALLOCATE ( dl_bpres(npiglo, npjglo)) ALLOCATE ( dl_psurf(npiglo, npjglo)) ALLOCATE ( dl_sigi(npiglo, npjglo)) ! prepare output variable ipk(:) = 1 stypvar(1)%cname = 'sobotpres' stypvar(1)%cunits = 'Pascal' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0 stypvar(1)%valid_max = 1.e15 stypvar(1)%clong_name = 'Bottom Pressure' stypvar(1)%cshort_name = 'sobotpres' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TYX' ! Initialize output file gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk ) ncout = create (cf_out, cf_in, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout, cdglobal=cglobal ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, 1 ) tim = getvar1d (cf_in, cn_vtimec, npt ) ierr = putvar1d (ncout, tim, npt, 'T') PRINT *, 'Output files initialised ...' DO jt = 1, npt IF ( lssh ) THEN zt(:,:) = getvar(cf_in, cn_sossheig, 1, npiglo, npjglo, ktime=jt ) dl_psurf(:,:) = pp_grav * pp_rau0 * zt(:,:) ELSE IF ( lssh2 ) THEN zt(:,:) = getvar(cf_in, cn_votemper, 1, npiglo, npjglo, ktime=jt ) zs(:,:) = getvar(cf_in, cn_vosaline, 1, npiglo, npjglo, ktime=jt ) dl_sigi(:,:) = 1000. + sigmai(zt, zs, 0., npiglo, npjglo) ! CAUTION : hdept is used for reading SSH in the next line hdept(:,:) = getvar(cf_in, cn_sossheig, 1, npiglo, npjglo, ktime=jt ) dl_psurf(:,:) = pp_grav * dl_sigi * hdept(:,:) ELSE dl_psurf(:,:)=0.d0 ENDIF dl_bpres(:,:) = dl_psurf(:,:) DO jk = 1, npk tmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo ) hdept(:,:) = getvar(cn_fzgr, cn_hdept, jk, npiglo, npjglo ) zt(:,:) = getvar(cf_in, cn_votemper, jk, npiglo, npjglo, ktime=jt ) zs(:,:) = getvar(cf_in, cn_vosaline, jk, npiglo, npjglo, ktime=jt ) dl_sigi(:,:) = 1000. + sigmai(zt, zs, hdept, npiglo, npjglo) IF ( lfull ) THEN ; e3t(:,:) = e31d(jk) ELSE ; e3t(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF dl_bpres(:,:) = dl_bpres(:,:) + dl_sigi(:,:) * e3t(:,:) * pp_grav * 1.d0 * tmask(:,:) END DO ! loop to next level ierr = putvar(ncout, id_varout(1) ,REAL(dl_bpres), 1, npiglo, npjglo, ktime=jt) END DO ! next time frame ierr = closeout(ncout) END PROGRAM cdfbotpressure cdftools-3.0/cdfsigi.f900000644000175000017500000001234712241227304016257 0ustar amckinstryamckinstryPROGRAM cdfsigi !!====================================================================== !! *** PROGRAM cdfsigi *** !!===================================================================== !! ** Purpose : Compute sigmai 3D field from gridT file !! Store the results on a 'similar' cdf file. !! !! ** Method: read temp and salinity, compute sigma-i !! using depth given in argument (meters or dbar) !! History : 2.0 : 11/2004 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: narg, iargc ! browse command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's REAL(KIND=4) :: ref_dep ! reference depth in meters REAL(KIND=4) :: zspval ! missing value REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp ! temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsal ! salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsigi ! sigma-i REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter CHARACTER(LEN=256) :: cf_tfil ! input filename CHARACTER(LEN=256) :: cf_out='sigi.nc'! output file name CHARACTER(LEN=256) :: cldum ! dummy string TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes !! !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfsigi T-file Ref-dep(m) ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute potential density refered to the depth given in arguments.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with temperature and salinity' PRINT *,' Ref-dep : reference depth in meter.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cn_vosigmai),' (kg/m3 -1000 )' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfsig0' PRINT *,' ' STOP ENDIF CALL getarg (1, cf_tfil) CALL getarg (2, cldum) ; READ(cldum,*) ref_dep IF ( chkfile(cf_tfil) ) STOP ! missing file npiglo = getdim (cf_tfil, cn_x) npjglo = getdim (cf_tfil, cn_y) npk = getdim (cf_tfil, cn_z) npt = getdim (cf_tfil, cn_t) ipk(:)= npk ! all variables (input and output are 3D) stypvar(1)%cname = cn_vosigmai stypvar(1)%cunits = 'kg/m3' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0.001 stypvar(1)%valid_max = 45. stypvar(1)%clong_name = 'Potential_density:refered to '//TRIM(cldum)//' m' stypvar(1)%cshort_name = cn_vosigmai stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE (ztemp(npiglo,npjglo), zsal (npiglo,npjglo) ) ALLOCATE (zsigi(npiglo,npjglo), zmask(npiglo,npjglo) ) ALLOCATE (tim(npt) ) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) zspval= getatt(cf_tfil, cn_vosaline, cn_missing_value) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jt = 1, npt PRINT *,'time: ',jt DO jk = 1, npk zmask(:,:) = 1. ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zsal( :,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) WHERE( zsal == zspval ) zmask = 0 zsigi(:,:) = sigmai(ztemp, zsal, ref_dep, npiglo, npjglo )* zmask(:,:) ierr = putvar(ncout, id_varout(1), zsigi, jk, npiglo, npjglo, ktime=jt) END DO ! loop to next level END DO ! loop on time ierr = closeout(ncout) END PROGRAM cdfsigi cdftools-3.0/cdffindij.f900000644000175000017500000000733112241227304016564 0ustar amckinstryamckinstryPROGRAM cdffindij !!====================================================================== !! *** PROGRAM cdffindij *** !!===================================================================== !! ** Purpose : Return the window index (imin imax jmin jmax ) !! for the geographical windows given on input !! (longmin longmax latmin matmax) !! !! ** Method : Read the coordinate/mesh_hgr file and look for the glam, !! gphi variables. !! Then use a search algorithm to find the corresponding I J !! The point type ( T U V F ) is specified on the command !! line as well as the name of the coordinate/mesh hgr file. !! !! History : 2.1 : 11/2005 : J.M. Molines : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE cdftools USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: iimin, iimax, ijmin, ijmax ! model grid window REAL(KIND=4) :: xmin, xmax, ymin, ymax ! geographical window CHARACTER(LEN=256) :: cltype='F' ! point type to search for CHARACTER(LEN=256) :: cldum ! dummy character variable CHARACTER(LEN=256) :: clcoo ! dummy character variable !!---------------------------------------------------------------------- CALL ReadCdfNames() clcoo = cn_fcoo !! Read command line and output usage message if not compliant. narg= iargc() IF ( narg < 4 ) THEN PRINT *,' usage : cdffindij xmin xmax ymin ymax [-c COOR-file] [-p point_type]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Return the model limit (i,j space) of the geographical window ' PRINT *,' given on the input line.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' xmin xmax ymin ymax : geographical limits of the window, in lon/lat' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-c COOR-file ] : specify a particular coordinate file' PRINT *,' default is ',TRIM(cn_fcoo) PRINT *,' [-p point type] : specify the point on the C-grid (T U V F)' PRINT *,' default is ',TRIM(cltype) PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fcoo),' or the specified coordinates file.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' Output is done on standard output.' STOP ENDIF ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE ( '-c' ) ; CALL getarg(ijarg, clcoo ) ; ijarg=ijarg+1 CASE ( '-p' ) ; CALL getarg(ijarg, cltype ) ; ijarg=ijarg+1 CASE DEFAULT ireq=ireq+1 SELECT CASE (ireq) CASE ( 1 ) ; READ(cldum,*) xmin CASE ( 2 ) ; READ(cldum,*) xmax CASE ( 3 ) ; READ(cldum,*) ymin CASE ( 4 ) ; READ(cldum,*) ymax CASE DEFAULT PRINT *,' Too many arguments !' ; STOP END SELECT END SELECT END DO CALL cdf_findij ( xmin, xmax, ymin, ymax, iimin, iimax, ijmin, ijmax, cd_coord=clcoo, cd_point=cltype, cd_verbose='y') END PROGRAM cdffindij cdftools-3.0/cdf16bit.f900000644000175000017500000006200312241227304016243 0ustar amckinstryamckinstryPROGRAM cdf16bit !!====================================================================== !! *** PROGRAM cdf16bit *** !!====================================================================== !! ** Purpose : Transform the 32bit precision input file into a 16bit prec. !! Uses constant scale_factor and add_offset. !! !! ** Method : Store the results on a 'cdf16bit.nc' file similar to the input file. !! Scale factor and offset are pre-defined for authorized cdf varname !! !! History : 2.1 ! 11/2006 J.M. Molines : Original code !! 3.0 ! 12/2010 J.M. Molines : Full Doctor form + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! sf_ao : Scale Factor Add Offset !! check_scaling : verify that the sf_ao do not produce saturation !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt, jvar, jv ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! Number of variables in a file INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of var id's INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! arrays of var id's INTEGER(KIND=2), DIMENSION(:,:), ALLOCATABLE :: i2d ! 16 bit 2D array fro conversion REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! Array to read a layer of data REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zmax, zmin ! min and max of the field at level(jk) REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time of file REAL(KIND=4) :: sf, ao ! scale_factor, add_offset REAL(KIND=4) :: zchkmax, zchkmin ! scale_factor, add_offset checking values REAL(KIND=4) :: zzmax, zzmin ! min and max of the full 3D field REAL(KIND=4) :: spval ! missing value, fill_value, spval ... CHARACTER(LEN=256) :: cf_in ! input file CHARACTER(LEN=256) :: cf_out='cdf16bit.nc' ! outputfile CHARACTER(LEN=256) :: cldum ! dummy string CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! Type variable is defined in cdfio. LOGICAL :: l_chk=.false. ! logical flags to save line options LOGICAL :: l_verbose=.false. ! logical flags to save line options LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lmask ! 2D logical land/sea mask (true on ocean) !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdf16bit 32BIT-file [ -check ] [ -verbose]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Convert input 32 bit precision file into 16 bit' PRINT *,' precision file using add_offset and scale_factor' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' 32BIT-file : input 32 bit file to be converted' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -check ] : control than the scale factors are adequate' PRINT *,' [ -verbose ] : give information level by level.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none ' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : same names than in input file' STOP ENDIF !! ijarg = 1 CALL getarg (ijarg, cf_in) ; ijarg = ijarg + 1 IF ( chkfile(cf_in) ) STOP ! missing file ! Check for options and reflect options on logical flags DO WHILE ( ijarg <= narg) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) ! Analyse option CASE ( '-check' ) ! control if the scale factors are OK l_chk=.true. CASE ( '-verbose' ) ! information will be given level by level l_chk=.true. ; l_verbose=.true. CASE DEFAULT PRINT *,' OPTION ',TRIM(cldum),' not supported.' ; STOP END SELECT END DO ! get domain dimension from input file npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z',kstatus=ierr) IF (ierr /= 0 ) STOP 'depth dimension name not suported' ENDIF npt = getdim (cf_in, cn_t) ! Allocate memory ALLOCATE( v2d(npiglo,npjglo), i2d(npiglo,npjglo), lmask(npiglo, npjglo) ) ALLOCATE( zmin(npk) , zmax(npk) , tim(npt)) ! Get the number of variables held in the file, allocate arrays nvars = getnvar(cf_in) PRINT *,' nvars =', nvars ALLOCATE (cv_names(nvars) ) ALLOCATE (stypvar(nvars) ) ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) ) ! get list of variable names and collect attributes in stypvar (optional) cv_names(:)=getvarname(cf_in,nvars,stypvar) id_var(:) = (/(jv, jv=1,nvars)/) ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk (cf_in,nvars) ! flags variable not to be treated by changing their name to none WHERE( ipk == 0 ) cv_names='none' stypvar(:)%cname=cv_names ! create output fileset ! fills the scale_factor and add_offset attribute according to variable name ! if the variable is not documented, then, sf=1, ao=0. and no conversion ! is performed for this variable (It stays in REAL*4 ) DO jvar=1,nvars IF (cv_names(jvar) /= 'none' ) CALL sf_ao(jvar) END DO ! create output file taking the sizes in cf_in ncout =create(cf_out, cf_in,npiglo,npjglo,npk) ! The variables are created as FLOAT or SHORT depending on the scale_factor AND add_offset attribute ierr= createvar(ncout , stypvar, nvars, ipk, id_varout ) ierr= putheadervar(ncout , cf_in, npiglo, npjglo, npk) ! Get time and write time tim=getvar1d(cf_in,cn_vtimec,npt) ; ierr=putvar1d(ncout,tim,npt,'T') ! Loop on all variables of the file DO jvar = 1,nvars IF (cv_names(jvar) == 'none' ) THEN ! skip these variable they are copied in ncout by putheader above ELSE sf=stypvar(jvar)%scale_factor ao=stypvar(jvar)%add_offset PRINT *,' Working with ', TRIM(cv_names(jvar)), ipk(jvar), sf, ao spval=stypvar(jvar)%rmissing_value DO jt = 1, npt DO jk = 1, ipk(jvar) v2d(:,:)= getvar(cf_in, cv_names(jvar), jk ,npiglo, npjglo, ktime=jt ) IF ( sf == 1. .AND. ao == 0 ) THEN ! write FLOATS IF ( stypvar(jvar)%savelog10 == 1 ) THEN WHERE ( v2d /= spval ) v2d(:,:)= log10(v2d) ELSEWHERE v2d = 0. END WHERE ENDIF ierr = putvar(ncout, id_varout(jvar) ,v2d, jk, npiglo, npjglo, ktime=jt) ! skip remaining of the do-loop, treat next level CYCLE ENDIF IF ( stypvar(jvar)%savelog10 == 0 ) THEN ! take care of not converting 'special values' WHERE( v2d /= spval ) i2d(:,:)=NINT((v2d(:,:)-ao)/sf) ELSEWHERE i2d(:,:)=0 END WHERE ELSE ! store log10 ao and sf refer to the log10 of the variable WHERE( v2d /= spval ) i2d(:,:)=NINT((log10(v2d(:,:))-ao)/sf) ELSEWHERE i2d(:,:)=0 END WHERE ENDIF CALL checkscaling ! write SHORT to the file ierr = putvar(ncout, id_varout(jvar) ,i2d, jk, npiglo, npjglo, ktime=jt) END DO ! loop to next level END DO ! next time loop END IF END DO ! loop to next var in file ierr = closeout(ncout) CONTAINS SUBROUTINE sf_ao (kvar) !!--------------------------------------------------------------------- !! *** ROUTINE sf_ao *** !! !! ** Purpose : Set the scale_factor and add_offset for the variable kvar !! Also set the flag savelog10 when the log10 of the variable !! is stored, instead of the proper variable. !! !! ** Method : Recognize the variable name and set pre-defined values. !! Give the min and max value for a given variable, and remap !! it on -32000 +32000 (Integer*2. The max I2 is 32767 (2^15 -1) !! Taking 32000 leaves allows a slight overshoot ( 1%) !! !! ** Comments : With select case (which gives a much more readable code, !! the CASE statement requires a constant matching pattern, !! thus avoiding the use of dynamically adjusted names as !! defined in modcdfnames ... !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kvar ! variable number CHARACTER(LEN=256) :: clvarname REAL(KIND=4) :: zvmin, zvmax !!---------------------------------------------------------------------- clvarname=cv_names(kvar) SELECT CASE (clvarname) ! gridT CASE ('votemper') ! Potential temperature (Deg C) zvmin= -3. ; zvmax = 42. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('vosaline') ! Salinity (PSU) zvmin= 0. ; zvmax = 42. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('sossheig') ! Sea Surface Heigh (m) zvmin= -2.5 ; zvmax = 2.5 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('somxl010') ! Mixed layer depth (m) zvmin= 0. ; zvmax = 5000. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('sohefldo') ! Total Heat flux Down (W/m2) zvmin= -1500. ; zvmax = 500. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('soshfldo') ! Solar Heat flux Down (W/m2) zvmin= -0.1 ; zvmax = 500. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('sowaflup') ! Evaporation - Precipitation Up ( kg/m2/s) zvmin= -0.1 ; zvmax = 0.1 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('sowafldp') ! SSS damping term Up (kg/m2/s ) zvmin= -10. ; zvmax = 15. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iowaflup') ! ??? zvmin= -1. ; zvmax = 0.1 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('sowaflcd') ! Concentration Dilution water flux (kg/m2/s) zvmin=-1. ; zvmax = 15. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('solhflup') ! Latent Heat Flux Up (W/m2) zvmin=-800. ; zvmax = 150. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('solwfldo') ! Long Wave radiation Heat flux Down (W/m2) zvmin=-200. ; zvmax = 50. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('sosbhfup') ! Sensible Heat Flux Up (W/m2) zvmin=-800. ; zvmax = 100. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. ! gridU CASE ('vozocrtx') ! Zonal Velocity U (m/s) zvmin= -3.0 ; zvmax = 3.0 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('sozotaux') ! Zonal Wind Stress (N/m2) zvmin= -1.5 ; zvmax = 1.5 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. ! gridV CASE ('vomecrty') ! Meridional Velocity V (m/s) zvmin= -3.0 ; zvmax = 3.0 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('sometauy') ! Meridional Wind Stress (N/m2) zvmin= -1.5 ; zvmax = 1.5 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. ! gridW CASE ('vovecrtz') ! Vertical Velocity W (m/s) zvmin= -1.e-2 ; zvmax = 1.e-2 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('votkeavt') ! Vertical mixing coef log(avt) log(m2/s) zvmin= -8. ; zvmax = 2.0 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=1. !icemod CASE ('isnowthi') ! Snow Thickness (m) zvmin=0. ; zvmax = 5. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iicethic') ! Ice Thickness (m) zvmin=0. ; zvmax = 15. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iiceprod') ! Ice Production (m/kt) (step ice) zvmin=-0.05 ; zvmax = 0.05 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('ileadfra') ! Ice Lead Fraction (%) (In fact, ice concentration) zvmin= 0 ; zvmax = 1. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iicetemp') ! Ice Temperature (Deg C ) zvmin= -50. ; zvmax = 0.1 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('ioceflxb') !Ocean Ice flux (W/m2) zvmin= -100. ; zvmax = 2500.0 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iicevelu') ! Zonal Ice Velocity (m/s) (at U point) zvmin= -2. ; zvmax = 2.0 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iicevelv') ! Meridional Ice Velocity (m/s) (at V point) zvmin= -2. ; zvmax = 2.0 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('isstempe') ! Sea Surface Temperature (Deg C) zvmin= -3. ; zvmax = 42.0 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('isssalin') ! Sea Surface Salinity (PSU) zvmin= 0. ; zvmax = 42.0 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iocetflx') ! Total Flux at Ocean Surface (W/m2) zvmin= -1500. ; zvmax = 500. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iocesflx') ! Solar Flux at Ocean Surface (W/m2) zvmin= 0. ; zvmax = 500. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iocwnsfl') ! Non Solar Flux at Ocean surface (W/m2) zvmin= -1500. ; zvmax = 200. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iocesafl') ! Salt Flux at Ocean Surface (kg/m2/kt) zvmin= -300. ; zvmax = 300. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iocestru') ! Zonal Ice Ocean Stress (N/m2) zvmin= -1.5 ; zvmax = 1.5 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iocestrv') ! Meridional Ice Ocean Stress (N/m2) zvmin= -1.5 ; zvmax = 1.5 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iicesflx') ! Solar FLux at ice/ocean Surface (W/m2) zvmin= -1.0 ; zvmax = 500. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('iicenflx') ! Non Solar FLux at ice/ocean Surface (W/m2) zvmin= -1500. ; zvmax = 300. stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. CASE ('isnowpre') ! Snow Precipitation (kg/day) zvmin= 0. ; zvmax = 0.0001 stypvar(kvar)%add_offset=(zvmin + zvmax) /2. stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000. stypvar(kvar)%savelog10=0. ! TRC CASE ('cfc11') ! Concentration tracer 1 zvmin= 0. ; zvmax = 0.0001 stypvar(kvar)%add_offset=0. stypvar(kvar)%scale_factor= 1. stypvar(kvar)%savelog10=1. CASE ('bombc14') ! Concentration tracer 1 zvmin= 0. ; zvmax = 0.0001 stypvar(kvar)%add_offset=0. stypvar(kvar)%scale_factor= 1. stypvar(kvar)%savelog10=1. CASE DEFAULT PRINT *, TRIM(clvarname),' is not recognized !' PRINT *, 'No conversion will be performed' stypvar(kvar)%scale_factor=1.0 stypvar(kvar)%add_offset=0. stypvar(kvar)%savelog10=0. END SELECT END SUBROUTINE sf_ao SUBROUTINE checkscaling() !!--------------------------------------------------------------------- !! *** ROUTINE checkscaling *** !! !! ** Purpose : Check if the scale_factor and add_offset are ok for !! the current v2d field !! !! ** Method : - Needs -check and/or -verbose line option to be activated. !! - Find the min and max of 3D field (called every level, and determine min/max) !! - if -verbose option set, give details at every levels !! - When last level is done, give the diagnostics in case of conflict !! !!---------------------------------------------------------------------- IF ( l_chk ) THEN ! with this option, check if the max value of the field can be !mapped on I2 with actual values of Scale_factor and Add_offset lmask=.true. ; WHERE (v2d == spval ) lmask=.false. ! Works with log10 of v2d in case of savelog10=1 IF (stypvar(jvar)%savelog10 == 1 ) THEN WHERE( v2d /= 0. ) v2d=LOG10(v2d) ENDIF zmax(jk)=MAXVAL(v2d,lmask) ; zmin(jk)=MINVAL(v2d,lmask) ! Additional output if verbose mode IF ( l_verbose ) THEN zchkmax=(zmax(jk) - ao )/sf ; zchkmin = (zmin(jk) -ao ) /sf IF ( zchkmax >= 2**15 ) THEN PRINT *,TRIM(cv_names(jvar)), ' LEVEL ', jk ,' MIN = ',zmin(jk),' MAX = ', zmax(jk) PRINT *,' W A R N I N G ! : maximum too high for (sf,ao) pair.', TRIM(cf_in) PRINT *,' Optimal value for this level AO = ', (zmin(jk) + zmax(jk) )/2.,' [ ', & & stypvar(jvar)%add_offset,']' PRINT *,' Optimal value for this level SF = ', (zmax(jk) - (zmin(jk) + zmax(jk) )/2. )/32000., & & ' [ ',stypvar(jvar)%scale_factor,' ] ' END IF IF ( zchkmin < -2**15 ) THEN PRINT *,TRIM(cv_names(jvar)), ' LEVEL ', jk ,' MIN = ',zmin(jk),' MAX = ', zmax(jk) PRINT *,' W A R N I N G ! : minimum too low for (sf,ao) pair.', TRIM(cf_in) PRINT *,' Optimal value for this level AO = ', (zmin(jk) + zmax(jk) )/2.,' [ ', & & stypvar(jvar)%add_offset,']' PRINT *,' Optimal value for this level SF = ', (zmax(jk) - (zmin(jk) + zmax(jk) )/2. )/32000., & & ' [ ',stypvar(jvar)%scale_factor,' ] ' END IF END IF ! verbose mode ! Print a warning if necessary after the last level of var has been processed IF ( jk == ipk(jvar) ) THEN zzmax=MAXVAL(zmax(1:ipk(jvar))) ; zzmin=MINVAL(zmin(1:ipk(jvar))) zchkmax=(zzmax - ao )/sf ; zchkmin = (zzmin -ao ) /sf IF ( zchkmax >= 2**15 ) THEN PRINT *,' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' PRINT *,TRIM(cv_names(jvar)), ' MIN = ',zzmin,' MAX = ',zzmax,TRIM(cf_in) PRINT *,' WARNING ! : maximum too high for (sf,ao) pair.' PRINT *,' Optimal value for this level AO = ', (zzmin + zzmax )/2.,' [ ', & & stypvar(jvar)%add_offset,']' PRINT *,' Optimal value for this level SF = ', (zzmax - (zzmin + zzmax )/2. )/32000., & & ' [ ',stypvar(jvar)%scale_factor,' ] ' PRINT *,' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' END IF IF ( zchkmin < -2**15 ) THEN PRINT *,' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' PRINT *,TRIM(cv_names(jvar)), ' MIN = ',zzmin,' MAX = ', zzmax,TRIM(cf_in) PRINT *,' WARNING ! : minimum too low for (sf,ao) pair.' PRINT *,' Optimal value for AO = ', (zzmin + zzmax )/2.,' [ ', & & stypvar(jvar)%add_offset,']' PRINT *,' Optimal value for SF = ', (zzmax - (zzmin + zzmax )/2. )/32000., & & ' [ ',stypvar(jvar)%scale_factor,' ] ' PRINT *,' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' ENDIF END IF ! last level END IF ! check mode END SUBROUTINE checkscaling END PROGRAM cdf16bit cdftools-3.0/cdf2levitusgrid2d.f900000644000175000017500000006365612241227304020206 0ustar amckinstryamckinstryPROGRAM cdf2levitusgrid2d !!====================================================================== !! *** PROGRAM cdf2levitusgrid2d *** !!===================================================================== !! ** Purpose : remaps (bin) 2D high resolution (finer than 1x1 deg) !! fields on Levitus 2D 1x1 deg grid !! !! ** Method : data surface averaging !! It assumes that Levitus grid SW grid cell center !! is 0.5W,89.5S !! !! History : 3.0 : 06/2012 : N. Ferry : Original code !!---------------------------------------------------------------------- USE cdfio USE modcdfnames USE cdftools USE modutils !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2012 !! $Id$ !! Copyright (c) 2012, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: jilev,jjlev ! dummy loop index INTEGER(KIND=4) :: jvar, numvar0 ! dummy loop index INTEGER(KIND=4) :: ii, ij ! array index (not loop) INTEGER(KIND=4) :: iilev, ijlev ! array index (not loop) INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: npilev, npjlev ! size of the Levitus domain INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: nvars ! number of variables in the input file INTEGER(KIND=4) :: nvarsout ! number of variables in the output file INTEGER(KIND=4) :: iimin, iimax ! IJ coordinates of the closest points INTEGER(KIND=4) :: ijmin, ijmax ! " " " INTEGER(KIND=4) :: imethod=1 ! interpolation method INTEGER(KIND=4) :: iter_shap=3 ! number of Shapiro iteration INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_var ! levels and varid's of input vars INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipkout, id_varout ! levels and varid's of output vars REAL(KIND=4) :: zradius=120. ! Distance (km) for the search bubble (FHZ) REAL(KIND=4) :: rlon1, rlon2, rlat1, rlat2, rpos REAL(KIND=4) :: gphitmin REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t ! horizontal T metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: z_in ! input field REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: z_fill ! output REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamt, gphit ! T longitude latitude REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rlonlev, rlatlev ! Levitus grid longitude latitude REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zbt REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! input mask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmasklev ! output mask REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! depth axis REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: d_out, d_n ! output field and weighting field CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cf_out ! output file name ( output) CHARACTER(LEN=256) :: cf_levitus_mask='levitus_mask.nc' ! Levitus mask filename CHARACTER(LEN=256) :: cv_nam ! variable name CHARACTER(LEN=256) :: cldum ! dummy string CHARACTER(LEN=256) :: ctcalendar ! time attributes CHARACTER(LEN=256) :: cttitle ! time attributes CHARACTER(LEN=256) :: ctlong_name ! time attributes CHARACTER(LEN=256) :: ctaxis ! time attributes CHARACTER(LEN=256) :: ctunits ! time attributes CHARACTER(LEN=256) :: cttime_origin ! time attributes CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name CHARACTER(LEN=6) :: ctyp ! 'fill' or 'smooth' for shapiro TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! input attributes TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvarout ! output attributes LOGICAL :: lchk ! missing files flag LOGICAL :: ltest !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg < 3 ) THEN PRINT *,' usage : cdf2levitusgrid2d IN-file OUT-file VAR-name2D' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' remaps (bin) 2D high resolution (finer than 1x1 deg) ' PRINT *,' fields on Levitus 2D 1x1 deg grid ' PRINT *,' (does not work for vector fields) ' PRINT *,' It assumes that Levitus grid SW grid cell center ' PRINT *,' is (0.5W,89.5S) ' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : netcdf input file ' PRINT *,' OUT-file : netcdf output file ' PRINT *,' VAR-name2D : input variable name for interpolation ' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr) PRINT *,' ',TRIM(cn_fmsk) PRINT *,' ',TRIM(cf_levitus_mask) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : name given as second argument' PRINT *,' variables : 2d_var_name' STOP ENDIF ijarg = 1 CALL getarg(ijarg, cf_in) ; ijarg = ijarg + 1 CALL getarg(ijarg, cf_out) ; ijarg = ijarg + 1 CALL getarg(ijarg, cv_nam) ; ijarg = ijarg + 1 lchk = chkfile (cn_fhgr) lchk = chkfile (cn_fmsk) .OR. lchk lchk = chkfile (cf_levitus_mask) .OR. lchk lchk = chkfile (cf_in) .OR. lchk IF ( lchk ) STOP ! missing files npiglo = getdim(cf_in,cn_x) npjglo = getdim(cf_in,cn_y) npk = getdim(cf_in,cn_z) npt = getdim(cf_in,cn_t) npilev = getdim(cf_levitus_mask,cn_x) npjlev = getdim(cf_levitus_mask,cn_y) nvars = getnvar(cf_in) ALLOCATE (cv_names(nvars) ) ALLOCATE (stypvar(nvars) , stypvarout(1)) ALLOCATE (id_var(nvars), ipk(nvars), id_varout(1), ipkout(1)) ALLOCATE ( zbt(npiglo,npjglo) , z_in(npiglo,npjglo) ) ! get list of variable names and collect attributes in stypvar (optional) cv_names(:) = getvarname(cf_in, nvars, stypvar) id_var(:) = (/(jvar, jvar=1,nvars)/) ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk(cf_in, nvars) WHERE( ipk == 0 ) cv_names='none' stypvar(:)%cname = cv_names ! select variables to output: ii=1 DO jk=1,nvars IF ( TRIM(cv_names(jk)) == TRIM(cv_nam) ) THEN ipkout(ii) = ipk(jk) stypvarout(ii) = stypvar(jk) stypvarout(ii)%rmissing_value=getspval ( cf_in, TRIM(cv_nam) ) PRINT*, 'rmissing_value = ', stypvarout(ii)%rmissing_value nvarsout = ii numvar0 = jk ENDIF ENDDO z_in(:,:) = getvar(cf_in, cv_names(numvar0), 1, npiglo, npjglo) ! Allocate the memory ALLOCATE ( e1t(npiglo,npjglo), e2t(npiglo,npjglo) ) ALLOCATE ( glamt(npiglo,npjglo), gphit(npiglo,npjglo) ) ALLOCATE ( d_out(npilev,npjlev) , d_n(npilev,npjlev) ) ALLOCATE ( tmask(npiglo,npjglo) , tmasklev(npilev,npjlev)) ALLOCATE ( rlonlev(npilev,npjlev), rlatlev(npilev,npjlev) ) ALLOCATE ( gdept(1), tim(npt) ) ! Read the metrics from the mesh_hgr file e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) ! and the coordinates from the mesh_hgr file glamt = getvar(cn_fhgr, cn_glamt, 1, npiglo, npjglo) gphit = getvar(cn_fhgr, cn_gphit, 1, npiglo, npjglo) gphitmin = MINVAL(gphit(:,1)) WHERE ( glamt < 0. ) glamt = glamt + 360. END WHERE ! get the tmask from the byte_mask file tmask(:,:) = getvar(cn_fmsk, 'tmask', 1, npiglo, npjglo) ! get the longitude,latitude,mask from the input Levitus mask file rlonlev(:,:) = getvar(cf_levitus_mask, 'nav_lon', 1, npilev, npjlev) rlatlev(:,:) = getvar(cf_levitus_mask, 'nav_lat' , 1, npilev, npjlev) tmasklev(:,:) = getvar(cf_levitus_mask, 'mask', 1, npilev, npjlev) ! create output fileset ncout = create (cf_out, cf_levitus_mask, npilev, npjlev, 0 ,cdlonvar='lon', cdlatvar='lat' ) ierr = createvar (ncout , stypvarout, 1, ipkout, id_varout ) ierr = putheadervar(ncout , 'dummy', npilev, npjlev, 0 , pnavlon=rlonlev, pnavlat=rlatlev ) tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = gettimeatt(cf_in, cn_vtimec, ctcalendar, cttitle, ctlong_name, ctaxis, ctunits, cttime_origin ) ierr = puttimeatt(ncout, cn_vtimec, ctcalendar, cttitle, ctlong_name, ctaxis, ctunits, cttime_origin ) ierr = putvar1d( ncout, rlonlev(:,1), npilev, 'X') ierr = putvar1d( ncout, rlatlev(1,:), npjlev, 'Y') zbt(:,:) = e1t(:,:) * e2t(:,:) ! for surface weighting DO jt = 1, npt PRINT *,'jt = ', jt ! Compute spatial mean by bin !----------------------------- ! Perform bining of the input file on the Levitus grid. ! Input area weighted values are summed up into a Levitus 1x1 bin d_out(:,:) = 0.d0 d_n (:,:) = 0.d0 DO jj=1,npjglo DO ji=1,npiglo iilev = MIN( 360, INT( glamt(ji,jj) ) + 1) ijlev = MIN (180 , INT( gphit(ji,jj) + 90. ) + 1) !IF ( iilev < 1 .OR. iilev .GT. 360 ) print*, 'iilev, glamt = ',iilev,glamt(ji,jj) !IF ( ijlev < 1 .OR. ijlev .GT. 180 ) print*, 'ijlev, gphit = ',ijlev,gphit(ji,jj) IF ( z_in(ji,jj) /= stypvarout(1)%rmissing_value ) THEN d_out(iilev,ijlev) = d_out(iilev,ijlev) + (z_in(ji,jj)*tmask(ji,jj))*zbt(ji,jj)*tmasklev(iilev,ijlev)*1.d0 d_n (iilev,ijlev) = d_n (iilev,ijlev) + tmask(ji,jj) *zbt(ji,jj)*tmasklev(iilev,ijlev)*1.d0 ENDIF ENDDO ENDDO WHERE ( d_n > 0. ) d_out = d_out / d_n ELSEWHERE d_out = stypvarout(1)%rmissing_value END WHERE ! Check if there are points with missing values on Levitus grid IF ( COUNT( d_out == stypvarout(1)%rmissing_value .AND. tmasklev == 1. ) /= 0. ) THEN ALLOCATE ( z_fill(npilev,npjlev) ) z_fill(:,:) = 0. ! imethod = 1 SELECT CASE (imethod) CASE ( 1 ) ! Method 1: fill missing data with shapiro ctyp='fill' iter_shap = 3 ! number of shapiro iteration CALL shapiro_fill_smooth ( REAL(d_out), npilev, npjlev, iter_shap, ctyp, & stypvarout(1)%rmissing_value, INT(tmasklev), z_fill ) DO jjlev = 1 , npjlev DO jilev = 1 , npilev IF ( z_fill(jilev,jjlev) .NE. stypvarout(1)%rmissing_value & & .AND. tmasklev(jilev,jjlev) == 1 & & .AND. d_out(jilev,jjlev) == stypvarout(1)%rmissing_value ) & & d_out(jilev,jjlev) = z_fill(jilev,jjlev) ENDDO ENDDO CASE ( 2 ) ! Method 2: compute with influence bubble ! For each point of Levitus grid, a data screening is performed ! in a influence bubble of radius zradius, centered on Levitus point ! and the weighted average of the data in the bubble is computed z_fill(:,:) = 0. DO jjlev = 1 , npjlev-1 DO jilev = 1 , npilev ierr = 0 IF ( tmasklev(jilev,jjlev) == 1 .AND. d_out(jilev,jjlev) == stypvarout(1)%rmissing_value ) THEN ! for the South pole, no treatment performed if data too far from southern most orca points CALL btoe(rlonlev(jilev,jjlev),rlatlev(jilev,jjlev),rlon1,rlat1,-1.2*zradius,-1.2*zradius) IF ( rlat1 > gphitmin ) THEN ! Search the closest point of ORCA grid for this Levitus point CALL cdf_findij (rlonlev(jilev,jjlev), rlonlev(jilev,jjlev), rlatlev(jilev,jjlev), rlatlev(jilev,jjlev), & & iimin, iimax, ijmin, ijmax,cd_coord=cn_fhgr,cd_point='T', cd_verbose='N') ! Next valid grid point going northward on ORCA grid ltest = .TRUE. ; ij = ijmin ; ii = iimin DO WHILE ( ij <= npjglo .AND. ltest .AND. & & etobd(rlonlev(jilev,jjlev),rlatlev(jilev,jjlev),glamt(ii,ij), gphit(ii,ij)) <= zradius ) IF ( tmask(ii,ij) == 1 ) THEN ltest = .FALSE. z_fill(jilev,jjlev) = z_fill(jilev,jjlev) + & &(z_in(ii,ij)*tmask(ii,ij))*zbt(ii,ij)*tmasklev(jilev,jjlev) d_n (jilev,jjlev) = d_n (jilev,jjlev) + & & tmask(ii,ij) *zbt(ii,ij)*tmasklev(jilev,jjlev) ierr = ierr + 1 ENDIF ij = ij + 1 END DO ! Next valid grid point going southward on ORCA grid ltest = .TRUE. ; ij = ijmin-1 ; ii = iimin DO WHILE ( ij >= 1 .AND. ltest .AND. & & etobd(rlonlev(jilev,jjlev),rlatlev(jilev,jjlev),glamt(ii,ij), gphit(ii,ij)) <= zradius ) IF ( tmask(ii,ij) == 1 ) THEN ltest = .FALSE. z_fill(jilev,jjlev) = z_fill(jilev,jjlev) + & & (z_in(ii,ij)*tmask(ii,ij))*zbt(ii,ij)*tmasklev(jilev,jjlev) d_n (jilev,jjlev) = d_n (jilev,jjlev) + & & tmask(ii,ij) *zbt(ii,ij)*tmasklev(jilev,jjlev) ierr = ierr + 1 ENDIF ij = ij - 1 END DO ! Next valid grid point going westward on ORCA grid ltest = .TRUE. ; ij = ijmin ; ii = iimin+1 ; IF ( ii > npiglo ) ii = ii - npiglo DO WHILE ( ltest .AND. & & etobd(rlonlev(jilev,jjlev),rlatlev(jilev,jjlev),glamt(ii,ij), gphit(ii,ij)) <= zradius ) IF ( tmask(ii,ij) == 1 ) THEN ltest = .FALSE. z_fill(jilev,jjlev) = z_fill(jilev,jjlev) + & & (z_in(ii,ij)*tmask(ii,ij))*zbt(ii,ij)*tmasklev(jilev,jjlev) d_n (jilev,jjlev) = d_n (jilev,jjlev) + & & tmask(ii,ij) *zbt(ii,ij)*tmasklev(jilev,jjlev) ierr = ierr + 1 ENDIF ii = ii + 1 IF ( ii > npiglo ) ii = ii - npiglo END DO ! Next valid grid point going eastward on ORCA grid ltest = .TRUE. ; ij = ijmin ; ii = iimin-1 ; IF ( ii < 1) ii = ii + npiglo DO WHILE ( ltest .AND. & & etobd(rlonlev(jilev,jjlev),rlatlev(jilev,jjlev),glamt(ii,ij), gphit(ii,ij)) <= zradius ) IF ( tmask(ii,ij) == 1 ) THEN ltest = .FALSE. z_fill(jilev,jjlev) = z_fill(jilev,jjlev) + & & (z_in(ii,ij)*tmask(ii,ij))*zbt(ii,ij)*tmasklev(jilev,jjlev) d_n (jilev,jjlev) = d_n (jilev,jjlev) + & & tmask(ii,ij) *zbt(ii,ij)*tmasklev(jilev,jjlev) ierr = ierr + 1 ENDIF ii = ii - 1 IF ( ii < 1 ) ii = ii + npiglo END DO ! computing d_out value IF ( z_fill(jilev,jjlev) .NE. stypvarout(1)%rmissing_value & & .AND. d_n(jilev,jjlev) > 0 & & .AND. d_out(jilev,jjlev) == stypvarout(1)%rmissing_value ) & & d_out(jilev,jjlev) = z_fill(jilev,jjlev) / d_n(jilev,jjlev) ENDIF ! rlat1 > gphitmin ENDIF ! tmasklev(jilev,jjlev) == 1 .AND. d_out(jilev,jjlev) == stypvarout(1)%rmissing_value ENDDO ENDDO ! Case of the North Pole ijlev = npjlev DO jilev = 1 , npilev ierr = 0 IF ( tmasklev(jilev,ijlev) == 1 .AND. d_out(jilev,ijlev) == stypvarout(1)%rmissing_value ) THEN ! Search the closest point of ORCA grid for this Levitus point CALL cdf_findij (rlonlev(jilev,ijlev), rlonlev(jilev,ijlev), rlatlev(jilev,ijlev), rlatlev(jilev,ijlev), & & iimin, iimax, ijmin, ijmax,cd_coord=cn_fhgr,cd_point='T', cd_verbose='N') ! Next valid grid point going southward on ORCA grid ltest = .TRUE. ; ij = ijmin ; ii = iimin DO WHILE ( ij >= 1 .AND. ltest .AND. & & etobd(rlonlev(jilev,ijlev),rlatlev(jilev,ijlev),glamt(ii,ij), gphit(ii,ij)) <= zradius ) IF ( tmask(ii,ij) == 1 ) THEN ltest = .FALSE. z_fill(jilev,ijlev) = z_fill(jilev,ijlev) + & & (z_in(ii,ij)*tmask(ii,ij))*zbt(ii,ij)*tmasklev(jilev,ijlev) d_n (jilev,ijlev) = d_n (jilev,ijlev) + & & tmask(ii,ij) *zbt(ii,ij)*tmasklev(jilev,ijlev) ierr = ierr + 1 ENDIF ij = ij - 1 END DO ! Next valid grid point going westward on ORCA grid ltest = .TRUE. ; ij = ijmin ; ii = iimin+1 ; IF ( ii > npiglo) ii = ii - npiglo DO WHILE ( ltest .AND. & & etobd(rlonlev(jilev,ijlev),rlatlev(jilev,ijlev),glamt(ii,ij), gphit(ii,ij)) <= zradius ) IF ( tmask(ii,ij) == 1 ) THEN ltest = .FALSE. z_fill(jilev,ijlev) = z_fill(jilev,ijlev) + & & (z_in(ii,ij)*tmask(ii,ij))*zbt(ii,ij)*tmasklev(jilev,ijlev) d_n (jilev,ijlev) = d_n (jilev,ijlev) + & & tmask(ii,ij) *zbt(ii,ij)*tmasklev(jilev,ijlev) ierr = ierr + 1 ENDIF ii = ii + 1 IF ( ii > npiglo ) ii = ii - npiglo END DO ! Next valid grid point going eastward on ORCA grid ltest = .TRUE. ; ij = ijmin ; ii = iimin-1 ; IF ( ii < 1 ) ii = ii + npiglo DO WHILE ( ltest .AND. & & etobd(rlonlev(jilev,ijlev),rlatlev(jilev,ijlev),glamt(ii,ij), gphit(ii,ij)) <= zradius ) IF ( tmask(ii,ij) == 1 ) THEN ltest = .FALSE. z_fill(jilev,ijlev) = z_fill(jilev,ijlev) + & & (z_in(ii,ij)*tmask(ji,ij))*zbt(ii,ij)*tmasklev(jilev,ijlev) d_n (jilev,ijlev) = d_n (jilev,ijlev) + & & tmask(ii,ij) *zbt(ii,ij)*tmasklev(jilev,ijlev) ierr = ierr + 1 ENDIF ii = ii - 1 ; IF ( ii < 1 ) ii = ii + npiglo END DO ! Going "northward" and crossing the pole ltest = .TRUE. rpos = 1. ij = ijmin + 1 * rpos ; ii = iimin IF ( ij > npjglo ) THEN ii = ii + npiglo/2 ; IF ( ii > npiglo ) ii = ii - npiglo rpos = -1. ij = ij + 1 * rpos ENDIF DO WHILE ( ij >= 1 .AND. ltest .AND. & & etobd(rlonlev(jilev,ijlev),rlatlev(jilev,ijlev),glamt(ii,ij), gphit(ii,ij)) <= zradius ) IF ( tmask(ii,ij) == 1 ) THEN ltest = .FALSE. z_fill(jilev,ijlev) = z_fill(jilev,ijlev) + & &(z_in(ii,ij)*tmask(ii,ij))*zbt(ii,ij)*tmasklev(jilev,ijlev) d_n (jilev,ijlev) = d_n (jilev,ijlev) + & & tmask(ii,ij) *zbt(ii,ij)*tmasklev(jilev,ijlev) ierr = ierr + 1 ENDIF ij = ij + 1 * rpos IF ( ij > npjglo ) THEN ii = ii + npiglo/2 ; IF ( ii > npiglo ) ii = ii - npiglo rpos = -1. ij = ij + 1 * rpos ENDIF END DO ! computing d_out value IF ( z_fill(jilev,ijlev) .NE. stypvarout(1)%rmissing_value & & .AND. d_n(jilev,ijlev) > 0 ) & & d_out(jilev,ijlev) = z_fill(jilev,ijlev) / d_n(jilev,ijlev) ENDIF ENDDO CASE DEFAULT PRINT *, ' METHOD ', imethod ,'is not recognized in this program' STOP END SELECT ! imethod IF ( ALLOCATED(z_fill) ) DEALLOCATE( z_fill ) ENDIF ! filling points ! ---------------------------------------------------------------------------------------- ! write ierr = putvar(ncout, id_varout(1), REAL(d_out(:,:)), 1, npilev, npjlev, ktime=jt) END DO ! loop on time ierr = closeout(ncout) CONTAINS REAL(KIND=4) FUNCTION etobd(plonr, platr, plon, plat) !!--------------------------------------------------------------------- !! *** FUNCTION etobd *** !! !! ** Purpose : !! Compute the beta plane distance between two lon/lat values !! !! ** Method : !! Return the distance (km) between 2 points given in the !! arguments with their latitudes and longitudes !!---------------------------------------------------------------------- REAL(KIND=4), INTENT(in) :: plonr, platr, plon, plat ! lon/lat of the 2 input points REAL(KIND=8), PARAMETER :: dp_p1 = 1.745329D-02 ! radians per degree REAL(KIND=8), PARAMETER :: dp_p2 = 111.1940D0 ! dp_p1 * earth radius in km (6370.949) REAL(KIND=8) :: dl_rx, dl_ry ! working double prec variables REAL(KIND=8) :: dl_r0 REAL(KIND=8) :: dl_r1, dl_r2 !!---------------------------------------------------------------------- dl_r0 = DBLE(plonr) ; IF ( dl_r0 < 0.d0 ) dl_r0 = dl_r0 + 360.d0 dl_r1 = DBLE(plon ) ; IF ( dl_r1 < 0.d0 ) dl_r1 = dl_r1 + 360.d0 dl_rx = dl_r1 - dl_r0 IF ( dl_rx > 180. ) THEN dl_rx = dl_rx - 360.d0 ELSE IF ( dl_rx < -180.d0 ) THEN dl_rx = dl_rx + 360.d0 ELSE IF ( ABS(dl_rx) == 180.d0 ) THEN dl_rx = 180.d0 ENDIF dl_r2 = DBLE(plat) - DBLE(platr) dl_rx = dp_p2 * dl_rx * COS(dp_p1*platr) dl_ry = dp_p2 * dl_r2 etobd = REAL(SQRT(dl_rx*dl_rx + dl_ry*dl_ry)) END FUNCTION etobd SUBROUTINE btoe(plonr, platr, plon, plat, plx, ply) !!--------------------------------------------------------------------- !! *** ROUTINE btoe *** !! !! ** Purpose : Return position (lon/lat) of a point located at !! a given distance from the original point !! !! ** Method : Trigo ... !! !!---------------------------------------------------------------------- REAL(KIND=4), INTENT(in) :: plonr, platr, plx, ply REAL(KIND=4), INTENT(out) :: plon, plat REAL(KIND=8), PARAMETER :: dp_p1= 1.745329D-02 ! radians per degree REAL(KIND=8), PARAMETER :: dp_p2= 111.1940D0 ! dp_p1 * earth radius in km (6370.949) REAL(KIND=8) :: dl_rx, dl_ry REAL(KIND=8) :: dl_r0 REAL(KIND=8) :: dl_r1, dl_r2, dl_r3 !!---------------------------------------------------------------------- dl_r0 = DBLE(plonr) ; IF ( dl_r0 < 0.d0 ) dl_r0 = dl_r0 + 360.d0 dl_rx = DBLE(plx ) dl_r2 = DBLE(platr) dl_r1 = dl_r0 + dl_rx / ( dp_p2 * COS(dp_p1*dl_r2) ) dl_r3 = dl_r2 + ply / dp_p2 plon = REAL(dl_r1) IF ( plon < 0. ) plon = plon + 360. IF ( plon >= 360. ) plon = plon - 360. plat = REAL(dl_r3) IF ( plat > 90. ) plat = 90. IF ( plat < -90. ) plat = -90. END SUBROUTINE btoe END PROGRAM cdf2levitusgrid2d cdftools-3.0/cdfmax.f900000644000175000017500000003265712241227304016117 0ustar amckinstryamckinstryPROGRAM cdfmax !!====================================================================== !! *** PROGRAM cdfmax *** !!===================================================================== !! ** Purpose : Find the min/max of a variable of an nc file. Give its !! location. A sub-area can be specified either horizontally !! and/or vertically. !! !! History : 2.1 : 11/2006 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jk, jvar, jt INTEGER(KIND=4) :: idep INTEGER(KIND=4) :: narg, iargc, ijarg INTEGER(KIND=4) :: ni, nj, nk, nt ! size of the global domain INTEGER(KIND=4) :: ndim ! dimension of the variables INTEGER(KIND=4) :: ntype ! type of slab (xy, xz, yz ...) INTEGER(KIND=4) :: ii1, ii2, ij1, ij2 ! index of min max INTEGER(KIND=4) :: niz, njz, nkz, nvars ! size of the domain INTEGER(KIND=4) :: iimin=1, iimax=0 ! i-limit of the domain INTEGER(KIND=4) :: ijmin=1, ijmax=0 ! j-limit of the domain INTEGER(KIND=4) :: ikmin=1, ikmax=0 ! k-limit of the domain INTEGER(KIND=4) :: itmin=1, itmax=0 ! t-limit of the domain INTEGER(KIND=4) :: istatus ! working integer INTEGER(KIND=4), DIMENSION(2) :: ilmin, ilmax ! working array for minloc, maxloc REAL(KIND=4) :: rfact=1.0 ! multiplying factor REAL(KIND=4) :: zspval ! missing value or spval REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: h ! depth REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, rlon, rlat ! data array, longitude, latitude CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cv_in='none' ! current variable name CHARACTER(LEN=256) :: cldum ! dummy char variable CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! list of variables in file TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! dummy dtructure to read var names LOGICAL :: lforcexy=.FALSE. ! flag for forced horizontal slab LOGICAL :: lflag=.FALSE. ! flag set when all data are missing !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmax -f file -var cdfvar ...' PRINT *,' ... [-lev kmin kmax ] [-zoom imin imax jmin jmax] ...' PRINT *,' ... [-time tmin tmax ] [-fact multfact] [-xy ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Find minimum and maximum of a file as well as their ' PRINT *,' respective location. Options allow to restrict the ' PRINT *,' finding to a sub area in time and space. This program' PRINT *,' also deal with vertical slabs in a domain.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' -f file : input file ' PRINT *,' -var cdfvar : input variable' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-lev kmin kmax ] : restrict to level between kmin and kmax. ' PRINT *,' [-zoom imin imax jmin jmax] : restrict to sub area specified' PRINT *,' by the given limits. If the zoomed area is ' PRINT *,' degenerated to a single line, then the vertical' PRINT *,' slab is considered as domain.' PRINT *,' [-time tmin tmax ] : restrict to the indicated time windows.' PRINT *,' [-fact multfact] : use a multiplicative factor for the output' PRINT *,' [-xy ] : force horizontal slab even in the case of a degenerated' PRINT *,' zoomed area.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' output is done on standard output.' STOP ENDIF ijarg=1 DO WHILE (ijarg <= narg) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE (cldum ) CASE ( '-f' ) CALL getarg(ijarg, cf_in) ; ijarg = ijarg + 1 CASE ( '-lev' ) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmin CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmax CASE ( '-fact' ) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rfact CASE ( '-zoom' ) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimin CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax CASE ( '-time' ) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itmin CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itmax CASE ( '-var' ) CALL getarg(ijarg, cv_in) ; ijarg = ijarg + 1 CASE ( '-xy' ) lforcexy = .TRUE. CASE DEFAULT PRINT *, cldum,' : unknown option ' STOP END SELECT END DO IF ( chkfile(cf_in) ) STOP ! missing file ni=0 ; nj=0; nk=0; nt=0 ni = getdim(cf_in, cn_x, cldum, istatus) IF ( istatus == 1 ) THEN ni = getdim(cf_in, 'lon', cldum, istatus) IF ( istatus == 1 ) THEN PRINT *,' No X or lon dim found ' ; STOP ENDIF ENDIF IF ( iimax == 0 ) iimax = ni nj = getdim(cf_in, cn_y, cldum, istatus) IF ( istatus == 1 ) THEN nj = getdim(cf_in, 'lat', cldum, istatus) IF ( istatus == 1 ) THEN PRINT *,' No y or lat dim found ' ; STOP ENDIF ENDIF IF ( ijmax == 0 ) ijmax = nj nk=getdim(cf_in, cn_z, cldum, istatus) IF ( istatus == 1 ) THEN nk = getdim(cf_in, 'z', cldum, istatus) IF ( istatus == 1 ) THEN nk = getdim(cf_in, 'lev', cldum, istatus) IF ( istatus == 1 ) THEN PRINT *,' No dep or z or lev dim found ' ENDIF ENDIF ENDIF IF ( ikmax == 0 ) ikmax = nk nt = getdim(cf_in, cn_t, cldum, istatus) IF ( istatus == 1 ) THEN nt = getdim(cf_in, 'step', cldum, istatus) IF ( istatus == 1 ) THEN PRINT *,' No time or step dim found ' ENDIF ENDIF ! fix the size of the zoomed area, or the whole domain if no zoom niz = iimax - iimin + 1 njz = ijmax - ijmin + 1 nkz = ikmax - ikmin + 1 IF (nt == 0 ) nt = 1 ! assume a 1 time frame file IF ( itmax == 0 ) itmax = nt ! allocate arrays ALLOCATE (h(nk), rlon(niz,njz), rlat(niz,njz)) ! Look for variable name starting with dep nvars = getnvar(cf_in) ALLOCATE (cv_names(nvars), stypvar(nvars)) cv_names = getvarname(cf_in,nvars,stypvar) DO jvar=1,nvars idep = INDEX(cv_names(jvar),'dep') + INDEX(cv_names(jvar),'lev') IF (idep /= 0 ) EXIT END DO IF ( jvar == nvars +1 ) THEN ! no depth variable found ... we initialize it to levels h = (/(ji,ji=1,nk)/) ELSE h = getvar1d(cf_in, cv_names(jvar), nk) ENDIF zspval = getatt(cf_in, cv_in, cn_missing_value) ! Allocate memory and define ntype : (1) = horizontal i-j slab eventually many layers. ! (2) = vertical j-k slab, at a given i ! (3) = vertical i-k slab, at a given j IF ( (niz /= 1 .AND. njz /= 1 ) .OR. lforcexy ) THEN ALLOCATE (v2d(niz,njz) ) ntype = 1 ! horizontal x-y slabs ELSE IF ( niz == 1 ) THEN ALLOCATE (v2d(njz,nkz)) ntype = 2 ! vertical y-z slab ELSE ALLOCATE(v2d(niz,nkz)) ntype = 3 ! vertical x-z slab ENDIF ENDIF ! read latitude, longitude from the header rlon = getvar(cf_in, cn_vlon2d, 1, niz, njz, iimin, ijmin) rlat = getvar(cf_in, cn_vlat2d, 1, niz, njz, iimin, ijmin) DO ndim = getvdim(cf_in, cv_in) + 1 ! getvdim gives ndim-1 ! PRINT *,TRIM(cv_in),' with multiplying factor of ', rfact ! ndim <=3 corresponds to purely 2D variables (x,y) or (x,y,t) IF ( ndim <= 3 ) THEN ikmin = 1 ; ikmax = 1 ; nkz = 1 ENDIF SELECT CASE (ntype) CASE (1) SELECT CASE (ndim) CASE( 2,3,4 ) ! assume x,y,z,t variable PRINT 9000,'time level dep MAX: i long j lat MaxValue MIN: i long j lat MinValue' DO jt=itmin, itmax DO jk=ikmin,ikmax v2d(:,:) = getvar(cf_in, cv_in, jk, niz, njz, kimin=iimin, kjmin=ijmin, ktime=jt) ilmax = MAXLOC(v2d,(v2d /= zspval) ) ilmin = MINLOC(v2d,(v2d /= zspval) ) ii1=ilmax(1) ; ij1=ilmax(2) ii2=ilmin(1) ; ij2=ilmin(2) lflag = lchkflag() PRINT 9003, jt, jk, h(jk),ii1+iimin -1, rlon(ii1,ij1),ij1+ijmin -1,rlat(ii1,ij1),v2d(ii1,ij1)*rfact, & & ii2+iimin -1, rlon(ii2,ij2),ij2+ijmin -1,rlat(ii2,ij2),v2d(ii2,ij2)*rfact END DO END DO EXIT CASE DEFAULT PRINT *,' Non mapable variables x-y :(' cv_in='none' END SELECT CASE (2) SELECT CASE (ndim) CASE( 4 ) ! assume x,y,z,t variable PRINT 9000,' time i-slab MAX: i long j lat k dep MaxValue MIN: i & & long j lat k dep MinValue' DO jt=itmin, itmax v2d(:,:) = getvaryz(cf_in, cv_in, iimin, njz, nkz, ijmin, ikmin, ktime=jt) ilmax = MAXLOC(v2d,(v2d/= zspval) ) ilmin = MINLOC(v2d,(v2d/= zspval) ) ii1=ilmax(1) ; ij1=ilmax(2) ii2=ilmin(1) ; ij2=ilmin(2) lflag = lchkflag() PRINT 9002, jt, iimin, iimin, rlon(1,ii1),ii1+ijmin -1,rlat(1,ii1),ij1+ikmin-1, h(ij1+ikmin-1), v2d(ii1,ij1)*rfact, & & iimin, rlon(1,ii2),ii2+ijmin -1,rlat(1,ii2),ij2+ikmin-1, h(ij2+ikmin-1), v2d(ii2,ij2)*rfact END DO EXIT CASE DEFAULT PRINT *,' Non mapable variables x-z or y-z :(' cv_in='none' END SELECT CASE (3) SELECT CASE (ndim) CASE( 4 ) ! assume x,y,z,t variable PRINT 9000,' time j-slab MAX: i long j lat k dep MaxValue MIN: i & & long j lat k dep MinValue' DO jt=itmin, itmax v2d(:,:) = getvarxz(cf_in, cv_in, ijmin, niz, nkz, iimin, ikmin, ktime=jt) ilmax = MAXLOC(v2d,(v2d /= zspval) ) ilmin = MINLOC(v2d,(v2d /= zspval) ) ii1=ilmax(1) ; ij1=ilmax(2) ii2=ilmin(1) ; ij2=ilmin(2) lflag = lchkflag() PRINT 9002, jt, ijmin, ii1, rlon(ii1,1),ijmin,rlat(ii1,1),ij1+ikmin-1, h(ij1+ikmin-1), v2d(ii1,ij1)*rfact, & & ii2, rlon(ii2,1),ijmin,rlat(ii2,1),ij2+ikmin-1, h(ij2+ikmin-1), v2d(ii2,ij2)*rfact END DO EXIT CASE DEFAULT PRINT *,' Non mapable variables x-z or y-z :(' cv_in='none' END SELECT CASE DEFAULT PRINT *,' ntype = ',ntype, ' is not defined ' ; STOP END SELECT ! ntype ENDDO 9000 FORMAT(a) 9002 FORMAT(I5, x,i4,9x, i5,f8.2, i5, f7.2, i5, f8.2, e14.5, 6x, i5,f8.2, i5, f7.2, i5, f8.2, e14.5 ) 9003 FORMAT(I5, x,i5,1x,f7.2,5x,i5,f8.2, i5, f7.2, e14.5, 5x,i5,f8.2, i5, f7.2, e14.5) CONTAINS LOGICAL FUNCTION lchkflag() !!--------------------------------------------------------------------- !! *** FUNCTION lchkflag *** !! !! ** Purpose : Set flag to true when all data are missing. !! !! ** Method : When all data are missing, MAXLOC or MINLOC return 0 index !! which cannot be used in v2d, or any other array. !! In this case, faulty indices are set to 1,1 and 1,2 and !! corresponding v2d is set to a flag value 999999999.999 !! REM: the return value is T or F, btw not used in the code. !!---------------------------------------------------------------------- lflag=.false. IF ( ii1 == 0 ) THEN ; ii1=1 ; lflag=.true. ; ENDIF IF ( ii2 == 0 ) THEN ; ii2=1 ; lflag=.true. ; ENDIF IF ( ij1 == 0 ) THEN ; ij1=1 ; lflag=.true. ; ENDIF IF ( ij2 == 0 ) THEN ; ij2=2 ; lflag=.true. ; ENDIF IF ( lflag ) v2d(ii1,ij1)=-999999999.999 IF ( lflag ) v2d(ii2,ij2)=+999999999.999 lchkflag = lflag END FUNCTION lchkflag END PROGRAM cdfmax cdftools-3.0/cdfvita-geo.f900000644000175000017500000002544212241227304017037 0ustar amckinstryamckinstryPROGRAM cdfvita_geo !!====================================================================== !! *** PROGRAM cdfvita_geo *** !!===================================================================== !! ** Purpose : Compute velocity on t grid !! !! ** Method : Read velocity component on input gridU and gridV file !! Use gridT file for the proper location of T points !! The velocity module is also output (same function than !! cdfspeed) If a gridW file is given, (fifth argument) !! then w is also computed on the T grid !! !! History : 2.1 : 11/2006 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt, jlev ! dummy loop index INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nlev, ik ! number of selected levels, current lev INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr ! error status for cdfio INTEGER(KIND=4) :: nvar ! number of variable INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nklev ! selected levels INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! output stuff REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter array REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdeptall, gdept ! depths and selected depths REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: uc, vc ! velocity component on C grid REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ua, va, vmod ! velocity component on A grid TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! data attributes CHARACTER(LEN=256) :: cf_ufil, cf_vfil ! velocity files on C grid CHARACTER(LEN=256) :: cf_wfil ! optional W file on C grid CHARACTER(LEN=256) :: cf_tfil ! GridT file for T position CHARACTER(LEN=256) :: cf_out='vita.nc' ! output file name CHARACTER(LEN=256) :: cldum ! dummy char variable LOGICAL :: lvertical = .FALSE. ! vertical velocity flag LOGICAL :: lperio = .FALSE. ! E_W periodicity flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfvita-geo Ugeo-file Vgeo_file T-file [-w W-file] [-lev level_list]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Create a file with velocity components and module computed' PRINT *,' at T points from file on C-grid. T-file is used only for' PRINT *,' getting the header of the output file. Any file on T grid' PRINT *,' can be used.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' Ugeo-file : netcdf file with zonal component of velocity' PRINT *,' Vgeo-file : netcdf file with meridional component of velocity' PRINT *,' T-file : netcdf file with T points header OK.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -w W-file ] : if used, also compute vertical velocities at' PRINT *,' T points.' PRINT *,' [ -lev level_list] : specify a list of level to be used ' PRINT *,' (default option is to use all input levels).' PRINT *,' This option MUST be the last on the command line !!' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : sovitua, sovitva, sovitmod, [sovitwa]' STOP ENDIF nlev = 0 ijarg=1 DO WHILE ( ijarg <= narg ) CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE ( '-lev' ) nlev= narg - ijarg + 1 ALLOCATE (nklev(nlev) ) DO jlev = 1, nlev CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,* ) nklev(jlev) ENDDO CASE ( '-w' ) CALL getarg( ijarg, cf_wfil ) ; ijarg=ijarg+1 lvertical=.TRUE. CASE DEFAULT cf_ufil=cldum CALL getarg( ijarg, cf_vfil ) ; ijarg=ijarg+1 CALL getarg( ijarg, cf_tfil ) ; ijarg=ijarg+1 END SELECT ENDDO ! adjust number of variable according to -w option nvar=3 IF ( lvertical ) nvar = 4 ALLOCATE ( ipk(nvar), id_varout(nvar), stypvar(nvar) ) IF ( chkfile(cf_ufil) .OR. chkfile(cf_vfil) .OR. chkfile(cf_tfil) ) STOP ! missing file IF ( lvertical ) THEN IF ( chkfile(cf_wfil) ) STOP ! missing file ENDIF npiglo = getdim (cf_ufil,cn_x) npjglo = getdim (cf_ufil,cn_y) npk = getdim (cf_ufil,cn_z) npt = getdim (cf_ufil,cn_t) IF ( npk == 0 ) THEN ; npk = 1 ; ENDIF IF ( nlev == 0 ) THEN ! take all levels nlev = npk ALLOCATE (nklev(nlev) ) DO jlev = 1, nlev nklev(jlev) = jlev ENDDO ENDIF ALLOCATE ( gdept(nlev) ) ! Zonal Velocity T point ipk(1) = nlev stypvar(1)%cname = 'sovitua' stypvar(1)%cunits = 'm/s' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 10000. stypvar(1)%clong_name = 'Zonal Velocity T point' stypvar(1)%cshort_name = 'sovitua' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' ! Meridional Velocity T point ipk(2) = nlev stypvar(2)%cname = 'sovitva' stypvar(2)%cunits = 'm/s' stypvar(2)%rmissing_value = 0. stypvar(2)%valid_min = 0. stypvar(2)%valid_max = 10000. stypvar(2)%clong_name = 'Meridional Velocity T point' stypvar(2)%cshort_name = 'sovitva' stypvar(2)%conline_operation = 'N/A' stypvar(2)%caxis = 'TZYX' ! Velocity module T point ipk(3) = nlev stypvar(3)%cname = 'sovitmod' stypvar(3)%cunits = 'm/s' stypvar(3)%rmissing_value = 0. stypvar(3)%valid_min = 0. stypvar(3)%valid_max = 10000. stypvar(3)%clong_name = 'Velocity module T point' stypvar(3)%cshort_name = 'sovitmod' stypvar(3)%conline_operation = 'N/A' stypvar(3)%caxis = 'TZYX' IF ( lvertical ) THEN ! Vertical Velocity at T point ipk(nvar) = nlev stypvar(nvar)%cname = 'sovitwa' stypvar(nvar)%cunits = 'mm/s' stypvar(nvar)%rmissing_value = 0. stypvar(nvar)%valid_min = 0. stypvar(nvar)%valid_max = 10000. stypvar(nvar)%clong_name = 'Vertical Velocity at T point' stypvar(nvar)%cshort_name = 'sovitwa' stypvar(nvar)%conline_operation = 'N/A' stypvar(nvar)%caxis = 'TZYX' ENDIF PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt PRINT *, 'nlev =', nlev ALLOCATE( uc(npiglo,npjglo), vc(npiglo,npjglo) ) ALLOCATE( ua(npiglo,npjglo), va(npiglo,npjglo), vmod(npiglo,npjglo) ) ALLOCATE( tim(npt), gdeptall(npk) ) gdeptall(:) = getvar1d(cf_tfil,cn_vdeptht, npk) DO jlev = 1, nlev ik = nklev(jlev) gdept(jlev) = gdeptall(ik) ENDDO ! check E-W periodicity using uc array as working space uc(:,:) = getvar(cf_tfil, cn_vlon2d, 1, npiglo, npjglo ) IF ( uc(1,1) == uc(npiglo-1,1) ) THEN lperio = .TRUE. PRINT *,' E-W periodicity detected.' ENDIF ncout = create (cf_out, cf_tfil, npiglo, npjglo, nlev ) ierr = createvar (ncout , stypvar, nvar, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, nlev, pdep=gdept ) DO jt = 1, npt DO jlev = 1, nlev ik = nklev(jlev) uc(:,:) = getvar(cf_ufil, cn_vozocrtx, ik ,npiglo, npjglo, ktime=jt ) vc(:,:) = getvar(cf_vfil, cn_vomecrty, ik ,npiglo, npjglo, ktime=jt ) ua = 0. ; va = 0. ; ua(:,:) = 0. ; va(:,:)=0. ; vmod(:,:)=0. DO ji=2, npiglo DO jj=2,npjglo ua(ji,jj) = 0.5* (uc(ji,jj )+ uc(ji,jj-1)) va(ji,jj) = 0.5* (vc(ji-1,jj)+ vc(ji,jj )) vmod(ji,jj) = SQRT( ua(ji,jj)*ua(ji,jj) + va(ji,jj)*va(ji,jj) ) END DO END DO IF ( lperio) THEN ! periodic E-W boundary ... ua (1,:) = ua (npiglo-1,:) va (1,:) = va (npiglo-1,:) vmod(1,:) = vmod(npiglo-1,:) ENDIF ierr=putvar(ncout, id_varout(1), ua, jlev ,npiglo, npjglo, ktime=jt ) ierr=putvar(ncout, id_varout(2), va, jlev ,npiglo, npjglo, ktime=jt ) ierr=putvar(ncout, id_varout(3), vmod, jlev ,npiglo, npjglo, ktime=jt ) END DO END DO IF ( lvertical ) THEN ! reuse uc an vc arrays to store Wk and Wk+1 DO jt = 1, npt DO jlev=1, nlev - 1 uc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(jlev), npiglo, npjglo, ktime=jt ) vc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(jlev)+1, npiglo, npjglo, ktime=jt ) ua(:,:) = 0.5*(uc(:,:) + vc(:,:))*1000. ! mm/sec ierr = putvar(ncout, id_varout(4), ua, jlev, npiglo, npjglo, ktime=jt ) uc(:,:) = vc(:,:) END DO IF ( nlev == npk ) THEN ua(:,:) = 0.e0 ! npk ELSE uc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(nlev), npiglo, npjglo, ktime=jt ) vc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(nlev)+1, npiglo, npjglo, ktime=jt ) ua(:,:) = 0.5*(uc(:,:) + vc(:,:))*1000. ! mm/sec ENDIF ierr = putvar(ncout, id_varout(4), ua, nlev ,npiglo, npjglo, ktime=jt ) ENDDO ENDIF tim = getvar1d(cf_ufil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdfvita_geo cdftools-3.0/cdftools-end.pod0000644000175000017500000000331212241227304017404 0ustar amckinstryamckinstry =head1 AUTHORS Written by Jean-Marc Molines, Grenoble - France Contributors : F. Castruccio, C. Dufour, R. Dussin, M. Juza, A. Lecointre, P. Mathiot, A. Melet., A.M. Treguier =head1 LICENSE AND COPYRIGHT Copyright (C) 1998-2012 LEGI / Team MEOM / CNRS UMR 5518 - Grenoble - France, Jean-Marc.Molines@legi.grenoble-inp.fr This software is governed by the CeCILL license under French law and abiding by the rules of distribution of free software. You can use, modify and/ or redistribute the software under the terms of the CeCILL license as circulated by CEA, CNRS and INRIA at the following URL "http://www.cecill.info". As a counterpart to the access to the source code and rights to copy, modify and redistribute granted by the license, users are provided only with a limited warranty and the software's author, the holder of the economic rights, and the successive licensors have only limited liability. In this respect, the user's attention is drawn to the risks associated with loading, using, modifying and/or developing or reproducing the software by the user in light of its specific status of free software, that may mean that it is complicated to manipulate, and that also therefore means that it is reserved for developers and experienced professionals having in-depth computer knowledge. Users are therefore encouraged to load and test the software's suitability as regards their requirements in conditions enabling the security of their systems and/or data to be ensured and, more generally, to use and operate it in the same conditions as regards security. The fact that you are presently reading this means that you have had knowledge of the CeCILL license and that you accept its terms. cdftools-3.0/cdfhdy.f900000644000175000017500000001661012241227304016105 0ustar amckinstryamckinstryPROGRAM cdfhdy !!====================================================================== !! *** PROGRAM cdfhdy *** !!===================================================================== !! ** Purpose : Compute dynamical height anomaly field from gridT file !! Store the results on a 2D cdf file. !! !! ** Method : the integral of (1/g) *10e4 * sum [ delta * dz ] !! with delta = (1/rho - 1/rho0) !! 10e4 factor is conversion decibar/pascal !! !! History : 2.1 : 05/2010 : R. Dussin : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos, ONLY : sigmai USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! browse arguments INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! " " INTEGER(KIND=4) :: nlev1, nlev2 ! limit of vertical integration INTEGER(KIND=4) :: ncout ! ncid of output fileset INTEGER(KIND=4), DIMENSION(1) :: ipk ! outptut variables : number of levels, INTEGER(KIND=4), DIMENSION(1) :: id_varout ! ncdf varid's REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp, sal ! Temperature and salinity at current level REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp0, sal0 ! reference temperature and salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! 2D mask at current level REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdep, rdepth ! depth at current level including SSH REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ssh ! Sea Surface Heigh REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim, e3t_1d ! time counter, vertical level spacing REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dhdy, dterm ! dynamic height, working array REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsig0, dsig ! In situ density (reference, local) REAL(KIND=8) :: drau0 = 1000.d0 ! density of fresh water REAL(KIND=8) :: dgrav = 9.81d0 ! gravity CHARACTER(LEN=256) :: cf_tfil ! input file name CHARACTER(LEN=256) :: cf_out='cdfhdy.nc' ! output file name CHARACTER(LEN=256) :: cldum ! dummy string TYPE(variable) , DIMENSION(1) :: stypvar ! structure for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg <= 3 ) THEN PRINT *,' usage : cdfhdy T-file level1 level2' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute dynamical height anomaly field from gridT file.' PRINT *,' It is computed as the integral of (1/g) *10e4 * sum [ delta * dz ]' PRINT *,' where delta = (1/rho - 1/rho0)' PRINT *,' 10e4 factor is for the conversion decibar to pascal.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with temperature and salinity' PRINT *,' level1 : upper limit for vertical integration (usually 1 = surface)' PRINT *,' level2 : lower limit for vertical integration.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fmsk),' and ', TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : sohdy (m)' STOP ENDIF CALL getarg (1, cf_tfil ) CALL getarg (2, cldum ) ; READ(cldum,*) nlev1 CALL getarg (3, cldum ) ; READ(cldum,*) nlev2 IF ( chkfile (cf_tfil) .OR. chkfile(cn_fmsk) .OR. chkfile(cn_fzgr) ) STOP ! missing file npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) ipk(:) = 1 stypvar(1)%cname= 'sohdy' stypvar(1)%cunits='m' stypvar(1)%rmissing_value=0. stypvar(1)%valid_min= -100. stypvar(1)%valid_max= 100. stypvar(1)%clong_name='Dynamical height anomaly' stypvar(1)%cshort_name='sohdy' stypvar(1)%conline_operation='N/A' stypvar(1)%caxis='TYX' PRINT *, 'npiglo=', npiglo PRINT *, 'npjglo=', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt ALLOCATE (temp0(npiglo,npjglo), sal0(npiglo,npjglo), dsig0(npiglo,npjglo) ,tmask(npiglo,npjglo)) ALLOCATE (temp(npiglo,npjglo), sal(npiglo,npjglo), dsig(npiglo,npjglo) , dhdy(npiglo,npjglo), dterm(npiglo,npjglo)) ALLOCATE (rdep(npiglo,npjglo), rdepth(npiglo,npjglo), ssh(npiglo,npjglo), e3t_1d(npk)) ALLOCATE (tim(npt)) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ! Temperature and salinity for reference profile temp0(:,:) = 0. sal0(:,:) = 35. tmask(:,:) = getvar(cn_fmsk, 'tmask', nlev2, npiglo, npjglo) ssh(:,:) = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo) e3t_1d(:) = getvare3(cn_fzgr, cn_ve3t, npk) DO jt=1,npt PRINT *,' TIME = ', jt, tim(jt)/86400.,' days' dhdy(:,:) = 0. rdepth(:,:) = 0. DO jk = nlev1, nlev2 !rdep(:,:) = getvar(cn_fzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.true.) ! we degrade the computation to smooth the results rdep(:,:) = e3t_1d(jk) IF ( jk == 1 ) THEN rdep(:,:) = rdep(:,:) + ssh(:,:) ENDIF ! depth at current level, including ssh (used for computation of rho in situ) rdepth(:,:) = rdepth(:,:) + rdep(:,:) temp(:,:)= getvar(cf_tfil, cn_votemper, jk ,npiglo, npjglo, ktime=jt) sal(:,:) = getvar(cf_tfil, cn_vosaline, jk ,npiglo, npjglo, ktime=jt) dsig0 = sigmai(temp0, sal0, rdepth, npiglo, npjglo) dsig = sigmai(temp , sal , rdepth, npiglo, npjglo) ! we compute the term of the integral : (1/g) *10e4 * sum [ delta * dz ] ! with delta = (1/rho - 1/rho0) ! 10e4 factor is conversion decibar/pascal ! dterm = ( ( 1.d0 / ( drau0 + dsig(:,:) ) ) - ( 1.d0 / ( drau0 + dsig0(:,:) ) ) ) * 10000.d0 * rdep / dgrav ! in land, it seems appropriate to stop the computation WHERE(sal == 0 ) dterm = 0 dhdy(:,:) = dhdy(:,:) + dterm(:,:) END DO ! loop to next level ! we mask with the last level of the integral dhdy(:,:) = dhdy(:,:) * tmask(:,:) ierr = putvar(ncout, id_varout(1) ,REAL(dhdy), 1, npiglo, npjglo, ktime=jt) END DO ! next time frame ierr = closeout(ncout) END PROGRAM cdfhdy cdftools-3.0/cdfsections.f900000644000175000017500000012173312241227304017153 0ustar amckinstryamckinstryprogram cdfsections !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! *** PROGRAM cdfsections *** ! ! ** Purpose : extract oceanic fields along a track made of several sections. ! ! ** Method : computes N sections by taking the nearest point north of 60°N ! and near undefined values (bottom or coasts), and interpolates ! between the four nearest points elsewhere. ! ! ** Outputs : temperature, salinity, density, current (normal/tangeantial) ! - normal current is positive northward (westward if meridional section) ! - tangeantial current is on the right of the normal current. ! ! NB : it is recommended to put a lot of points on each section if the aim is ! to compute X-integrations. ! ! WARNING : ! - require large memory : reduce domain size with ncks if insufficient memory error. ! - does not work if the section crosses the Greenwich line (easy to modify if needed). ! - not yet tested north of 60°N (but should work) ... ! ! history : ! N. JOURDAIN (LEGI-MEOM), April 2009 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! $Rev$ !! $Date$ !! $Id$ !!-------------------------------------------------------------- USE netcdf USE eos IMPLICIT NONE !--- Local variables INTEGER :: narg, iargc !--- grid_T INTEGER :: fidT, status, dimID_time_counter, dimID_deptht, dimID_y, dimID_x, & & mtime_counter, mdeptht, my, mx, vosaline_ID, votemper_ID, time_counter_ID, & & deptht_ID, nav_lat_ID, nav_lon_ID, fidM, dimID_s, X_ID, sig0_ID, sig1_ID, & & sig2_ID, sig4_ID !--- grid_U INTEGER :: fidU, dimID_depthu, mdepthu, mxu, vozocrtx_ID !--- grid_V INTEGER :: fidV, dimID_depthv, mdepthv, myu, vomecrty_ID CHARACTER(LEN=256) :: file_in_T, file_out, file_in_U, file_in_V, cdum REAL*4 :: RT, dtmp_T, dtmp_U, dtmp_V, miniT, miniU, miniV, rr, ang, pi,& & latinf, latsup, loninf, lonsup, a, b, c, e, missing, lonref, latref REAL*8 :: offset INTEGER :: N1, N2, i, j, k, s, p, iiT, jjT, Nsec, Ntot,Unorm_ID, Utang_ID, cont,& & l, iiU, jjU, iiV, jjV, iinf, isup, jinf, jsup INTEGER,ALLOCATABLE,DIMENSION(:) :: N REAL*4,ALLOCATABLE,DIMENSION(:) :: lat, lon LOGICAL,ALLOCATABLE,DIMENSION(:) :: undefined !---- grid_T REAL*4,ALLOCATABLE,DIMENSION(:,:,:,:) :: vosaline, votemper, sig0, sig1, sig2, sig4 REAL*4,ALLOCATABLE,DIMENSION(:,:,:) :: somxl010, somxlt02, vosaline_sec, votemper_sec REAL*4,ALLOCATABLE,DIMENSION(:,:) :: nav_lat_T, nav_lon_T, somxl010_sec, somxlt02_sec REAL*4,ALLOCATABLE,DIMENSION(:) :: time_counter, deptht !---- grid_U REAL*4,ALLOCATABLE,DIMENSION(:,:,:,:) :: vozocrtx REAL*4,ALLOCATABLE,DIMENSION(:,:,:) :: vozocrtx_sec REAL*4,ALLOCATABLE,DIMENSION(:,:) :: nav_lat_U, nav_lon_U !---- grid_V REAL*4,ALLOCATABLE,DIMENSION(:,:,:,:) :: vomecrty REAL*4,ALLOCATABLE,DIMENSION(:,:,:) :: vomecrty_sec REAL*4,ALLOCATABLE,DIMENSION(:,:) :: nav_lat_V, nav_lon_V !---- grid section REAL*4,ALLOCATABLE,DIMENSION(:,:,:) :: Unorm, Utang, sigsec0, sigsec1, sigsec2, sigsec4 REAL*4,ALLOCATABLE,DIMENSION(:) :: lonsec, latsec REAL*8,ALLOCATABLE,DIMENSION(:) :: d, X1 !------------------------------------------------------------------------- ! GETTING ARGUMENTS : !- Read command line and output usage message if not compliant. narg= iargc() IF ( narg.lt.10 ) THEN PRINT *,'Usage : ' PRINT *,' cdfsections Ufile Vfile Tfile larf lorf Nsec lat1 lon1 lat2 lon2 n1' PRINT *,' [ lat3 lon3 n2 ] [ lat4 lon4 n3 ] ....' PRINT *,' ' PRINT *,' Computes temperature, salinity, sig0, sig1, sig2, sig4, Uorth, Utang ' PRINT *,' along a section made of Nsec linear segments (see output attributes).' PRINT *,' Output is section.nc, var. as a function of X(km), depth(m) and time.' PRINT *,' ' PRINT *,'Arguments : ' PRINT *,' # larf and lorf -> location of X=0 for the X-absice (may be out of section)' PRINT *,' # Nsec -> number of segments used to compute the whole section.' PRINT *,' # lat1,lat2,lat3,... -> extrema latitudes of the segments (from -90 to 90)' PRINT *,' # lon1,lon2,lon3,... -> extrema latitudes of the segments (from 0 to 360)' PRINT *,' # n1, n2, ... -> number of output points on each segment.' PRINT *,' (you have to give Nsec+1 values of lati/loni and Nsec values of ni)' PRINT *,' ' PRINT *,' It is recommended to put a lot of points on each section if the aim' PRINT *,' is to compute X-integrations along the section (10 x the model resolution).' PRINT *,'NB : sections cannot cross the Greenwich line !!' PRINT *,'NB : Not yet tested north of 60°N.' PRINT *,'NB : require a large amount of memory !' PRINT *,' -> reduce domain size with ncks -d if insufficient memory error.' PRINT *,' ' PRINT *,'Example for one linear section : ' PRINT *,' cdfsections U.nc V.nc T.nc 48.0 305.0 1 49.0 307.0 50.5 337.5 20' PRINT *,'Example for a section made of 2 linear segments : ' PRINT *,' cdfsections U.nc V.nc T.nc 48.0 305.0 2 49.0 307.0 50.5 337.5 20 40.3 305.1 50' STOP ENDIF CALL getarg (1, file_in_U ) CALL getarg (2, file_in_V ) CALL getarg (3, file_in_T ) CALL getarg (4, cdum ); READ(cdum,*) latref CALL getarg (5, cdum ); READ(cdum,*) lonref CALL getarg (6, cdum ); READ(cdum,*) Nsec if ( narg.ne.8+Nsec*3) then PRINT *, '**!/# ERROR : wrong number of arguments in cdfsections' PRINT *, 'Usage : ' PRINT *, ' cdfsections Ufile Vfile Tfile larf lorf Nsec lat1 lon1 lat2 lon2 n1 ....' PRINT *, '-> please execute cdfsections without any arguments for more details.' STOP endif ALLOCATE( lat(Nsec+1), lon(Nsec+1) ) ALLOCATE( N(Nsec), d(Nsec) ) CALL getarg (7, cdum ); READ(cdum,*) lat(1) CALL getarg (8, cdum ); READ(cdum,*) lon(1) do i=1,(narg-8),3 CALL getarg (i+8, cdum ); READ(cdum,*) lat(i/3+2) CALL getarg (i+9, cdum ); READ(cdum,*) lon(i/3+2) CALL getarg (i+10, cdum ); READ(cdum,*) N(i/3+1) enddo do i=1,Nsec+1 if ( (lon(i).lt.0.0).or.(lonref.lt.0.0) ) then PRINT *, '**!/# ERROR : longitudes must be between 0 and 360' STOP endif enddo file_out = 'section.nc' !---- Rayon terrestre en km : RT = 6378 pi = 3.1415927 rr = pi / 180.0 !--------------------------------------- ! Read netcdf input file for grid T : write(*,*) TRIM(file_in_T) status = NF90_OPEN(TRIM(file_in_T),0,fidT) call erreur(status,.TRUE.,"read") !Lecture des ID des dimensions qui nous interessent status = NF90_INQ_DIMID(fidT,"time_counter",dimID_time_counter) call erreur(status,.TRUE.,"inq_dimID_time_counter") status = NF90_INQ_DIMID(fidT,"deptht",dimID_deptht) call erreur(status,.TRUE.,"inq_dimID_deptht") status = NF90_INQ_DIMID(fidT,"y",dimID_y) call erreur(status,.TRUE.,"inq_dimID_y") status = NF90_INQ_DIMID(fidT,"x",dimID_x) call erreur(status,.TRUE.,"inq_dimID_x") !Lecture des valeurs des dimensions qui nous interessent status = NF90_INQUIRE_DIMENSION(fidT,dimID_time_counter,len=mtime_counter) call erreur(status,.TRUE.,"inq_dim_time_counter") status = NF90_INQUIRE_DIMENSION(fidT,dimID_deptht,len=mdeptht) call erreur(status,.TRUE.,"inq_dim_deptht") status = NF90_INQUIRE_DIMENSION(fidT,dimID_y,len=my) call erreur(status,.TRUE.,"inq_dim_y") status = NF90_INQUIRE_DIMENSION(fidT,dimID_x,len=mx) call erreur(status,.TRUE.,"inq_dim_x") write(*,101) mx, my, mdeptht, mtime_counter 101 FORMAT(' -> dimensions of arrays : (',3(i4,','),i4,')') !Allocation of arrays : ALLOCATE( vosaline(mx,my,mdeptht,mtime_counter) ) ALLOCATE( votemper(mx,my,mdeptht,mtime_counter) ) ALLOCATE( time_counter(mtime_counter) ) ALLOCATE( deptht(mdeptht) ) ALLOCATE( nav_lat_T(mx,my) ) ALLOCATE( nav_lon_T(mx,my) ) ALLOCATE( undefined(mdeptht) ) !Lecture des ID des variables qui nous interessent status = NF90_INQ_VARID(fidT,"vosaline",vosaline_ID) call erreur(status,.TRUE.,"inq_vosaline_ID") status = NF90_INQ_VARID(fidT,"votemper",votemper_ID) call erreur(status,.TRUE.,"inq_votemper_ID") status = NF90_INQ_VARID(fidT,"time_counter",time_counter_ID) call erreur(status,.TRUE.,"inq_time_counter_ID") status = NF90_INQ_VARID(fidT,"deptht",deptht_ID) call erreur(status,.TRUE.,"inq_deptht_ID") status = NF90_INQ_VARID(fidT,"nav_lat",nav_lat_ID) call erreur(status,.TRUE.,"inq_nav_lat_ID") status = NF90_INQ_VARID(fidT,"nav_lon",nav_lon_ID) call erreur(status,.TRUE.,"inq_nav_lon_ID") !Lecture des valeurs des variables qui nous interessent status = NF90_GET_VAR(fidT,vosaline_ID,vosaline) call erreur(status,.TRUE.,"getvar_vosaline") status = NF90_GET_VAR(fidT,votemper_ID,votemper) call erreur(status,.TRUE.,"getvar_votemper") status = NF90_GET_VAR(fidT,time_counter_ID,time_counter) call erreur(status,.TRUE.,"getvar_time_counter") status = NF90_GET_VAR(fidT,deptht_ID,deptht) call erreur(status,.TRUE.,"getvar_deptht") status = NF90_GET_VAR(fidT,nav_lat_ID,nav_lat_T) call erreur(status,.TRUE.,"getvar_nav_lat") status = NF90_GET_VAR(fidT,nav_lon_ID,nav_lon_T) call erreur(status,.TRUE.,"getvar_nav_lon") !extract missing value for vosaline : status = NF90_GET_ATT(fidT,vosaline_ID,"missing_value",missing) call erreur(status,.TRUE.,"get_att_vosaline") !Fermeture du fichier lu status = NF90_CLOSE(fidT) call erreur(status,.TRUE.,"fin_lecture") !--------------------------------------- ! Read netcdf input file for grid U : write(*,*) TRIM(file_in_U) status = NF90_OPEN(TRIM(file_in_U),0,fidU) call erreur(status,.TRUE.,"read") !Lecture des ID des dimensions qui nous interessent status = NF90_INQ_DIMID(fidU,"time_counter",dimID_time_counter) call erreur(status,.TRUE.,"inq_dimID_time_counter") status = NF90_INQ_DIMID(fidU,"depthu",dimID_depthu) call erreur(status,.TRUE.,"inq_dimID_depthu") status = NF90_INQ_DIMID(fidU,"y",dimID_y) call erreur(status,.TRUE.,"inq_dimID_y") status = NF90_INQ_DIMID(fidU,"x",dimID_x) call erreur(status,.TRUE.,"inq_dimID_x") !Lecture des valeurs des dimensions qui nous interessent status = NF90_INQUIRE_DIMENSION(fidU,dimID_depthu,len=mdepthu) call erreur(status,.TRUE.,"inq_dim_depthu") status = NF90_INQUIRE_DIMENSION(fidU,dimID_x,len=mxu) call erreur(status,.TRUE.,"inq_dim_x") write(*,101) mxu, my, mdepthu, mtime_counter !Allocation of arrays : ALLOCATE( vozocrtx(mxu,my,mdepthu,mtime_counter) ) ALLOCATE( nav_lat_U(mxu,my) ) ALLOCATE( nav_lon_U(mxu,my) ) !Lecture des ID des variables qui nous interessent status = NF90_INQ_VARID(fidU,"vozocrtx",vozocrtx_ID) call erreur(status,.TRUE.,"inq_vozocrtx_ID") status = NF90_INQ_VARID(fidU,"nav_lat",nav_lat_ID) call erreur(status,.TRUE.,"inq_nav_lat_ID") status = NF90_INQ_VARID(fidU,"nav_lon",nav_lon_ID) call erreur(status,.TRUE.,"inq_nav_lon_ID") !Lecture des valeurs des variables qui nous interessent status = NF90_GET_VAR(fidU,vozocrtx_ID,vozocrtx) call erreur(status,.TRUE.,"getvar_vozocrtx") status = NF90_GET_VAR(fidU,nav_lat_ID,nav_lat_U) call erreur(status,.TRUE.,"getvar_nav_lat") status = NF90_GET_VAR(fidU,nav_lon_ID,nav_lon_U) call erreur(status,.TRUE.,"getvar_nav_lon") !Fermeture du fichier lu status = NF90_CLOSE(fidU) call erreur(status,.TRUE.,"fin_lecture") !--------------------------------------- ! Read netcdf input file for grid V : write(*,*) TRIM(file_in_V) status = NF90_OPEN(TRIM(file_in_V),0,fidV) call erreur(status,.TRUE.,"read") !Lecture des ID des dimensions qui nous interessent status = NF90_INQ_DIMID(fidV,"depthv",dimID_depthv) call erreur(status,.TRUE.,"inq_dimID_depthv") status = NF90_INQ_DIMID(fidV,"y",dimID_y) call erreur(status,.TRUE.,"inq_dimID_y") !Lecture des valeurs des dimensions qui nous interessent status = NF90_INQUIRE_DIMENSION(fidV,dimID_depthv,len=mdepthv) call erreur(status,.TRUE.,"inq_dim_depthv") status = NF90_INQUIRE_DIMENSION(fidV,dimID_y,len=myu) call erreur(status,.TRUE.,"inq_dim_y") write(*,101) mx, myu, mdepthv, mtime_counter !Allocation of arrays : ALLOCATE( vomecrty(mx,myu,mdepthv,mtime_counter) ) ALLOCATE( nav_lat_V(mx,myu) ) ALLOCATE( nav_lon_V(mx,myu) ) !Lecture des ID des variables qui nous interessent status = NF90_INQ_VARID(fidV,"vomecrty",vomecrty_ID) call erreur(status,.TRUE.,"inq_vomecrty_ID") status = NF90_INQ_VARID(fidV,"nav_lat",nav_lat_ID) call erreur(status,.TRUE.,"inq_nav_lat_ID") status = NF90_INQ_VARID(fidV,"nav_lon",nav_lon_ID) call erreur(status,.TRUE.,"inq_nav_lon_ID") !Lecture des valeurs des variables qui nous interessent status = NF90_GET_VAR(fidV,vomecrty_ID,vomecrty) call erreur(status,.TRUE.,"getvar_vomecrty") status = NF90_GET_VAR(fidV,nav_lat_ID,nav_lat_V) call erreur(status,.TRUE.,"getvar_nav_lat") status = NF90_GET_VAR(fidV,nav_lon_ID,nav_lon_V) call erreur(status,.TRUE.,"getvar_nav_lon") !Fermeture du fichier lu status = NF90_CLOSE(fidV) call erreur(status,.TRUE.,"fin_lecture") !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! Remise des longitudes de 0 à 360 (utile pour l'interpolation): do i=1,mx do j=1,my if (nav_lon_T(i,j).lt.0.0) then nav_lon_T(i,j) = 360.0 + nav_lon_T(i,j) endif enddo do j=1,myu if (nav_lon_V(i,j).lt.0.0) then nav_lon_V(i,j) = 360.0 + nav_lon_V(i,j) endif enddo enddo do i=1,mxu do j=1,my if (nav_lon_U(i,j).lt.0.0) then nav_lon_U(i,j) = 360.0 + nav_lon_U(i,j) endif enddo enddo !------------------------------------------------------------------------------- ! Calcul des densite avel le module eos des CDFTOOLS-2.1 ALLOCATE( sig0(mx,my,mdeptht,mtime_counter) ) ALLOCATE( sig1(mx,my,mdeptht,mtime_counter) ) ALLOCATE( sig2(mx,my,mdeptht,mtime_counter) ) ALLOCATE( sig4(mx,my,mdeptht,mtime_counter) ) do k=1,mdeptht do l=1,mtime_counter sig0(:,:,k,l)=sigma0(votemper(:,:,k,l),vosaline(:,:,k,l),mx,my) sig1(:,:,k,l)=sigmai(votemper(:,:,k,l),vosaline(:,:,k,l),1000.,mx,my) sig2(:,:,k,l)=sigmai(votemper(:,:,k,l),vosaline(:,:,k,l),2000.,mx,my) sig4(:,:,k,l)=sigmai(votemper(:,:,k,l),vosaline(:,:,k,l),4000.,mx,my) enddo enddo !------------------------------------------------------------------------------- ! Calcul de la longueur des sections et des points modeles associes Ntot=SUM(N(:)) write(*,*) '********** total number of points :', Ntot ALLOCATE( latsec(Ntot) , lonsec(Ntot) , X1(Ntot) ) ALLOCATE( votemper_sec(Ntot,mdeptht,mtime_counter) ) ALLOCATE( vosaline_sec(Ntot,mdeptht,mtime_counter) ) ALLOCATE( vozocrtx_sec(Ntot,mdepthu,mtime_counter) ) ALLOCATE( vomecrty_sec(Ntot,mdepthv,mtime_counter) ) ALLOCATE( Unorm(Ntot,mdeptht,mtime_counter) ) ALLOCATE( Utang(Ntot,mdeptht,mtime_counter) ) ALLOCATE( sigsec0(Ntot,mdeptht,mtime_counter) ) ALLOCATE( sigsec1(Ntot,mdeptht,mtime_counter) ) ALLOCATE( sigsec2(Ntot,mdeptht,mtime_counter) ) ALLOCATE( sigsec4(Ntot,mdeptht,mtime_counter) ) ! BOUCLE SUR LE NOMBRE DE SECTIONS Nsec A ACOLLER : N2=0 ! Point de référence pour la distance de la section (exple : dans OVIDE 60N 43.25W) offset=RT * acos(cos(latref*rr)*cos(lat(1)*rr)*cos((lonref)*rr-lon(1)*rr)+sin(latref*rr)*sin(lat(1)*rr)) cont=0 DO p=1,Nsec N1=N2+1 N2=N1+N(p)-1 !longueur de la section p en km : d(p) = RT * acos(cos(lat(p)*rr)*cos(lat(p+1)*rr)*cos(lon(p+1)*rr-lon(p)*rr)+sin(lat(p)*rr)*sin(lat(p+1)*rr)) write(*,102) p,d(p) 102 FORMAT('*** Section ',i4,' = ',f8.2, 'km') write(*,103) lat(p), lon(p), lat(p+1), lon(p+1) 103 FORMAT(' - from (lat,lon) = (',f6.2,',',f6.2,') to (',f6.2,',',f6.2,')') ! "pente" de la section 1 en radians / equateur (angle algebrique) if (lon(p).ne.lon(p+1)) then ang = atan((lat(p+1)-lat(p))/(lon(p+1)-lon(p))) else ang=pi/2. endif write(*,*) ' - angle / equateur (deg) =', ang/rr !coordonnées de tous les points de la section p en (lon,lat) et en km : DO s=N1,N2 undefined(:)=.FALSE. latsec(s)=(lat(p+1)-lat(p))*FLOAT(s-N1+cont)/FLOAT(N2-N1+cont) + lat(p) lonsec(s)=(lon(p+1)-lon(p))*FLOAT(s-N1+cont)/FLOAT(N2-N1+cont) + lon(p) X1(s)=d(p)*FLOAT(s-N1+cont)/FLOAT(N2-N1+cont)+offset miniT=1000 !km miniU=miniT miniV=miniT ! recherche du point le plus proche (on fait comme ça parceque la grille est bizarre vers les poles) do i=1,mx do j=1,my dtmp_T= RT * acos(cos(nav_lat_T(i,j)*rr)*cos(latsec(s)*rr)*cos(nav_lon_T(i,j)*rr- & & lonsec(s)*rr)+sin(nav_lat_T(i,j)*rr)*sin(latsec(s)*rr)) dtmp_U= RT * acos(cos(nav_lat_U(i,j)*rr)*cos(latsec(s)*rr)*cos(nav_lon_U(i,j)*rr- & & lonsec(s)*rr)+sin(nav_lat_U(i,j)*rr)*sin(latsec(s)*rr)) dtmp_V= RT * acos(cos(nav_lat_V(i,j)*rr)*cos(latsec(s)*rr)*cos(nav_lon_V(i,j)*rr- & & lonsec(s)*rr)+sin(nav_lat_V(i,j)*rr)*sin(latsec(s)*rr)) if (dtmp_T.lt.miniT) then miniT=dtmp_T iiT=i jjT=j endif if (dtmp_U.lt.miniU) then miniU=dtmp_U iiU=i jjU=j endif if (dtmp_V.lt.miniV) then miniV=dtmp_V iiV=i jjV=j endif enddo enddo !interpolation des champs T: if (latsec(s).gt.60.0) then !champs le plus proche de la section (U et V interpoles au point T) votemper_sec(s,:,:) = votemper(iiT,jjT,:,:) vosaline_sec(s,:,:) = vosaline(iiT,jjT,:,:) vozocrtx_sec(s,:,:) = vozocrtx(iiU,jjU,:,:) vomecrty_sec(s,:,:) = vomecrty(iiV,jjV,:,:) ! vitesse normale et tangeantielle a la section (section orientee vers le nord, tangeante à droite) Unorm(s,:,:) = vomecrty_sec(s,:,:)*cos(ang) - vozocrtx_sec(s,:,:)*sin(ang) Utang(s,:,:) = vomecrty_sec(s,:,:)*sin(ang) + vozocrtx_sec(s,:,:)*cos(ang) ! densites : sigsec0(s,:,:) = MAX(sig0(iiT,jjT,:,:),10.0) sigsec1(s,:,:) = MAX(sig1(iiT,jjT,:,:),10.0) sigsec2(s,:,:) = MAX(sig2(iiT,jjT,:,:),10.0) sigsec4(s,:,:) = MAX(sig4(iiT,jjT,:,:),20.0) else ! Champs T interpoles if (lonsec(s).ge.nav_lon_T(iiT,jjT)) then iinf=iiT if ( iiT+1.le.mx ) then isup=iiT+1 else isup=1 endif else if ( iiT-1.ge.1 ) then iinf=iiT-1 else iinf=mx endif isup=iiT endif if (latsec(s).ge.nav_lat_T(iiT,jjT)) then jinf=jjT jsup=jjT+1 else jinf=jjT-1 jsup=jjT endif loninf=nav_lon_T(iinf,jjT) lonsup=nav_lon_T(isup,jjT) latinf=nav_lat_T(iiT,jinf) latsup=nav_lat_T(iiT,jsup) a=(lonsec(s)-loninf)/(lonsup-loninf) b=(lonsup-lonsec(s))/(lonsup-loninf) c=(latsec(s)-latinf)/(latsup-latinf) e=(latsup-latsec(s))/(latsup-latinf) votemper_sec(s,:,:) = c*(a*votemper(isup,jsup,:,:)+b*votemper(iinf,jsup,:,:)) & & +e*(a*votemper(isup,jinf,:,:)+b*votemper(iinf,jinf,:,:)) vosaline_sec(s,:,:) = c*(a*vosaline(isup,jsup,:,:)+b*vosaline(iinf,jsup,:,:)) & & +e*(a*vosaline(isup,jinf,:,:)+b*vosaline(iinf,jinf,:,:)) sigsec0(s,:,:) = c*(a*sig0(isup,jsup,:,:)+b*sig0(iinf,jsup,:,:)) & & +e*(a*sig0(isup,jinf,:,:)+b*sig0(iinf,jinf,:,:)) sigsec0(s,:,:) = MAX(sigsec0(s,:,:),10.0) sigsec1(s,:,:) = c*(a*sig1(isup,jsup,:,:)+b*sig1(iinf,jsup,:,:)) & & +e*(a*sig1(isup,jinf,:,:)+b*sig1(iinf,jinf,:,:)) sigsec1(s,:,:) = MAX(sigsec1(s,:,:),10.0) sigsec2(s,:,:) = c*(a*sig2(isup,jsup,:,:)+b*sig2(iinf,jsup,:,:)) & & +e*(a*sig2(isup,jinf,:,:)+b*sig2(iinf,jinf,:,:)) sigsec2(s,:,:) = MAX(sigsec2(s,:,:),10.0) sigsec4(s,:,:) = c*(a*sig4(isup,jsup,:,:)+b*sig4(iinf,jsup,:,:)) & & +e*(a*sig4(isup,jinf,:,:)+b*sig4(iinf,jinf,:,:)) sigsec4(s,:,:) = MAX(sigsec4(s,:,:),20.0) ! test si valeurs indefinies sur un des 4 points : do k=1,mdeptht if ((vosaline(iinf,jinf,k,1).eq.missing).or.(vosaline(iinf,jsup,k,1).eq.missing).or.& & (vosaline(isup,jinf,k,1).eq.missing).or.(vosaline(isup,jsup,k,1).eq.missing) ) then votemper_sec(s,:,:) = votemper(iiT,jjT,:,:) vosaline_sec(s,:,:) = vosaline(iiT,jjT,:,:) vozocrtx_sec(s,:,:) = vozocrtx(iiU,jjU,:,:) vomecrty_sec(s,:,:) = vomecrty(iiV,jjV,:,:) sigsec0(s,:,:) = MAX(sig0(iiT,jjT,:,:),10.0) sigsec1(s,:,:) = MAX(sig1(iiT,jjT,:,:),10.0) sigsec2(s,:,:) = MAX(sig2(iiT,jjT,:,:),10.0) sigsec4(s,:,:) = MAX(sig4(iiT,jjT,:,:),20.0) undefined(k)=.TRUE. endif enddo ! Champs U interpoles if (lonsec(s).ge.nav_lon_U(iiU,jjU)) then iinf=iiU if ( iiU+1.le.mx ) then isup=iiU+1 else isup=1 endif else if ( iiU-1.ge.1 ) then iinf=iiU-1 else iinf=mx endif isup=iiU endif if (latsec(s).ge.nav_lat_U(iiU,jjU)) then jinf=jjU jsup=jjU+1 else jinf=jjU-1 jsup=jjU endif loninf=nav_lon_U(iinf,jjU) lonsup=nav_lon_U(isup,jjU) latinf=nav_lat_U(iiU,jinf) latsup=nav_lat_U(iiU,jsup) a=(lonsec(s)-loninf)/(lonsup-loninf) b=(lonsup-lonsec(s))/(lonsup-loninf) c=(latsec(s)-latinf)/(latsup-latinf) e=(latsup-latsec(s))/(latsup-latinf) vozocrtx_sec(s,:,:) = c*(a*vozocrtx(isup,jsup,:,:)+b*vozocrtx(iinf,jsup,:,:)) & & +e*(a*vozocrtx(isup,jinf,:,:)+b*vozocrtx(iinf,jinf,:,:)) ! Champs V interpoles if (lonsec(s).ge.nav_lon_U(iiU,jjU)) then iinf=iiU if ( iiU+1.le.mx ) then isup=iiU+1 else isup=1 endif else if ( iiU-1.ge.1 ) then iinf=iiU-1 else iinf=mx endif isup=iiU endif if (latsec(s).ge.nav_lat_V(iiV,jjV)) then jinf=jjV jsup=jjV+1 else jinf=jjV-1 jsup=jjV endif loninf=nav_lon_V(iinf,jjV) lonsup=nav_lon_V(isup,jjV) latinf=nav_lat_V(iiV,jinf) latsup=nav_lat_V(iiV,jsup) a=(lonsec(s)-loninf)/(lonsup-loninf) b=(lonsup-lonsec(s))/(lonsup-loninf) c=(latsec(s)-latinf)/(latsup-latinf) e=(latsup-latsec(s))/(latsup-latinf) vomecrty_sec(s,:,:) = c*(a*vomecrty(isup,jsup,:,:)+b*vomecrty(iinf,jsup,:,:)) & & +e*(a*vomecrty(isup,jinf,:,:)+b*vomecrty(iinf,jinf,:,:)) ! si l'un des 4 points de l'interpolation etait indefini : do k=1,mdeptht if (undefined(k)) then vozocrtx_sec(s,k,:) = vozocrtx(iiU,jjU,k,:) vomecrty_sec(s,k,:) = vomecrty(iiV,jjV,k,:) endif enddo ! vitesse normale et tangeantielle a la section (section orientee vers le nord, tangeante à droite) Unorm(s,:,:) = vomecrty_sec(s,:,:)*cos(ang) - vozocrtx_sec(s,:,:)*sin(ang) Utang(s,:,:) = vomecrty_sec(s,:,:)*sin(ang) + vozocrtx_sec(s,:,:)*cos(ang) endif ENDDO !- s nb de points sur section p cont=1 offset=X1(N2) ENDDO !- p nb de sections !---------------------------------------------------------- !---------------------------------------------------------- ! Writing new netcdf file : status = NF90_CREATE(TRIM(file_out),NF90_NOCLOBBER,fidM) call erreur(status,.TRUE.,'create') !Definition des dimensions du fichiers status = NF90_DEF_DIM(fidM,"time_counter",NF90_UNLIMITED,dimID_time_counter) call erreur(status,.TRUE.,"def_dimID_time_counter") status = NF90_DEF_DIM(fidM,"deptht",mdeptht,dimID_deptht) call erreur(status,.TRUE.,"def_dimID_deptht") status = NF90_DEF_DIM(fidM,"X",Ntot,dimID_s) call erreur(status,.TRUE.,"def_dimID_s") !Definition des variables status = NF90_DEF_VAR(fidM,"vosaline",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),vosaline_ID) call erreur(status,.TRUE.,"def_var_vosaline_ID") status = NF90_DEF_VAR(fidM,"votemper",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),votemper_ID) call erreur(status,.TRUE.,"def_var_votemper_ID") status = NF90_DEF_VAR(fidM,"time_counter",NF90_FLOAT,(/dimID_time_counter/),time_counter_ID) call erreur(status,.TRUE.,"def_var_time_counter_ID") status = NF90_DEF_VAR(fidM,"deptht",NF90_FLOAT,(/dimID_deptht/),deptht_ID) call erreur(status,.TRUE.,"def_var_deptht_ID") status = NF90_DEF_VAR(fidM,"nav_lat",NF90_FLOAT,(/dimID_s/),nav_lat_ID) call erreur(status,.TRUE.,"def_var_nav_lat_ID") status = NF90_DEF_VAR(fidM,"nav_lon",NF90_FLOAT,(/dimID_s/),nav_lon_ID) call erreur(status,.TRUE.,"def_var_nav_lon_ID") status = NF90_DEF_VAR(fidM,"X",NF90_DOUBLE,(/dimID_s/),X_ID) call erreur(status,.TRUE.,"def_var_X_ID") status = NF90_DEF_VAR(fidM,"Uorth",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),Unorm_ID) call erreur(status,.TRUE.,"def_var_Unorm_ID") status = NF90_DEF_VAR(fidM,"Utang",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),Utang_ID) call erreur(status,.TRUE.,"def_var_Utang_ID") status = NF90_DEF_VAR(fidM,"sig0",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),sig0_ID) call erreur(status,.TRUE.,"def_var_sig0_ID") status = NF90_DEF_VAR(fidM,"sig1",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),sig1_ID) call erreur(status,.TRUE.,"def_var_sig1_ID") status = NF90_DEF_VAR(fidM,"sig2",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),sig2_ID) call erreur(status,.TRUE.,"def_var_sig2_ID") status = NF90_DEF_VAR(fidM,"sig4",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),sig4_ID) call erreur(status,.TRUE.,"def_var_sig4_ID") ! Attributs des variables : status = NF90_PUT_ATT(fidM,vosaline_ID,"online_operation","N/A") call erreur(status,.TRUE.,"put_att_vosaline_ID") status = NF90_PUT_ATT(fidM,vosaline_ID,"short_name","vosaline") call erreur(status,.TRUE.,"put_att_vosaline_ID") status = NF90_PUT_ATT(fidM,vosaline_ID,"long_name","sea_water_salinity") call erreur(status,.TRUE.,"put_att_vosaline_ID") status = NF90_PUT_ATT(fidM,vosaline_ID,"valid_max",45.) call erreur(status,.TRUE.,"put_att_vosaline_ID") status = NF90_PUT_ATT(fidM,vosaline_ID,"valid_min",0.) call erreur(status,.TRUE.,"put_att_vosaline_ID") status = NF90_PUT_ATT(fidM,vosaline_ID,"missing_value",0.) call erreur(status,.TRUE.,"put_att_vosaline_ID") status = NF90_PUT_ATT(fidM,vosaline_ID,"units","PSU") call erreur(status,.TRUE.,"put_att_vosaline_ID") status = NF90_PUT_ATT(fidM,votemper_ID,"online_operation","N/A") call erreur(status,.TRUE.,"put_att_votemper_ID") status = NF90_PUT_ATT(fidM,votemper_ID,"short_name","votemper") call erreur(status,.TRUE.,"put_att_votemper_ID") status = NF90_PUT_ATT(fidM,votemper_ID,"long_name","sea_water_potential_temperature") call erreur(status,.TRUE.,"put_att_votemper_ID") status = NF90_PUT_ATT(fidM,votemper_ID,"valid_max",45.) call erreur(status,.TRUE.,"put_att_votemper_ID") status = NF90_PUT_ATT(fidM,votemper_ID,"valid_min",-2.) call erreur(status,.TRUE.,"put_att_votemper_ID") status = NF90_PUT_ATT(fidM,votemper_ID,"missing_value",0.) call erreur(status,.TRUE.,"put_att_votemper_ID") status = NF90_PUT_ATT(fidM,votemper_ID,"units","C") call erreur(status,.TRUE.,"put_att_votemper_ID") status = NF90_PUT_ATT(fidM,time_counter_ID,"time_origin","2001-OCT-03 00:00:00") call erreur(status,.TRUE.,"put_att_time_counter_ID") status = NF90_PUT_ATT(fidM,time_counter_ID,"units","seconds since 2001-10-03 00:00:00") call erreur(status,.TRUE.,"put_att_time_counter_ID") status = NF90_PUT_ATT(fidM,time_counter_ID,"long_name","Time axis") call erreur(status,.TRUE.,"put_att_time_counter_ID") status = NF90_PUT_ATT(fidM,time_counter_ID,"title","Time") call erreur(status,.TRUE.,"put_att_time_counter_ID") status = NF90_PUT_ATT(fidM,time_counter_ID,"calendar","gregorian") call erreur(status,.TRUE.,"put_att_time_counter_ID") status = NF90_PUT_ATT(fidM,deptht_ID,"long_name","Vertical T levels") call erreur(status,.TRUE.,"put_att_deptht_ID") status = NF90_PUT_ATT(fidM,deptht_ID,"title","deptht") call erreur(status,.TRUE.,"put_att_deptht_ID") status = NF90_PUT_ATT(fidM,deptht_ID,"valid_max",50.) call erreur(status,.TRUE.,"put_att_deptht_ID") status = NF90_PUT_ATT(fidM,deptht_ID,"valid_min",0.) call erreur(status,.TRUE.,"put_att_deptht_ID") status = NF90_PUT_ATT(fidM,deptht_ID,"positive","unknown") call erreur(status,.TRUE.,"put_att_deptht_ID") status = NF90_PUT_ATT(fidM,deptht_ID,"units","m") call erreur(status,.TRUE.,"put_att_deptht_ID") status = NF90_PUT_ATT(fidM,nav_lat_ID,"long_name","Latitude") call erreur(status,.TRUE.,"put_att_nav_lat_ID") status = NF90_PUT_ATT(fidM,nav_lat_ID,"scale_factor",1.) call erreur(status,.TRUE.,"put_att_nav_lat_ID") status = NF90_PUT_ATT(fidM,nav_lat_ID,"add_offset",0.) call erreur(status,.TRUE.,"put_att_nav_lat_ID") status = NF90_PUT_ATT(fidM,nav_lat_ID,"valid_max",89.947868347168) call erreur(status,.TRUE.,"put_att_nav_lat_ID") status = NF90_PUT_ATT(fidM,nav_lat_ID,"valid_min",-77.0104751586914) call erreur(status,.TRUE.,"put_att_nav_lat_ID") status = NF90_PUT_ATT(fidM,nav_lat_ID,"units","degrees_north") call erreur(status,.TRUE.,"put_att_nav_lat_ID") status = NF90_PUT_ATT(fidM,nav_lon_ID,"long_name","Longitude") call erreur(status,.TRUE.,"put_att_nav_lon_ID") status = NF90_PUT_ATT(fidM,nav_lon_ID,"scale_factor",1.) call erreur(status,.TRUE.,"put_att_nav_lon_ID") status = NF90_PUT_ATT(fidM,nav_lon_ID,"add_offset",0.) call erreur(status,.TRUE.,"put_att_nav_lon_ID") status = NF90_PUT_ATT(fidM,nav_lon_ID,"valid_max",180.) call erreur(status,.TRUE.,"put_att_nav_lon_ID") status = NF90_PUT_ATT(fidM,nav_lon_ID,"valid_min",-180.) call erreur(status,.TRUE.,"put_att_nav_lon_ID") status = NF90_PUT_ATT(fidM,nav_lon_ID,"units","degrees_east") call erreur(status,.TRUE.,"put_att_nav_lon_ID") status = NF90_PUT_ATT(fidM,X_ID,"nav_model","Default grid") call erreur(status,.TRUE.,"put_att_X_ID") status = NF90_PUT_ATT(fidM,X_ID,"long_name","X") call erreur(status,.TRUE.,"put_att_X_ID") status = NF90_PUT_ATT(fidM,X_ID,"scale_factor",1.) call erreur(status,.TRUE.,"put_att_X_ID") status = NF90_PUT_ATT(fidM,X_ID,"add_offset",0.) call erreur(status,.TRUE.,"put_att_X_ID") status = NF90_PUT_ATT(fidM,X_ID,"units","km") call erreur(status,.TRUE.,"put_att_X_ID") status = NF90_PUT_ATT(fidM,Unorm_ID,"online_operation","N/A") call erreur(status,.TRUE.,"put_att_Unorm_ID") status = NF90_PUT_ATT(fidM,Unorm_ID,"short_name","Uorth") call erreur(status,.TRUE.,"put_att_Unorm_ID") status = NF90_PUT_ATT(fidM,Unorm_ID,"long_name","ocean speed orthogonal to the section oriented south-north") call erreur(status,.TRUE.,"put_att_Unorm_ID") status = NF90_PUT_ATT(fidM,Unorm_ID,"valid_max",10.) call erreur(status,.TRUE.,"put_att_Unorm_ID") status = NF90_PUT_ATT(fidM,Unorm_ID,"valid_min",-10.) call erreur(status,.TRUE.,"put_att_Unorm_ID") status = NF90_PUT_ATT(fidM,Unorm_ID,"missing_value",0.) call erreur(status,.TRUE.,"put_att_Unorm_ID") status = NF90_PUT_ATT(fidM,Unorm_ID,"units","m/s") call erreur(status,.TRUE.,"put_att_Unorm_ID") status = NF90_PUT_ATT(fidM,Utang_ID,"online_operation","N/A") call erreur(status,.TRUE.,"put_att_Utang_ID") status = NF90_PUT_ATT(fidM,Utang_ID,"short_name","Utang") call erreur(status,.TRUE.,"put_att_Utang_ID") status = NF90_PUT_ATT(fidM,Utang_ID,"long_name","ocean speed tangential to the section oriented south-north") call erreur(status,.TRUE.,"put_att_Utang_ID") status = NF90_PUT_ATT(fidM,Utang_ID,"valid_max",10.) call erreur(status,.TRUE.,"put_att_Utang_ID") status = NF90_PUT_ATT(fidM,Utang_ID,"valid_min",-10.) call erreur(status,.TRUE.,"put_att_Utang_ID") status = NF90_PUT_ATT(fidM,Utang_ID,"missing_value",0.) call erreur(status,.TRUE.,"put_att_Utang_ID") status = NF90_PUT_ATT(fidM,Utang_ID,"units","m/s") call erreur(status,.TRUE.,"put_att_Utang_ID") status = NF90_PUT_ATT(fidM,sig0_ID,"short_name","sig0") call erreur(status,.TRUE.,"put_att_sig0_ID") status = NF90_PUT_ATT(fidM,sig0_ID,"long_name","Potential Density Sigma 0") call erreur(status,.TRUE.,"put_att_sig0_ID") status = NF90_PUT_ATT(fidM,sig0_ID,"valid_max",100.) call erreur(status,.TRUE.,"put_att_sig0_ID") status = NF90_PUT_ATT(fidM,sig0_ID,"valid_min",10.0) call erreur(status,.TRUE.,"put_att_sig0_ID") status = NF90_PUT_ATT(fidM,sig0_ID,"missing_value",10.0) call erreur(status,.TRUE.,"put_att_sig0_ID") status = NF90_PUT_ATT(fidM,sig0_ID,"units","kg/m3") call erreur(status,.TRUE.,"put_att_sig0_ID") status = NF90_PUT_ATT(fidM,sig1_ID,"short_name","sig1") call erreur(status,.TRUE.,"put_att_sig1_ID") status = NF90_PUT_ATT(fidM,sig1_ID,"long_name","Potential Density Sigma 0") call erreur(status,.TRUE.,"put_att_sig1_ID") status = NF90_PUT_ATT(fidM,sig1_ID,"valid_max",100.) call erreur(status,.TRUE.,"put_att_sig1_ID") status = NF90_PUT_ATT(fidM,sig1_ID,"valid_min",10.0) call erreur(status,.TRUE.,"put_att_sig1_ID") status = NF90_PUT_ATT(fidM,sig1_ID,"missing_value",10.0) call erreur(status,.TRUE.,"put_att_sig1_ID") status = NF90_PUT_ATT(fidM,sig1_ID,"units","kg/m3") call erreur(status,.TRUE.,"put_att_sig1_ID") status = NF90_PUT_ATT(fidM,sig2_ID,"short_name","sig2") call erreur(status,.TRUE.,"put_att_sig2_ID") status = NF90_PUT_ATT(fidM,sig2_ID,"long_name","Potential Density Sigma 0") call erreur(status,.TRUE.,"put_att_sig2_ID") status = NF90_PUT_ATT(fidM,sig2_ID,"valid_max",100.) call erreur(status,.TRUE.,"put_att_sig2_ID") status = NF90_PUT_ATT(fidM,sig2_ID,"valid_min",10.0) call erreur(status,.TRUE.,"put_att_sig2_ID") status = NF90_PUT_ATT(fidM,sig2_ID,"missing_value",10.0) call erreur(status,.TRUE.,"put_att_sig2_ID") status = NF90_PUT_ATT(fidM,sig2_ID,"units","kg/m3") call erreur(status,.TRUE.,"put_att_sig2_ID") status = NF90_PUT_ATT(fidM,sig4_ID,"short_name","sig4") call erreur(status,.TRUE.,"put_att_sig4_ID") status = NF90_PUT_ATT(fidM,sig4_ID,"long_name","Potential Density Sigma 0") call erreur(status,.TRUE.,"put_att_sig4_ID") status = NF90_PUT_ATT(fidM,sig4_ID,"valid_max",100.) call erreur(status,.TRUE.,"put_att_sig4_ID") status = NF90_PUT_ATT(fidM,sig4_ID,"valid_min",20.0) call erreur(status,.TRUE.,"put_att_sig4_ID") status = NF90_PUT_ATT(fidM,sig4_ID,"missing_value",20.0) call erreur(status,.TRUE.,"put_att_sig4_ID") status = NF90_PUT_ATT(fidM,sig4_ID,"units","kg/m3") call erreur(status,.TRUE.,"put_att_sig4_ID") ! Attributs globaux : status = NF90_PUT_ATT(fidM,NF90_GLOBAL,"history","Created by cdfsections (see CDFTOOLS)") call erreur(status,.TRUE.,"put_att_global_ID") !Fin des definitions status = NF90_ENDDEF(fidM) call erreur(status,.TRUE.,"fin_definition") !Valeurs prises par les variables : status = NF90_PUT_VAR(fidM,vosaline_ID,vosaline_sec) call erreur(status,.TRUE.,"var_vosaline_ID") status = NF90_PUT_VAR(fidM,votemper_ID,votemper_sec) call erreur(status,.TRUE.,"var_votemper_ID") status = NF90_PUT_VAR(fidM,time_counter_ID,time_counter) call erreur(status,.TRUE.,"var_time_counter_ID") status = NF90_PUT_VAR(fidM,deptht_ID,deptht) call erreur(status,.TRUE.,"var_deptht_ID") status = NF90_PUT_VAR(fidM,nav_lat_ID,latsec) call erreur(status,.TRUE.,"var_nav_lat_ID") status = NF90_PUT_VAR(fidM,nav_lon_ID,lonsec) call erreur(status,.TRUE.,"var_nav_lon_ID") status = NF90_PUT_VAR(fidM,X_ID,X1) call erreur(status,.TRUE.,"var_X_ID") status = NF90_PUT_VAR(fidM,Unorm_ID,Unorm) call erreur(status,.TRUE.,"var_Unorm_ID") status = NF90_PUT_VAR(fidM,Utang_ID,Utang) call erreur(status,.TRUE.,"var_Utang_ID") status = NF90_PUT_VAR(fidM,sig0_ID,sigsec0) call erreur(status,.TRUE.,"var_sig0_ID") status = NF90_PUT_VAR(fidM,sig1_ID,sigsec1) call erreur(status,.TRUE.,"var_sig1_ID") status = NF90_PUT_VAR(fidM,sig2_ID,sigsec2) call erreur(status,.TRUE.,"var_sigsec2_ID") status = NF90_PUT_VAR(fidM,sig4_ID,sigsec4) call erreur(status,.TRUE.,"var_sigsec4_ID") !Fin de l'ecriture status = NF90_CLOSE(fidM) call erreur(status,.TRUE.,"final") end program cdfsections SUBROUTINE erreur(iret, lstop, chaine) ! pour les messages d'erreur USE netcdf INTEGER, INTENT(in) :: iret LOGICAL, INTENT(in) :: lstop CHARACTER(LEN=*), INTENT(in) :: chaine ! CHARACTER(LEN=256) :: message ! IF ( iret .NE. 0 ) THEN WRITE(*,*) 'ROUTINE: ', TRIM(chaine) WRITE(*,*) 'ERREUR: ', iret message=NF90_STRERROR(iret) WRITE(*,*) 'THIS MEANS :',TRIM(message) IF ( lstop ) STOP ENDIF ! END SUBROUTINE erreur cdftools-3.0/cdfio.f900000644000175000017500000030351012241227304015726 0ustar amckinstryamckinstry MODULE cdfio !!====================================================================== !! *** MODULE cdfio *** !! Implement all I/O related to netcdf in CDFTOOLS !!===================================================================== !! History : 2.1 : 2005 : J.M. Molines : Original code !! : 2009 : R. Dussin : add putvar_0d function !! 3.0 : 12/2010 : J.M. Molines : Doctor + Licence !! Modified: 3.0 : 08/2011 : P. Mathiot : Add chkvar function !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! ............................. !! ERR_HDL : Error Handler routine to catch netcdf errors !! gettimeseries : print a 2 column array (time, variable) for a given !! file, variable and depth !! !! functions : description !! ............................. !! chkfile : check the existence of a file !! chkvar : check the existence of a variable in a file !! closeout : close output file !! copyatt : copy attributes from a file taken as model !! create : create a netcdf data set !! createvar : create netcdf variables in a new data set !! cvaratt : change some var attributes !! edatt_char : edit attributes of char type !! edatt_r4 : edit attributes of float type !! getatt : get attributes of a variable !! getdim : return the value of the dimension passed as argument !! getipk : get the vertical dimension of the variable !! getnvar : get the number of variable in a file !! getspval : get spval of a given variable !! getvar1d : read 1D variable (eg depth, time_counter) from a file !! getvaratt : read variable attributes !! gettimeatt : get time attributes !! getvar : read the variable !! getvare3 : read e3 type variable !! getvarid : get the varid of a variable in a file !! getvarname : get the name of a variable, according to its varid !! getvarxz : get a x-z slice of 3D data !! getvaryz : get a y-z slice of 3D data !! getvdim : get the number of dim of a variable !! ncopen : open a netcdf file and return its ncid !! putatt : write variable attribute !! puttimeatt : write time variable attribute !! putheadervar : write header variables such as nav_lon, nav_lat etc ... from a file taken !! : as template !! putvar0d : write a 0d variable (constant) !! putvar1d4 : write a 1d variable !! putvari2 : write a 2d Integer*2 variable !! putvarr4 : write a 2d Real*4 variable !! putvarr8 : write a 2d Real*8 variable !! putvarzo : write a zonally integrated/mean field !! reputvarr4 : re-write a real*4 variable !! reputvar1d4 : re-write a real*4 1d variable !!------------------------------------------------------------------------------------------------------ USE netcdf USE modcdfnames IMPLICIT NONE PRIVATE INTEGER(KIND=4) :: nid_x, nid_y, nid_z, nid_t, nid_lat, nid_lon, nid_dep, nid_tim INTEGER(KIND=4) :: nid_lon1d, nid_lat1d LOGICAL :: l_mbathy=.false. INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mbathy !: for reading e3._ps in nemo3.x REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3t_ps, e3w_ps !: for reading e3._ps in nemo3.x REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e3t_0, e3w_0 !: for readinf e3._ps in nemo3.x INTEGER(KIND=4) :: nstart_date = -1 !# from global file attribute CHARACTER(LEN=256) :: ctime_units = 'seconds since 0000-01-01 00:00:00' CHARACTER(LEN=256) :: ctime_origin = 'N/A' !# CHARACTER(LEN=256) :: calendar = 'N/A' !# gregorian noleap xxxd CHARACTER(LEN=256) :: config !# config name associated with file CHARACTER(LEN=256) :: ccase !# case name associated with file CHARACTER(LEN=10 ) :: cfreq !# raw model output frequency (5d, 30d 1h ..) TYPE, PUBLIC :: variable CHARACTER(LEN=256) :: cname !# variable name CHARACTER(LEN=256) :: cunits !# variable unit REAL(KIND=4) :: rmissing_value !# variable missing value or spval REAL(KIND=4) :: valid_min !# valid minimum REAL(KIND=4) :: valid_max !# valid maximum REAL(KIND=4) :: scale_factor=1. !# scale factor REAL(KIND=4) :: add_offset=0. !# add offset REAL(KIND=4) :: savelog10=0. !# flag for log10 transform INTEGER(KIND=4) :: iwght=1 !# weight of the variable for cdfmoy_weighted CHARACTER(LEN=256) :: clong_name !# Long Name of the variable CHARACTER(LEN=256) :: cshort_name !# short name of the variable CHARACTER(LEN=256) :: conline_operation !# ??? CHARACTER(LEN=256) :: caxis !# string defining the dim of the variable CHARACTER(LEN=256) :: cprecision='r4' !# possible values are i2, r4, r8 END TYPE variable INTEGER(KIND=4), PARAMETER :: jp_missing_nm = 3 CHARACTER(LEN=256), DIMENSION(jp_missing_nm) :: & ! take care of same length for each element & cl_missing_nm = (/'missing_value','Fillvalue ','_Fillvalue '/) CHARACTER(LEN=256 ) :: cl_dum !# dummy char argument INTERFACE putvar MODULE PROCEDURE putvarr8, putvarr4, putvari2, putvarzo, reputvarr4 END INTERFACE INTERFACE putvar1d MODULE PROCEDURE putvar1d4, reputvar1d4 END INTERFACE INTERFACE putvar0d MODULE PROCEDURE putvar0dt, putvar0ds END INTERFACE INTERFACE atted MODULE PROCEDURE atted_char, atted_r4 END INTERFACE PUBLIC :: chkfile, chkvar PUBLIC :: copyatt, create, createvar, getvaratt, cvaratt, gettimeatt PUBLIC :: putatt, putheadervar, putvar, putvar1d, putvar0d, atted, puttimeatt PUBLIC :: getatt, getdim, getvdim, getipk, getnvar, getvarname, getvarid, getspval PUBLIC :: getvar, getvarxz, getvaryz, getvar1d, getvare3 PUBLIC :: gettimeseries PUBLIC :: closeout, ncopen PUBLIC :: ERR_HDL !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- CONTAINS INTEGER(KIND=4) FUNCTION copyatt (cdvar, kidvar, kcin, kcout) !!--------------------------------------------------------------------- !! *** FUNCTION copyatt *** !! !! ** Purpose : Copy attributes for variable cdvar, which have id !! kidvar in kcout, from file id kcin !! !! ** Method : Use NF90_COPY_ATT !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdvar INTEGER(KIND=4), INTENT(in) :: kidvar, kcin, kcout INTEGER(KIND=4) :: ja INTEGER(KIND=4) :: istatus, idvar, iatt CHARACTER(LEN=256) :: clatt !!---------------------------------------------------------------------- IF ( kcin /= -9999) THEN ! there is a reference file open istatus = NF90_INQ_VARID(kcin, cdvar, idvar) istatus = NF90_INQUIRE_VARIABLE(kcin, idvar, natts=iatt) DO ja = 1, iatt istatus = NF90_INQ_ATTNAME(kcin,idvar,ja,clatt) istatus = NF90_COPY_ATT(kcin,idvar,clatt,kcout,kidvar) END DO ELSE ! no reference file SELECT CASE (TRIM(cdvar) ) CASE ('nav_lon', 'lon', 'x', 'longitude' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'units', 'degrees_east') istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_min', -180. ) istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_max', 180. ) istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name', 'Longitude' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'nav_model', 'Default grid') CASE ('nav_lat' ,'lat', 'y', 'latitude' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'units', 'degrees_north') istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_min', -90. ) istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_max', 90. ) istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name','Latitude' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'nav_model', 'Default grid') CASE ('time_counter', 'time', 't' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'calendar', calendar ) istatus=NF90_PUT_ATT(kcout, kidvar, 'units', ctime_units ) istatus=NF90_PUT_ATT(kcout, kidvar, 'time_origin',ctime_origin ) istatus=NF90_PUT_ATT(kcout, kidvar, 'title', 'Time' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name', 'Time axis' ) CASE ('deptht', 'depthu' ,'depthv' , 'depthw', 'dep', 'gdept' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'units', 'm' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'positive', 'unknown' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_min', 0. ) istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_max', 5875. ) istatus=NF90_PUT_ATT(kcout, kidvar, 'title', TRIM(cdvar) ) istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name', 'Vertical Levels') CASE ('sigma', 'levels') istatus=NF90_PUT_ATT(kcout, kidvar, 'units', 'kg/m3' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'positive', 'unknown' ) istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_min', 0. ) istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_max', 40. ) istatus=NF90_PUT_ATT(kcout, kidvar, 'title', TRIM(cdvar) ) istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name', 'Sigma bin limits') END SELECT ENDIF copyatt = istatus END FUNCTION copyatt INTEGER(KIND=4) FUNCTION create( cdfile, cdfilref ,kx,ky,kz ,cdep, cdepvar, & & cdlonvar, cdlatvar, ld_xycoo) !!--------------------------------------------------------------------- !! *** FUNCTION create *** !! !! ** Purpose : Create the file, and creates dimensions, and copy attributes !! from a cdilref reference file (for the nav_lon, nav_lat etc ...) !! If optional cdep given : take as depth variable name instead of !! cdfilref. Return the ncid of the created file, and leave it open !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile, cdfilref ! input file and reference file INTEGER(KIND=4), INTENT(in) :: kx, ky, kz ! dimension of the variable CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep ! name of vertical dim name if not standard CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdepvar ! name of vertical var name if it differs ! from vertical dimension name CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdlonvar ! name of 1D longitude CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdlatvar ! name of 1D latitude LOGICAL, OPTIONAL, INTENT(in) :: ld_xycoo ! if false then DO NOT read nav_lat nav_lat from input file INTEGER(KIND=4) :: istatus, icout, incid, idum INTEGER(KIND=4) ,DIMENSION(4) :: invdim CHARACTER(LEN=256) :: cldep, cldepref, cldepvar, clonvar, clatvar LOGICAL :: ll_xycoo !!---------------------------------------------------------------------- istatus = NF90_CREATE(cdfile,cmode=or(NF90_CLOBBER,NF90_64BIT_OFFSET), ncid=icout) istatus = NF90_DEF_DIM(icout, cn_x, kx, nid_x) istatus = NF90_DEF_DIM(icout, cn_y, ky, nid_y) IF ( kz /= 0 ) THEN ! try to find out the name I will use for depth dimension in the new file ... IF (PRESENT (cdep) ) THEN cldep = cdep idum=getdim(cdfilref,cldep,cldepref) ! look for depth dimension name in ref file IF (cldepref =='unknown' ) cldepref=cdep ELSE idum=getdim(cdfilref,cn_z,cldep ) ! look for depth dimension name in ref file cldepref=cldep ENDIF cldepvar=cldep istatus = NF90_DEF_DIM(icout,TRIM(cldep),kz, nid_z) IF (PRESENT (cdepvar) ) THEN cldepvar=cdepvar ENDIF ENDIF istatus = NF90_DEF_DIM(icout,cn_t,NF90_UNLIMITED, nid_t) invdim(1) = nid_x ; invdim(2) = nid_y ; invdim(3) = nid_z ; invdim(4) = nid_t ! Open reference file if any, otherwise set ncid to flag value (for copy att) IF ( TRIM(cdfilref) /= 'none' ) THEN istatus = NF90_OPEN(cdfilref,NF90_NOWRITE,incid) ELSE incid = -9999 ENDIF IF (PRESENT (ld_xycoo) ) THEN ll_xycoo = ld_xycoo ELSE ll_xycoo = .true. ENDIF ! define variables and copy attributes IF ( ll_xycoo ) THEN istatus = NF90_DEF_VAR(icout,cn_vlon2d,NF90_FLOAT,(/nid_x, nid_y/), nid_lon) istatus = copyatt(cn_vlon2d, nid_lon,incid,icout) istatus = NF90_DEF_VAR(icout,cn_vlat2d,NF90_FLOAT,(/nid_x, nid_y/), nid_lat) istatus = copyatt(cn_vlat2d, nid_lat,incid,icout) ENDIF IF ( PRESENT(cdlonvar) ) THEN istatus = NF90_DEF_VAR(icout,cdlonvar,NF90_FLOAT,(/nid_x/), nid_lon1d) ENDIF IF ( PRESENT(cdlatvar) ) THEN istatus = NF90_DEF_VAR(icout,cdlatvar,NF90_FLOAT,(/nid_y/), nid_lat1d) ENDIF IF ( kz /= 0 ) THEN istatus = NF90_DEF_VAR(icout,TRIM(cldepvar),NF90_FLOAT,(/nid_z/), nid_dep) ! JMM bug fix : if cdep present, then chose attribute from cldepref istatus = copyatt(TRIM(cldepvar), nid_dep,incid,icout) ENDIF istatus = NF90_DEF_VAR(icout,cn_vtimec,NF90_FLOAT,(/nid_t/), nid_tim) istatus = copyatt(cn_vtimec, nid_tim,incid,icout) ! Add Global General attribute at first call istatus=NF90_PUT_ATT(icout,NF90_GLOBAL,'start_date', nstart_date ) istatus=NF90_PUT_ATT(icout,NF90_GLOBAL,'output_frequency', cfreq ) istatus=NF90_PUT_ATT(icout,NF90_GLOBAL,'CONFIG', config ) istatus=NF90_PUT_ATT(icout,NF90_GLOBAL,'CASE', ccase ) istatus = NF90_CLOSE(incid) create=icout END FUNCTION create INTEGER(KIND=4) FUNCTION createvar(kout, sdtyvar, kvar, kpk, kidvo, cdglobal) !!--------------------------------------------------------------------- !! *** FUNCTION createvar *** !! !! ** Purpose : Create kvar variables cdvar(:), in file id kout, !! !! ** Method : INPUT: !! kout = ncid of output file !! cdvar = array of name of variables !! kvar = number of variables to create !! kpk = number of vertical dimensions foreach variable !! OUTPUT: !! kidvo = arrays with the varid of the variables just created. !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file TYPE (variable), DIMENSION(kvar) ,INTENT(in) :: sdtyvar ! variable structure INTEGER(KIND=4), INTENT(in) :: kvar ! number of variable INTEGER(KIND=4), DIMENSION(kvar), INTENT(in) :: kpk ! number of level/var INTEGER(KIND=4), DIMENSION(kvar), INTENT(out):: kidvo ! varid's of output var CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdglobal! Global Attribute INTEGER(KIND=4) :: jv ! dummy loop index INTEGER(KIND=4) :: idims, istatus INTEGER(KIND=4), DIMENSION(4) :: iidims INTEGER(KIND=4) :: iprecision !!---------------------------------------------------------------------- DO jv = 1, kvar ! Create variables whose name is not 'none' IF ( sdtyvar(jv)%cname /= 'none' ) THEN IF (kpk(jv) == 1 ) THEN idims=3 iidims(1) = nid_x ; iidims(2) = nid_y ; iidims(3) = nid_t ELSE IF (kpk(jv) > 1 ) THEN idims=4 iidims(1) = nid_x ; iidims(2) = nid_y ; iidims(3) = nid_z ; iidims(4) = nid_t ELSE PRINT *,' ERROR: ipk = ',kpk(jv), jv , sdtyvar(jv)%cname STOP ENDIF SELECT CASE ( sdtyvar(jv)%cprecision ) ! check the precision of the variable to create ! CASE ( 'r8' ) ; iprecision = NF90_DOUBLE ! CASE ( 'i2' ) ; iprecision = NF90_SHORT ! CASE ( 'by' ) ; iprecision = NF90_BYTE ! CASE DEFAULT ! r4 iprecision = NF90_FLOAT IF ( sdtyvar(jv)%scale_factor /= 1. .OR. sdtyvar(jv)%add_offset /= 0. ) THEN iprecision = NF90_SHORT ENDIF END SELECT istatus = NF90_DEF_VAR(kout, sdtyvar(jv)%cname, iprecision, iidims(1:idims) ,kidvo(jv) ) ! add attributes istatus = putatt(sdtyvar(jv), kout, kidvo(jv), cdglobal=cdglobal) createvar=istatus ENDIF END DO istatus = NF90_ENDDEF(kout) END FUNCTION createvar FUNCTION getvarid( cdfile, knvars ) !!--------------------------------------------------------------------- !! *** FUNCTION getvarid *** !! !! ** Purpose : return a real array with the nvar variable id !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile INTEGER(KIND=4), INTENT(in) :: knvars ! Number of variables in cdfile INTEGER(KIND=4), DIMENSION(knvars) :: getvarid ! return function INTEGER(KIND=4) :: jv ! dummy loop index CHARACTER(LEN=256), DIMENSION(knvars) :: cdvar INTEGER(KIND=4) :: incid INTEGER(KIND=4) :: istatus !!---------------------------------------------------------------------- istatus = NF90_OPEN(cdfile, NF90_NOWRITE, incid) DO jv = 1, knvars istatus = NF90_INQUIRE_VARIABLE(incid, jv, cdvar(jv) ) istatus = NF90_INQ_VARID(incid, cdvar(jv), getvarid(jv)) ENDDO istatus=NF90_CLOSE(incid) END FUNCTION getvarid INTEGER(KIND=4) FUNCTION getvaratt (cdfile, cdvar, cdunits, pmissing_value, cdlong_name, cdshort_name) !!--------------------------------------------------------------------- !! *** FUNCTION getvaratt *** !! !! ** Purpose : Get specific attributes for a variable (units, missing_value, !! long_name, short_name !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile, cdvar REAL(KIND=4), INTENT(out) :: pmissing_value CHARACTER(LEN=*), INTENT(out) :: cdunits, cdlong_name, cdshort_name INTEGER(KIND=4) :: istatus INTEGER(KIND=4) :: incid, ivarid !!---------------------------------------------------------------------- istatus = NF90_OPEN(cdfile, NF90_NOWRITE, incid) istatus = NF90_INQ_VARID(incid, cdvar, ivarid) istatus = NF90_GET_ATT(incid, ivarid, 'units', cdunits ) pmissing_value = getspval ( cdfile, cdvar ) istatus = NF90_GET_ATT(incid, ivarid, 'long_name', cdlong_name ) istatus = NF90_GET_ATT(incid, ivarid, 'short_name', cdshort_name ) getvaratt = istatus istatus = NF90_CLOSE(incid) END FUNCTION getvaratt INTEGER(KIND=4) FUNCTION gettimeatt (cdfile, cdvartime, ctcalendar, cttitle, & & ctlong_name, ctaxis, ctunits, cttime_origin ) !!--------------------------------------------------------------------- !! *** FUNCTION gettimeatt *** !! !! ** Purpose : Get specific attributes for time variable !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile CHARACTER(LEN=*), INTENT(in) :: cdvartime CHARACTER(LEN=*), INTENT(out) :: ctcalendar, cttitle, ctlong_name, ctaxis, ctunits, cttime_origin INTEGER(KIND=4) :: istatus INTEGER(KIND=4) :: incid, ivarid !!---------------------------------------------------------------------- ctcalendar = 'unknown' cttitle = 'unknown' ctlong_name = 'unknown' ctaxis = 'unknown' ctunits = 'unknown' cttime_origin = 'unknown' istatus = NF90_OPEN(cdfile, NF90_NOWRITE, incid) istatus = NF90_INQ_VARID(incid, cdvartime, ivarid) istatus = NF90_GET_ATT(incid, ivarid, 'calendar', ctcalendar ) istatus = NF90_GET_ATT(incid, ivarid, 'title', cttitle ) istatus = NF90_GET_ATT(incid, ivarid, 'long_name', ctlong_name ) istatus = NF90_GET_ATT(incid, ivarid, 'axis', ctaxis ) istatus = NF90_GET_ATT(incid, ivarid, 'units', ctunits ) istatus = NF90_GET_ATT(incid, ivarid, 'time_origin', cttime_origin ) gettimeatt = istatus istatus = NF90_CLOSE(incid) END FUNCTION gettimeatt INTEGER(KIND=4) FUNCTION puttimeatt (kout, cdvartime, ctcalendar, cttitle, & & ctlong_name, ctaxis, ctunits, cttime_origin ) !!--------------------------------------------------------------------- !! *** FUNCTION puttimeatt *** !! !! ** Purpose : Put specific attributes for time variable !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout CHARACTER(LEN=20), INTENT(in) :: cdvartime CHARACTER(LEN=256), INTENT(out) :: ctcalendar, cttitle, ctlong_name, ctaxis, ctunits, cttime_origin INTEGER(KIND=4) :: ivarid !!---------------------------------------------------------------------- puttimeatt=NF90_INQ_VARID(kout, cdvartime, ivarid) IF (puttimeatt /= 0 ) THEN PRINT *, NF90_STRERROR(puttimeatt) ; STOP 'puttimeatt var does not exist' ENDIF puttimeatt = NF90_REDEF(kout) puttimeatt=NF90_PUT_ATT(kout,ivarid,'calendar',ctcalendar) IF (puttimeatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(puttimeatt) ; STOP 'puttimeatt calendar'; ENDIF puttimeatt=NF90_PUT_ATT(kout,ivarid,'title',cttitle) IF (puttimeatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(puttimeatt) ; STOP 'puttimeatt title'; ENDIF puttimeatt=NF90_PUT_ATT(kout,ivarid,'long_name',ctlong_name) IF (puttimeatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(puttimeatt) ; STOP 'puttimeatt long_name'; ENDIF puttimeatt=NF90_PUT_ATT(kout,ivarid,'axis',ctaxis) IF (puttimeatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(puttimeatt) ; STOP 'puttimeatt axis'; ENDIF puttimeatt=NF90_PUT_ATT(kout,ivarid,'units',ctunits) IF (puttimeatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(puttimeatt) ; STOP 'puttimeatt units'; ENDIF puttimeatt=NF90_PUT_ATT(kout,ivarid,'time_origin',cttime_origin) IF (puttimeatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(puttimeatt) ; STOP 'puttimeatt time_origin'; ENDIF puttimeatt=NF90_ENDDEF(kout) END FUNCTION puttimeatt INTEGER(KIND=4) FUNCTION cvaratt (cdfile, cdvar, cdunits, pmissing_value, cdlong_name, cdshort_name) !!--------------------------------------------------------------------- !! *** FUNCTION cvaratt *** !! !! ** Purpose : Change variable attributs in an existing variable !! !!---------------------------------------------------------------------- CHARACTER(LEN=256), INTENT(in) :: cdfile, cdvar CHARACTER(LEN=256), INTENT(in) :: cdunits, cdlong_name, cdshort_name REAL(KIND=4), INTENT(in) :: pmissing_value INTEGER(KIND=4) :: istatus INTEGER(KIND=4) :: incid, ivarid REAL(KIND=4) :: zspval CHARACTER(LEN=256) :: clmissing ! get the actual missing_value attribute name !!---------------------------------------------------------------------- istatus = NF90_OPEN (cdfile, NF90_WRITE, incid) istatus = NF90_REDEF(incid) istatus = NF90_INQ_VARID(incid, cdvar, ivarid) istatus=NF90_RENAME_ATT(incid, ivarid, 'units', cdunits ) zspval = getspval ( cdfile, cdvar, clmissing ) istatus=NF90_PUT_ATT (incid, ivarid, clmissing, pmissing_value ) istatus=NF90_RENAME_ATT(incid, ivarid, 'long_name', cdlong_name ) istatus=NF90_RENAME_ATT(incid, ivarid, 'short_name', cdshort_name ) istatus=NF90_ENDDEF(incid) cvaratt=istatus istatus=NF90_CLOSE(incid) END FUNCTION cvaratt INTEGER(KIND=4) FUNCTION putatt (sdtyvar, kout, kid, cdglobal) !!--------------------------------------------------------------------- !! *** FUNCTION putatt *** !! !! ** Purpose : Put attribute for variable defined in the data structure !! !!---------------------------------------------------------------------- TYPE (variable), INTENT(in) :: sdtyvar INTEGER(KIND=4), INTENT(in) :: kout, kid CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdglobal !: global attribute !!---------------------------------------------------------------------- putatt=NF90_PUT_ATT(kout,kid,'units',sdtyvar%cunits) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt units'; ENDIF ! With netcdf4, missing value must have the same precision than the variable. Need to convert ! to sdtyvar%cprecision previous PUT_ATT SELECT CASE (sdtyvar%cprecision ) CASE ( 'r8' ) ; putatt=NF90_PUT_ATT(kout,kid,cn_missing_value,REAL(sdtyvar%rmissing_value,8) ) CASE ( 'i2' ) ; putatt=NF90_PUT_ATT(kout,kid,cn_missing_value, INT(sdtyvar%rmissing_value,2) ) CASE ( 'by' ) ; putatt=NF90_PUT_ATT(kout,kid,cn_missing_value, INT(sdtyvar%rmissing_value,1) ) CASE DEFAULT ; putatt=NF90_PUT_ATT(kout,kid,cn_missing_value,REAL(sdtyvar%rmissing_value,4) ) END SELECT IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt missing value'; ENDIF putatt=NF90_PUT_ATT(kout,kid,'valid_min',sdtyvar%valid_min) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt valid_min'; ENDIF putatt=NF90_PUT_ATT(kout,kid,'valid_max',sdtyvar%valid_max) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt valid_max'; ENDIF putatt=NF90_PUT_ATT(kout,kid,'long_name',sdtyvar%clong_name) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt longname'; ENDIF putatt=NF90_PUT_ATT(kout,kid,'short_name',sdtyvar%cshort_name) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt short name'; ENDIF putatt=NF90_PUT_ATT(kout,kid,'iweight',sdtyvar%iwght) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt iweight'; ENDIF putatt=NF90_PUT_ATT(kout,kid,'online_operation',sdtyvar%conline_operation) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt online oper'; ENDIF putatt=NF90_PUT_ATT(kout,kid,'axis',sdtyvar%caxis) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt axis'; ENDIF ! Optional attributes (scale_factor, add_offset ) putatt=NF90_PUT_ATT(kout,kid,'scale_factor',sdtyvar%scale_factor) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt scale fact'; ENDIF putatt=NF90_PUT_ATT(kout,kid,'add_offset',sdtyvar%add_offset) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt add offset'; ENDIF putatt=NF90_PUT_ATT(kout,kid,'savelog10',sdtyvar%savelog10) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt savelog0'; ENDIF ! Global attribute IF ( PRESENT(cdglobal) ) THEN putatt=NF90_PUT_ATT(kout,NF90_GLOBAL,'history',cdglobal) IF (putatt /= NF90_NOERR ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt global'; ENDIF ENDIF END FUNCTION putatt REAL(KIND=4) FUNCTION getatt (cdfile, cdvar, cdatt) !!--------------------------------------------------------------------- !! *** FUNCTION getatt *** !! !! ** Purpose : return a REAL value with the values of the !! attribute cdatt for all the variable cdvar in cdfile !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name CHARACTER(LEN=*), INTENT(in) :: cdvar ! var name CHARACTER(LEN=*), INTENT(in) :: cdatt ! attribute name to look for INTEGER(KIND=4) :: istatus, jv, incid, idum !!---------------------------------------------------------------------- istatus = NF90_OPEN (cdfile, NF90_NOWRITE, incid) istatus = NF90_INQ_VARID(incid, cdvar, idum) IF ( istatus /= NF90_NOERR) PRINT *, TRIM(NF90_STRERROR(istatus)),' when looking for ',TRIM(cdvar),' in getatt.' istatus = NF90_GET_ATT(incid, idum, cdatt, getatt) IF ( istatus /= NF90_NOERR ) THEN PRINT *,' getatt problem :',NF90_STRERROR(istatus) PRINT *,' attribute :', TRIM(cdatt) PRINT *,' variable :', TRIM(cdvar) PRINT *,' file :', TRIM(cdfile) PRINT *,' return default 0 ' getatt=0. ENDIF istatus=NF90_CLOSE(incid) END FUNCTION getatt INTEGER(KIND=4) FUNCTION atted_char ( cdfile, cdvar, cdatt, cdvalue ) !!--------------------------------------------------------------------- !! *** FUNCTION atted_char *** !! !! ** Purpose : attribute editor : modify existing attribute or create !! new attribute for variable cdvar in cdfile !! !! ** Method : just put_att after some check. !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! input file CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name CHARACTER(LEN=*), INTENT(in) :: cdatt ! attribute name CHARACTER(LEN=*), INTENT(in) :: cdvalue ! attribute value INTEGER(KIND=4) :: incid, istatus, idvar, ityp !!------------------------------------------------------------------------- istatus = NF90_OPEN(cdfile, NF90_WRITE, incid) istatus = NF90_INQ_VARID(incid, cdvar, idvar) IF ( istatus /= NF90_NOERR ) THEN PRINT *, NF90_STRERROR(istatus),' in atted ( inq_varid)' STOP ENDIF istatus = NF90_INQUIRE_ATTRIBUTE(incid, idvar, cdatt, xtype=ityp ) IF ( istatus /= NF90_NOERR ) THEN PRINT *, ' Attribute does not exist. Create it' istatus = NF90_REDEF(incid) istatus = NF90_PUT_ATT(incid, idvar, cdatt, cdvalue) atted_char = istatus ELSE IF ( ityp == NF90_CHAR ) THEN istatus = NF90_REDEF(incid) istatus = NF90_PUT_ATT(incid, idvar, cdatt, cdvalue) atted_char = istatus ELSE PRINT *, ' Mismatch in attribute type in atted_char' STOP ENDIF ENDIF istatus=NF90_CLOSE(incid) END FUNCTION atted_char INTEGER(KIND=4) FUNCTION atted_r4 ( cdfile, cdvar, cdatt, pvalue ) !!--------------------------------------------------------------------- !! *** FUNCTION atted_r4 *** !! !! ** Purpose : attribute editor : modify existing attribute or create !! new attribute for variable cdvar in cdfile !! !! ** Method : just put_att after some check. !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! input file CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name CHARACTER(LEN=*), INTENT(in) :: cdatt ! attribute name REAL(KIND=4), INTENT(in) :: pvalue ! attribute value INTEGER(KIND=4) :: incid, istatus, idvar, ityp !!------------------------------------------------------------------------- istatus = NF90_OPEN(cdfile, NF90_WRITE, incid) istatus = NF90_INQ_VARID(incid, cdvar, idvar) IF ( istatus /= NF90_NOERR ) THEN PRINT *, NF90_STRERROR(istatus),' in atted ( inq_varid)' STOP ENDIF istatus = NF90_INQUIRE_ATTRIBUTE(incid, idvar, cdatt, xtype=ityp ) IF ( istatus /= NF90_NOERR ) THEN PRINT *, ' Attribute does not exist. Create it' istatus = NF90_REDEF(incid) istatus = NF90_PUT_ATT(incid, idvar, cdatt, pvalue) atted_r4 = istatus ELSE IF ( ityp == NF90_FLOAT ) THEN istatus = NF90_REDEF(incid) istatus = NF90_PUT_ATT(incid, idvar, cdatt, pvalue) atted_r4 = istatus ELSE PRINT *, ' Mismatch in attribute type in atted_r4' STOP ENDIF ENDIF istatus=NF90_CLOSE(incid) END FUNCTION atted_r4 INTEGER(KIND=4) FUNCTION getdim (cdfile, cdim_name, cdtrue, kstatus, ldexact) !!--------------------------------------------------------------------- !! *** FUNCTION getdim *** !! !! ** Purpose : Return the INTEGER value of the dimension !! identified with cdim_name in cdfile !! !! ** Method : This function look for a dimension name that contains !! cdim_name, in cdfile. In option it returns the error !! status which can be used to make another intent, changing !! the dim name. Finally, with the last optional argument !! ldexact, exact match to cdim_name can be required. !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in ) :: cdfile ! File name to look at CHARACTER(LEN=*), INTENT(in ) :: cdim_name ! File name to look at CHARACTER(LEN=256), OPTIONAL, INTENT(out) :: cdtrue ! full name of the read dimension INTEGER(KIND=4), OPTIONAL, INTENT(out) :: kstatus ! status of the nf inquire LOGICAL, OPTIONAL, INTENT(in ) :: ldexact ! when true look for exact cdim_name INTEGER(KIND=4) :: jdim INTEGER(KIND=4) :: incid, id_dim, idv INTEGER(KIND=4) :: istatus INTEGER(KIND=4) :: idims CHARACTER(LEN=256) :: clnam LOGICAL :: lexact = .false. LOGICAL, SAVE :: ll_first = .true. !!----------------------------------------------------------- clnam = '-------------' IF ( PRESENT(kstatus) ) kstatus=0 IF ( PRESENT(ldexact) ) lexact=ldexact istatus=NF90_OPEN(cdfile, NF90_NOWRITE, incid) IF ( istatus == NF90_NOERR ) THEN istatus=NF90_INQUIRE(incid, ndimensions=idims) IF ( lexact ) THEN istatus=NF90_INQ_DIMID(incid, cdim_name, id_dim) IF (istatus /= NF90_NOERR ) THEN PRINT *,NF90_STRERROR(istatus) PRINT *,' Exact dimension name ', TRIM(cdim_name),' not found in ',TRIM(cdfile) ; STOP ENDIF istatus=NF90_INQUIRE_DIMENSION(incid, id_dim, len=getdim) IF ( PRESENT(cdtrue) ) cdtrue=cdim_name jdim = 0 ELSE ! scann all dims to look for a partial match DO jdim = 1, idims istatus=NF90_INQUIRE_DIMENSION(incid, jdim, name=clnam, len=getdim) IF ( INDEX(clnam, TRIM(cdim_name)) /= 0 ) THEN IF ( PRESENT(cdtrue) ) cdtrue=clnam EXIT ENDIF ENDDO ENDIF IF ( jdim > idims ) THEN ! dimension not found IF ( PRESENT(kstatus) ) kstatus=1 ! error send optionally to the calling program getdim=0 IF ( PRESENT(cdtrue) ) cdtrue='unknown' ENDIF ! first call IF ( ll_first ) THEN ll_first = .false. ! take the opportunity to initialize time_counter attributes : istatus = NF90_INQ_VARID(incid, cn_vtimec, idv ) IF ( istatus == NF90_NOERR ) THEN istatus = NF90_GET_ATT(incid, idv, 'units', ctime_units ) istatus = NF90_GET_ATT(incid, idv, 'time_origin', ctime_origin ) istatus = NF90_GET_ATT(incid, idv, 'calendar', calendar ) ENDIF ! read global attributes ! start_date cl_dum = Get_Env ( 'start_date' ) ! look for environment variable istatus = NF90_INQUIRE_ATTRIBUTE(incid, NF90_GLOBAL, 'start_date') IF ( istatus == NF90_NOERR ) THEN istatus = NF90_GET_ATT(incid, NF90_GLOBAL, 'start_date', nstart_date ) ELSE IF ( cl_dum /= '' ) THEN READ(cl_dum, * ) nstart_date ELSE nstart_date = -1 ENDIF ! output_frequency cl_dum = Get_Env ( 'output_frequency' ) ! look for environment variable istatus = NF90_INQUIRE_ATTRIBUTE(incid, NF90_GLOBAL, 'output_frequency') IF ( istatus == NF90_NOERR ) THEN istatus = NF90_GET_ATT(incid, NF90_GLOBAL, 'output_frequency', cfreq ) ELSE IF ( cl_dum /= '' ) THEN cfreq = TRIM(cl_dum) ELSE cfreq = 'N/A' ENDIF ! CONFIG cl_dum = Get_Env ( 'CONFIG' ) ! look for environment variable istatus = NF90_INQUIRE_ATTRIBUTE(incid, NF90_GLOBAL, 'CONFIG') IF ( istatus == NF90_NOERR ) THEN istatus = NF90_GET_ATT(incid, NF90_GLOBAL, 'CONFIG', config ) ELSE IF ( cl_dum /= '' ) THEN config = TRIM(cl_dum) ELSE config = 'N/A' ENDIF ! CASE cl_dum = Get_Env ( 'CASE' ) ! look for environment variable istatus = NF90_INQUIRE_ATTRIBUTE(incid, NF90_GLOBAL, 'CASE') IF ( istatus == NF90_NOERR ) THEN istatus = NF90_GET_ATT(incid, NF90_GLOBAL, 'CASE', ccase ) ELSE IF ( cl_dum /= '' ) THEN ccase = TRIM(cl_dum) ELSE ccase = 'N/A' ENDIF ENDIF istatus=NF90_CLOSE(incid) ELSE ! problem with the file IF ( PRESENT(cdtrue) ) cdtrue='unknown' IF ( PRESENT(kstatus) ) kstatus=1 ENDIF ! reset lexact to false for next call lexact=.false. END FUNCTION getdim REAL(KIND=4) FUNCTION getspval (cdfile, cdvar, cdmissing ) !!--------------------------------------------------------------------- !! *** FUNCTION getspval *** !! !! ** Purpose : return the SPVAL value of the variable cdvar in cdfile !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in ) :: cdfile ! File name to look at CHARACTER(LEN=*), INTENT(in ) :: cdvar ! variable name CHARACTER(LEN=*), OPTIONAL, INTENT(out) :: cdmissing ! missing att. name INTEGER(KIND=4) :: incid, id_var INTEGER(KIND=4) :: istatus INTEGER(KIND=4) :: jtry !!---------------------------------------------------------------------- IF ( PRESENT (cdmissing) ) cdmissing = cn_missing_value istatus=NF90_OPEN (cdfile, NF90_NOWRITE, incid ) istatus=NF90_INQ_VARID (incid, cdvar, id_var ) istatus=NF90_GET_ATT (incid, id_var, cn_missing_value, getspval ) IF ( istatus /= NF90_NOERR ) THEN DO jtry = 1, jp_missing_nm IF ( PRESENT (cdmissing) ) cdmissing = TRIM(cl_missing_nm(jtry)) istatus = NF90_GET_ATT (incid, id_var, cl_missing_nm(jtry) , getspval ) IF ( istatus == NF90_NOERR ) EXIT IF ( PRESENT (cdmissing) ) cdmissing = cn_missing_value getspval = 0. ENDDO ENDIF istatus=NF90_CLOSE (incid ) END FUNCTION getspval INTEGER(KIND=4) FUNCTION getvdim (cdfile, cdvar) !!--------------------------------------------------------------------- !! *** FUNCTION getvdim *** !! !! ** Purpose : Return the number of dimensions for variable cdvar in cdfile !! !! ** Method : Inquire for variable cdvar in cdfile. If found, !! determines the number of dimensions , assuming that variables !! are either (x,y,dep,time) or (x,y,time) !! If cdvar is not found, give an interactive choice for an existing !! variable, cdvar is then updated to this correct name. !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! File name to look at CHARACTER(LEN=*), INTENT(inout) :: cdvar ! variable name to look at. INTEGER(KIND=4) :: jvar INTEGER(KIND=4) :: istatus, incid, id_var, ivar, idi, istatus0 CHARACTER(LEN=256) :: clongname='long_name', clongn !!---------------------------------------------------------------------- CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,incid)) istatus0 = NF90_INQ_VARID ( incid,cdvar,id_var) DO WHILE ( istatus0 == NF90_ENOTVAR ) ivar=getnvar(cdfile) PRINT *, 'Give the number corresponding to the variable you want to work with ' DO jvar = 1, ivar clongn='' istatus=NF90_INQUIRE_VARIABLE (incid, jvar, cdvar, ndims=idi) istatus=NF90_GET_ATT (incid, jvar, clongname, clongn) IF (istatus /= NF90_NOERR ) clongn='unknown' PRINT *, jvar, ' ',TRIM(cdvar),' ',TRIM(clongn) ENDDO READ *,id_var istatus0=NF90_INQUIRE_VARIABLE (incid, id_var, cdvar, ndims=idi) ENDDO ! CALL ERR_HDL(NF90_INQUIRE_VARIABLE (incid, id_var, cdvar, ndims=idi)) getvdim = idi - 1 CALL ERR_HDL (NF90_CLOSE(incid)) END FUNCTION getvdim INTEGER(KIND=4) FUNCTION getnvar (cdfile) !!--------------------------------------------------------------------- !! *** FUNCTION getnvar *** !! !! ** Purpose : return the number of variables in cdfile !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! file to look at INTEGER(KIND=4) :: incid INTEGER(KIND=4) :: istatus !!---------------------------------------------------------------------- istatus = NF90_OPEN (cdfile, NF90_NOWRITE, incid ) istatus = NF90_INQUIRE (incid, nvariables = getnvar ) istatus = NF90_CLOSE (incid ) END FUNCTION getnvar FUNCTION getipk (cdfile,knvars,cdep) !!--------------------------------------------------------------------- !! *** FUNCTION getipk *** !! !! ** Purpose : Return the number of levels for all the variables !! in cdfile. Return 0 if the variable in 1d. !! !! ** Method : returns npk when 4D variables ( x,y,z,t ) !! returns 1 when 3D variables ( x,y, t ) !! returns 0 when other ( vectors ) !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! File to look at INTEGER(KIND=4), INTENT(in) :: knvars ! Number of variables in cdfile CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep ! optional depth dim name INTEGER(KIND=4), DIMENSION(knvars) :: getipk ! array (variables ) of levels INTEGER(KIND=4) :: incid, ipk, jv, iipk INTEGER(KIND=4) :: istatus CHARACTER(LEN=256) :: cldep='dep' !!---------------------------------------------------------------------- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,incid) IF ( PRESENT (cdep) ) cldep = cdep ! Note the very important TRIM below : if not, getdim crashes as it never find the correct dim ! iipk = getdim(cdfile, TRIM(cldep), kstatus=istatus) IF ( istatus /= 0 ) THEN PRINT *,' getipk : vertical dim not found ...assume 1' iipk=1 ENDIF DO jv = 1, knvars istatus=NF90_INQUIRE_VARIABLE(incid, jv, ndims=ipk) IF (ipk == 4 ) THEN getipk(jv) = iipk ELSE IF (ipk == 3 ) THEN getipk(jv) = 1 ELSE getipk(jv) = 0 ENDIF END DO istatus=NF90_CLOSE(incid) END FUNCTION getipk FUNCTION getvarname (cdfile, knvars, sdtypvar) !!--------------------------------------------------------------------- !! *** FUNCTION getvarname *** !! !! ** Purpose : return a character array with the knvars variable !! name corresponding to cdfile !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile INTEGER(KIND=4), INTENT(in) :: knvars ! Number of variables in cdfile TYPE (variable), DIMENSION (knvars) :: sdtypvar ! Retrieve variables attribute CHARACTER(LEN=256), DIMENSION(knvars) :: getvarname INTEGER(KIND=4) :: incid, jv, ilen INTEGER(KIND=4) :: istatus INTEGER(KIND=4) :: iatt REAL(KIND=4) :: zatt CHARACTER(LEN=256) :: cldum='' !!---------------------------------------------------------------------- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,incid) DO jv = 1, knvars istatus=NF90_INQUIRE_VARIABLE(incid, jv, name=getvarname(jv) ) sdtypvar(jv)%cname=getvarname(jv) ! look for standard attibutes IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'units', len=ilen) == NF90_NOERR ) THEN istatus=NF90_GET_ATT(incid, jv, 'units', cldum(1:ilen)) sdtypvar(jv)%cunits = TRIM(cldum) cldum = '' ELSE sdtypvar(jv)%cunits = 'N/A' ENDIF sdtypvar(jv)%rmissing_value = getspval ( cdfile, sdtypvar(jv)%cname ) IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'valid_min') == NF90_NOERR ) THEN istatus=NF90_GET_ATT(incid, jv, 'valid_min', zatt) sdtypvar(jv)%valid_min = zatt ELSE sdtypvar(jv)%valid_min = 0. ENDIF IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'valid_max') == NF90_NOERR ) THEN istatus=NF90_GET_ATT(incid, jv, 'valid_max', zatt) sdtypvar(jv)%valid_max = zatt ELSE sdtypvar(jv)%valid_max = 0. ENDIF IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'iweight') == NF90_NOERR ) THEN istatus=NF90_GET_ATT(incid, jv, 'iweight', iatt) sdtypvar(jv)%iwght = iatt ELSE sdtypvar(jv)%iwght = 1 ENDIF IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'long_name', len=ilen) == NF90_NOERR ) THEN istatus=NF90_GET_ATT(incid, jv, 'long_name', cldum(1:ilen)) sdtypvar(jv)%clong_name = TRIM(cldum) cldum = '' ELSE sdtypvar(jv)%clong_name = 'N/A' ENDIF IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'short_name', len=ilen) == NF90_NOERR ) THEN istatus=NF90_GET_ATT(incid, jv, 'short_name', cldum(1:ilen)) sdtypvar(jv)%cshort_name = TRIM(cldum) cldum = '' ELSE sdtypvar(jv)%cshort_name = 'N/A' ENDIF IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'online_operation', len=ilen) == NF90_NOERR ) THEN istatus=NF90_GET_ATT(incid, jv, 'online_operation', cldum(1:ilen)) sdtypvar(jv)%conline_operation = TRIM(cldum) cldum = '' ELSE sdtypvar(jv)%conline_operation = 'N/A' ENDIF IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'axis', len=ilen) == NF90_NOERR ) THEN istatus=NF90_GET_ATT(incid, jv, 'axis', cldum(1:ilen)) sdtypvar(jv)%caxis = TRIM(cldum) cldum = '' ELSE sdtypvar(jv)%caxis = 'N/A' ENDIF END DO istatus=NF90_CLOSE(incid) END FUNCTION getvarname FUNCTION getvar (cdfile,cdvar,klev,kpi,kpj,kimin,kjmin, ktime, ldiom) !!--------------------------------------------------------------------- !! *** FUNCTION getvar *** !! !! ** Purpose : Return the 2D REAL variable cvar, from cdfile at level klev. !! kpi,kpj are the horizontal size of the 2D variable !! !! ** Method : Initially a quite straigth forward function. But with the !! NEMO variation about the e3t in partial steps, I try to adapt !! the code to all existing mesh_zgr format, which reduces the !! readibility of the code. One my think of specific routine for !! getvar (e3._ps ...) !! !!--------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with INTEGER(KIND=4), OPTIONAL, INTENT(in) :: klev ! Optional variable. If missing 1 is assumed INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! horizontal size of the 2D variable INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kimin, kjmin ! Optional variable. If missing 1 is assumed INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed LOGICAL, OPTIONAL, INTENT(in) :: ldiom ! Optional variable. If missing false is assumed REAL(KIND=4), DIMENSION(kpi,kpj) :: getvar ! 2D REAL 4 holding variable field at klev INTEGER(KIND=4), DIMENSION(4) :: istart, icount, inldim INTEGER(KIND=4) :: incid, id_var, id_dimunlim, inbdim INTEGER(KIND=4) :: istatus, ilev, imin, jmin INTEGER(KIND=4) :: itime, ilog, ipiglo, imax INTEGER(KIND=4), SAVE :: ii, ij, ik0, ji, jj, ik1, ik REAL(KIND=4) :: sf=1., ao=0. !: Scale factor and add_offset REAL(KIND=4) :: spval !: missing value REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: zend, zstart CHARACTER(LEN=256) :: clvar LOGICAL :: lliom=.false., llperio=.false. LOGICAL :: llog=.FALSE. , lsf=.FALSE. , lao=.FALSE. !!--------------------------------------------------------------------- llperio=.false. IF (PRESENT(klev) ) THEN ilev=klev ELSE ilev=1 ENDIF IF (PRESENT(kimin) ) THEN imin=kimin ipiglo=getdim(cdfile, cn_x, ldexact=.true.) IF (imin+kpi-1 > ipiglo ) THEN llperio=.true. imax=kpi+1 +imin -ipiglo ENDIF ELSE imin=1 ENDIF IF (PRESENT(kjmin) ) THEN jmin=kjmin ELSE jmin=1 ENDIF IF (PRESENT(ktime) ) THEN itime=ktime ELSE itime=1 ENDIF IF (PRESENT(ldiom) ) THEN lliom=ldiom ELSE lliom=.false. ENDIF clvar=cdvar ! Must reset the flags to false for every call to getvar llog = .FALSE. lsf = .FALSE. lao = .FALSE. CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,incid) ) IF ( lliom) THEN ! try to detect if input file is a zgr IOM file, looking for e3t_0 istatus=NF90_INQ_VARID( incid,'e3t_0', id_var) IF ( istatus == NF90_NOERR ) THEN ! iom file , change names ! now try to detect if it is v2 or v3, in v3, e3t_ps exist and is a 2d variable istatus=NF90_INQ_VARID( incid,'e3t_ps', id_var) IF ( istatus == NF90_NOERR ) THEN ! case of NEMO_v3 zfr files ! look for mbathy and out it in memory, once for all IF ( .NOT. l_mbathy ) THEN PRINT *,'MESH_ZGR V3 detected' l_mbathy=.true. istatus=NF90_INQ_DIMID(incid,'x',id_var) ; istatus=NF90_INQUIRE_DIMENSION(incid,id_var, len=ii ) istatus=NF90_INQ_DIMID(incid,'y',id_var) ; istatus=NF90_INQUIRE_DIMENSION(incid,id_var, len=ij ) istatus=NF90_INQ_DIMID(incid,'z',id_var) ; istatus=NF90_INQUIRE_DIMENSION(incid,id_var, len=ik0) ALLOCATE( mbathy(ii,ij)) ! mbathy is allocated on the whole domain ALLOCATE( e3t_ps(ii,ij),e3w_ps(ii,ij)) ! e3._ps are allocated on the whole domain ALLOCATE( e3t_0(ik0), e3w_0(ik0) ) ! whole depth istatus=NF90_INQ_VARID (incid,'mbathy', id_var) IF ( istatus /= NF90_NOERR ) THEN PRINT *, 'Problem reading mesh_zgr.nc v3 : no mbathy found !' ; STOP ENDIF istatus=NF90_GET_VAR(incid,id_var, mbathy, start=(/1,1,1/), count=(/ii,ij,1/) ) ! istatus=NF90_INQ_VARID (incid,'e3t_ps', id_var) IF ( istatus /= NF90_NOERR ) THEN PRINT *, 'Problem reading mesh_zgr.nc v3 : no e3t_ps found !' ; STOP ENDIF istatus=NF90_GET_VAR(incid,id_var,e3t_ps, start=(/1,1,1/), count=(/ii,ij,1/) ) ! istatus=NF90_INQ_VARID (incid,'e3w_ps', id_var) IF ( istatus /= NF90_NOERR ) THEN PRINT *, 'Problem reading mesh_zgr.nc v3 : no e3w_ps found !' ; STOP ENDIF istatus=NF90_GET_VAR(incid,id_var,e3w_ps, start=(/1,1,1/), count=(/ii,ij,1/) ) ! istatus=NF90_INQ_VARID (incid,'e3t_0', id_var) IF ( istatus /= NF90_NOERR ) THEN PRINT *, 'Problem reading mesh_zgr.nc v3 : no e3t_0 found !' ; STOP ENDIF istatus=NF90_GET_VAR(incid,id_var,e3t_0, start=(/1,1/), count=(/ik0,1/) ) ! istatus=NF90_INQ_VARID (incid,'e3w_0', id_var) IF ( istatus /= NF90_NOERR ) THEN PRINT *, 'Problem reading mesh_zgr.nc v3 : no e3w_0 found !' ; STOP ENDIF istatus=NF90_GET_VAR(incid,id_var,e3w_0, start=(/1,1/), count=(/ik0,1/) ) DO ji=1,ii DO jj=1,ij IF ( e3t_ps (ji,jj) == 0 .AND. mbathy(ji,jj) /= 0 ) e3t_ps(ji,jj)=e3t_0(mbathy(ji,jj)) END DO END DO ENDIF ! zgr v3 SELECT CASE ( clvar ) CASE ('e3u_ps') ; clvar='e3t_ps' CASE ('e3v_ps') ; clvar='e3t_ps' CASE ('e3w_ps') ; clvar='e3w_ps' END SELECT ELSE ! zgr v2 SELECT CASE ( clvar ) CASE ('e3t_ps') ; clvar='e3t' CASE ('e3u_ps') ; clvar='e3u' CASE ('e3v_ps') ; clvar='e3v' CASE ('e3w_ps') ; clvar='e3w' END SELECT ENDIF ENDIF ENDIF istatus=NF90_INQUIRE(incid, unlimitedDimId=id_dimunlim) CALL ERR_HDL(NF90_INQ_VARID ( incid,clvar,id_var)) ! look for time dim in variable inldim=0 istatus=NF90_INQUIRE_VARIABLE(incid, id_var, ndims=inbdim,dimids=inldim(:) ) istart(1) = imin istart(2) = jmin ! JMM ! it workd for X Y Z T file, not for X Y T .... try to found a fix ! IF ( inldim(3) == id_dimunlim ) THEN istart(3) = itime istart(4) = 1 ELSE istart(3) = ilev istart(4) = itime ENDIF icount(1)=kpi icount(2)=kpj icount(3)=1 icount(4)=1 spval = getspval ( cdfile, cdvar) ! try many kind of missing_value (eg _FillValue _Fillvalue Fillvalue ...) istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'savelog10') IF (istatus == NF90_NOERR ) THEN ! there is a scale factor for this variable istatus=NF90_GET_ATT(incid,id_var,'savelog10',ilog) IF ( ilog /= 0 ) llog=.TRUE. ENDIF istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'scale_factor') IF (istatus == NF90_NOERR ) THEN ! there is a scale factor for this variable istatus=NF90_GET_ATT(incid,id_var,'scale_factor',sf) IF ( sf /= 1. ) lsf=.TRUE. ENDIF istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'add_offset') IF (istatus == NF90_NOERR ) THEN ! there is a scale factor for this variable istatus=NF90_GET_ATT(incid,id_var,'add_offset', ao) IF ( ao /= 0.) lao=.TRUE. ENDIF IF (llperio ) THEN ALLOCATE (zend (ipiglo-imin,kpj), zstart(imax-1,kpj) ) IF (l_mbathy .AND. & & ( cdvar == 'e3t_ps' .OR. cdvar == 'e3w_ps' .OR. cdvar == 'e3u_ps' .OR. cdvar == 'e3v_ps')) THEN istatus=0 clvar=cdvar SELECT CASE ( clvar ) CASE ( 'e3t_ps', 'e3u_ps', 'e3v_ps' ) DO ji=1,ipiglo-imin DO jj=1,kpj ik=mbathy(imin+ji-1, jmin+jj-1) IF (ilev == ik ) THEN zend(ji,jj)=e3t_ps(imin+ji-1, jmin+jj-1) ELSE zend(ji,jj)=e3t_0(ilev) ENDIF END DO END DO DO ji=1,imax-1 DO jj=1,kpj ik=mbathy(ji+1, jmin+jj-1) IF (ilev == ik ) THEN zstart(ji,jj)=e3t_ps(ji+1, jmin+jj-1) ELSE zstart(ji,jj)=e3t_0(ilev) ENDIF END DO END DO getvar(1:ipiglo-imin,:)=zend getvar(ipiglo-imin+1:kpi,:)=zstart IF (clvar == 'e3u_ps') THEN DO ji=1,kpi-1 DO jj=1,kpj getvar(ji,jj)=MIN(getvar(ji,jj),getvar(ji+1,jj)) END DO END DO ! not very satisfactory but still.... getvar(kpi,:)=getvar(kpi-1,:) ENDIF IF (clvar == 'e3v_ps') THEN DO ji=1,kpi DO jj=1,kpj-1 getvar(ji,jj)=MIN(getvar(ji,jj),getvar(ji,jj+1)) END DO END DO ! not very satisfactory but still.... getvar(:,kpj)=getvar(:,kpj-1) ENDIF CASE ( 'e3w_ps') DO ji=1,ipiglo-imin DO jj=1,kpj ik=mbathy(imin+ji-1, jmin+jj-1) IF (ilev == ik ) THEN zend(ji,jj)=e3w_ps(imin+ji-1, jmin+jj-1) ELSE zend(ji,jj)=e3w_0(ilev) ENDIF END DO END DO DO ji=1,imax-1 DO jj=1,kpj ik=mbathy(ji+1, jmin+jj-1) IF (ilev == ik ) THEN zstart(ji,jj)=e3w_ps(ji+1, jmin+jj-1) ELSE zstart(ji,jj)=e3w_0(ilev) ENDIF END DO END DO getvar(1:ipiglo-imin,:)=zend getvar(ipiglo-imin+1:kpi,:)=zstart END SELECT ELSE istatus=NF90_GET_VAR(incid,id_var,zend, start=(/imin,jmin,ilev,itime/),count=(/ipiglo-imin,kpj,1,1/)) istatus=NF90_GET_VAR(incid,id_var,zstart, start=(/2,jmin,ilev,itime/),count=(/imax-1,kpj,1,1/)) getvar(1:ipiglo-imin,:)=zend getvar(ipiglo-imin+1:kpi,:)=zstart ENDIF DEALLOCATE(zstart, zend ) ELSE IF (l_mbathy .AND. & & ( cdvar == 'e3t_ps' .OR. cdvar == 'e3w_ps' .OR. cdvar == 'e3u_ps' .OR. cdvar == 'e3v_ps')) THEN istatus=0 clvar=cdvar SELECT CASE ( clvar ) CASE ( 'e3t_ps', 'e3u_ps', 'e3v_ps' ) DO ji=1,kpi DO jj=1,kpj ik=mbathy(imin+ji-1, jmin+jj-1) IF (ilev == ik ) THEN getvar(ji,jj)=e3t_ps(imin+ji-1, jmin+jj-1) ELSE getvar(ji,jj)=e3t_0(ilev) ENDIF END DO END DO IF (clvar == 'e3u_ps') THEN DO ji=1,kpi-1 DO jj=1,kpj getvar(ji,jj)=MIN(getvar(ji,jj),getvar(ji+1,jj)) END DO END DO ! not very satisfactory but still.... getvar(kpi,:)=getvar(2,:) ENDIF IF (clvar == 'e3v_ps') THEN DO ji=1,kpi DO jj=1,kpj-1 getvar(ji,jj)=MIN(getvar(ji,jj),getvar(ji,jj+1)) END DO END DO ! not very satisfactory but still.... IF ( kpj /= 1 ) getvar(:,kpj)=getvar(:,kpj-1) ENDIF CASE ( 'e3w_ps') DO ji=1,kpi DO jj=1,kpj ik=mbathy(imin+ji-1, jmin+jj-1) IF (ilev == ik ) THEN getvar(ji,jj)=e3w_ps(imin+ji-1, jmin+jj-1) ELSE getvar(ji,jj)=e3w_0(ilev) ENDIF END DO END DO END SELECT ELSE istatus=NF90_GET_VAR(incid,id_var,getvar, start=istart,count=icount) ENDIF ENDIF IF ( istatus /= 0 ) THEN PRINT *,' Problem in getvar for ', TRIM(clvar) CALL ERR_HDL(istatus) STOP ENDIF ! Caution : order does matter ! IF (lsf ) WHERE (getvar /= spval ) getvar=getvar*sf IF (lao ) WHERE (getvar /= spval ) getvar=getvar + ao IF (llog) WHERE (getvar /= spval ) getvar=10**getvar istatus=NF90_CLOSE(incid) END FUNCTION getvar FUNCTION getvarxz (cdfile, cdvar, kj, kpi, kpz, kimin, kkmin, ktime) !!------------------------------------------------------------------------- !! *** FUNCTION getvar *** !! !! ** Purpose : Return the 2D REAL variable x-z slab cvar, from cdfile at j=kj !! kpi,kpz are the size of the 2D variable !! !!------------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with INTEGER(KIND=4), INTENT(in) :: kj ! Optional variable. If missing 1 is assumed INTEGER(KIND=4), INTENT(in) :: kpi, kpz ! size of the 2D variable INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kimin, kkmin ! Optional variable. If missing 1 is assumed INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed REAL(KIND=4), DIMENSION(kpi,kpz) :: getvarxz ! 2D REAL 4 holding variable x-z slab at kj INTEGER(KIND=4), DIMENSION(4) :: istart, icount INTEGER(KIND=4) :: incid, id_var INTEGER(KIND=4) :: istatus, ilev, imin, kmin INTEGER(KIND=4) :: itime, ilog INTEGER(KIND=4) :: idum REAL(KIND=4) :: sf=1., ao=0. ! Scale factor and add_offset REAL(KIND=4) :: spval ! Missing values LOGICAL :: llog=.FALSE. , lsf=.FALSE. , lao=.FALSE. !!------------------------------------------------------------------------- IF (PRESENT(kimin) ) THEN imin=kimin ELSE imin=1 ENDIF IF (PRESENT(kkmin) ) THEN kmin=kkmin ELSE kmin=1 ENDIF IF (PRESENT(ktime) ) THEN itime=ktime ELSE itime=1 ENDIF ! Must reset the flags to false for every call to getvar llog=.FALSE. lsf=.FALSE. lao=.FALSE. CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,incid) ) CALL ERR_HDL(NF90_INQ_VARID ( incid,cdvar,id_var)) spval = getspval ( cdfile, cdvar ) istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'savelog10') IF (istatus == NF90_NOERR ) THEN ! there is a scale factor for this variable istatus=NF90_GET_ATT(incid,id_var,'savelog10',ilog) IF ( ilog /= 0 ) llog=.TRUE. ENDIF istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'scale_factor') IF (istatus == NF90_NOERR ) THEN ! there is a scale factor for this variable istatus=NF90_GET_ATT(incid,id_var,'scale_factor',sf) IF ( sf /= 1. ) lsf=.TRUE. ENDIF istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'add_offset') IF (istatus == NF90_NOERR ) THEN ! there is a scale factor for this variable istatus=NF90_GET_ATT(incid,id_var,'add_offset',ao) IF ( ao /= 0.) lao=.TRUE. ENDIF ! detect if there is a y dimension in cdfile istatus=NF90_INQ_DIMID(incid,'y',idum) IF ( istatus == NF90_NOERR ) THEN ! the file has a 'y' dimension istart=(/imin,kj,kmin,itime/) ! JMM ! it workd for X Y Z T file, not for X Y T .... try to found a fix ! icount=(/kpi,1,kpz,1/) ELSE ! no y dimension istart=(/imin,kmin,itime,1/) icount=(/kpi,kpz,1,1/) ENDIF istatus=NF90_GET_VAR(incid,id_var,getvarxz, start=istart,count=icount) IF ( istatus /= 0 ) THEN PRINT *,' Problem in getvarxz for ', TRIM(cdvar) CALL ERR_HDL(istatus) STOP ENDIF ! Caution : order does matter ! IF (lsf ) WHERE (getvarxz /= spval ) getvarxz=getvarxz*sf IF (lao ) WHERE (getvarxz /= spval ) getvarxz=getvarxz + ao IF (llog) WHERE (getvarxz /= spval ) getvarxz=10**getvarxz istatus=NF90_CLOSE(incid) END FUNCTION getvarxz FUNCTION getvaryz (cdfile, cdvar, ki, kpj, kpz, kjmin, kkmin, ktime) !!------------------------------------------------------------------------- !! *** FUNCTION getvar *** !! !! ** Purpose : Return the 2D REAL variable y-z slab cvar, from cdfile at i=ki !! kpj,kpz are the size of the 2D variable !! !!------------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with INTEGER(KIND=4), INTENT(in) :: ki ! INTEGER(KIND=4), INTENT(in) :: kpj,kpz ! size of the 2D variable INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kjmin, kkmin ! Optional variable. If missing 1 is assumed INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed REAL(KIND=4), DIMENSION(kpj,kpz) :: getvaryz ! 2D REAL 4 holding variable x-z slab at kj INTEGER(KIND=4), DIMENSION(4) :: istart, icount INTEGER(KIND=4) :: incid, id_var INTEGER(KIND=4) :: istatus, ilev, jmin, kmin INTEGER(KIND=4) :: itime, ilog INTEGER(KIND=4) :: idum REAL(KIND=4) :: sf=1., ao=0. ! Scale factor and add_offset REAL(KIND=4) :: spval ! Missing values LOGICAL :: llog=.FALSE. , lsf=.FALSE. , lao=.FALSE. !!------------------------------------------------------------------------- IF (PRESENT(kjmin) ) THEN jmin=kjmin ELSE jmin=1 ENDIF IF (PRESENT(kkmin) ) THEN kmin=kkmin ELSE kmin=1 ENDIF IF (PRESENT(ktime) ) THEN itime=ktime ELSE itime=1 ENDIF ! Must reset the flags to false for every call to getvar llog=.FALSE. lsf=.FALSE. lao=.FALSE. CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,incid) ) CALL ERR_HDL(NF90_INQ_VARID ( incid,cdvar,id_var)) spval = getspval ( cdfile, cdvar ) istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'savelog10') IF (istatus == NF90_NOERR ) THEN ! there is a scale factor for this variable istatus=NF90_GET_ATT(incid,id_var,'savelog10',ilog) IF ( ilog /= 0 ) llog=.TRUE. ENDIF istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'scale_factor') IF (istatus == NF90_NOERR ) THEN ! there is a scale factor for this variable istatus=NF90_GET_ATT(incid,id_var,'scale_factor',sf) IF ( sf /= 1. ) lsf=.TRUE. ENDIF istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'add_offset') IF (istatus == NF90_NOERR ) THEN ! there is a scale factor for this variable istatus=NF90_GET_ATT(incid,id_var,'add_offset', ao) IF ( ao /= 0.) lao=.TRUE. ENDIF ! detect if there is a x dimension in cdfile istatus=NF90_INQ_DIMID(incid,'x',idum) IF ( istatus == NF90_NOERR ) THEN ! the file has a 'x' dimension istart=(/ki,jmin,kmin,itime/) ! JMM ! it workd for X Y Z T file, not for X Y T .... try to found a fix ! icount=(/1,kpj,kpz,1/) ELSE ! no x dimension istart=(/jmin,kmin,itime,1/) icount=(/kpj,kpz,1,1/) ENDIF istatus=NF90_GET_VAR(incid,id_var,getvaryz, start=istart,count=icount) IF ( istatus /= 0 ) THEN PRINT *,' Problem in getvaryz for ', TRIM(cdvar) CALL ERR_HDL(istatus) STOP ENDIF ! Caution : order does matter ! IF (lsf ) WHERE (getvaryz /= spval ) getvaryz=getvaryz*sf IF (lao ) WHERE (getvaryz /= spval ) getvaryz=getvaryz + ao IF (llog) WHERE (getvaryz /= spval ) getvaryz=10**getvaryz istatus=NF90_CLOSE(incid) END FUNCTION getvaryz FUNCTION getvar1d (cdfile, cdvar, kk, kstatus) !!------------------------------------------------------------------------- !! *** FUNCTION getvar1d *** !! !! ** Purpose : return 1D variable cdvar from cdfile, of size kk !! !!------------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with INTEGER(KIND=4), INTENT(in) :: kk ! size of 1D vector to be returned INTEGER(KIND=4), OPTIONAL, INTENT(out) :: kstatus ! return status concerning the variable existence REAL(KIND=4), DIMENSION(kk) :: getvar1d ! real returned vector INTEGER(KIND=4), DIMENSION(1) :: istart, icount INTEGER(KIND=4) :: incid, id_var INTEGER(KIND=4) :: istatus !!------------------------------------------------------------------------- istart(:) = 1 icount(1)=kk IF ( PRESENT(kstatus) ) kstatus = 0 istatus=NF90_OPEN(cdfile,NF90_NOWRITE,incid) istatus=NF90_INQ_VARID ( incid,cdvar,id_var) IF ( istatus == NF90_NOERR ) THEN istatus=NF90_GET_VAR(incid,id_var,getvar1d,start=istart,count=icount) ELSE IF ( PRESENT(kstatus) ) kstatus= istatus getvar1d=99999999999. ENDIF istatus=NF90_CLOSE(incid) END FUNCTION getvar1d FUNCTION getvare3 (cdfile,cdvar,kk) !!------------------------------------------------------------------------- !! *** FUNCTION getvare3 *** !! !! ** Purpose : Special routine for e3, which in fact is a 1D variable !! but defined as e3 (1,1,npk,1) in coordinates.nc (!!) !! !!------------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with INTEGER(KIND=4), INTENT(in) :: kk ! size of 1D vector to be returned REAL(KIND=4), DIMENSION(kk) :: getvare3 ! return e3 variable form the coordinate file INTEGER(KIND=4), DIMENSION(4) :: istart, icount INTEGER(KIND=4) :: incid, id_var INTEGER(KIND=4) :: istatus CHARACTER(LEN=256) :: clvar ! local name for cdf var (modified) !!------------------------------------------------------------------------- istart(:) = 1 icount(:) = 1 icount(3)=kk clvar=cdvar istatus=NF90_OPEN(cdfile,NF90_NOWRITE,incid) ! check for IOM style mesh_zgr or coordinates : ! IOIPSL (x_a=y_a=1) IOM ! gdept(time,z,y_a,x_a) gdept_0(t,z) ! gdepw(time,z,y_a,x_a) gdepw_0(t,z) ! e3t(time,z,y_a,x_a) e3t_0(t,z) ! e3w(time,z,y_a,x_a) e3w_0(t,z) istatus=NF90_INQ_VARID ( incid,'e3t_0',id_var) IF ( istatus == NF90_NOERR) THEN icount(1)=kk ; icount(3)=1 SELECT CASE (clvar) CASE ('gdepw') clvar='gdepw_0' CASE ('gdept') clvar='gdept_0' CASE ('e3t') clvar='e3t_0' CASE ('e3w') clvar='e3w_0' END SELECT ENDIF istatus=NF90_INQ_VARID ( incid,clvar,id_var) istatus=NF90_GET_VAR(incid,id_var,getvare3,start=istart,count=icount) IF ( istatus /= 0 ) THEN PRINT *,' Problem in getvare3 for ', TRIM(cdvar) PRINT *,TRIM(cdfile), kk CALL ERR_HDL(istatus) STOP ENDIF istatus=NF90_CLOSE(incid) END FUNCTION getvare3 INTEGER(KIND=4) FUNCTION putheadervar(kout, cdfile, kpi, kpj, kpk, pnavlon, pnavlat , pdep, cdep, ld_xycoo) !!--------------------------------------------------------------------- !! *** FUNCTION putheadervar *** !! !! ** Purpose : copy header variables from cdfile to the already open ncfile (ncid=kout) !! !! ** Method : header variables are nav_lat, nav_lon and either (deptht, depthu, or depthv ) !! Even if the use of different variable name for deptht, depthu depthv is !! one of the many non sense of IOIPSL, we are forced to stick with ! !! (Note that these 3 depth are identical in OPA. On the other hand, nav_lon, nav_lat !! differ for U and V and T points but have the same variable name). !! If pnavlon and pnavlat are provided as arguments, they are used for nav_lon, nav_lat !! instead of the nav_lon,nav_lat read on the file cdfile. !! !! ** Action : header variables for file kout is copied from cdfile !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout ! ncid of the outputfile (already open ) CHARACTER(LEN=*), INTENT(in) :: cdfile ! file from where the headers will be copied INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of nav_lon (kpi,kpj) INTEGER(KIND=4), INTENT(in) :: kpk ! dimension of depht(kpk) LOGICAL, OPTIONAL, INTENT(in) :: ld_xycoo ! option to put yx info REAL(KIND=4), OPTIONAL, DIMENSION(kpi,kpj), INTENT(in) :: pnavlon ! array provided optionaly to overrid the REAL(KIND=4), OPTIONAL, DIMENSION(kpi,kpj), INTENT(in) :: pnavlat ! corresponding arrays in cdfile REAL(KIND=4), OPTIONAL, DIMENSION(kpk), INTENT(in) :: pdep ! dep array if not on cdfile CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep ! optional name of vertical variable INTEGER(KIND=4), PARAMETER :: jpdep=6 INTEGER(KIND=4) :: istatus, idep, jj REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: z2d REAL(KIND=4), DIMENSION(kpk) :: z1d CHARACTER(LEN=256), DIMENSION(jpdep ) :: cldept= (/'deptht ','depthu ','depthv ','depthw ','nav_lev','z '/) CHARACTER(LEN=256) :: cldep LOGICAL :: ll_xycoo !!---------------------------------------------------------------------- IF (PRESENT(ld_xycoo) ) THEN ll_xycoo = ld_xycoo ELSE ll_xycoo = .true. ENDIF cldept = (/cn_vdeptht, cn_vdepthu, cn_vdepthv, cn_vdepthw,'nav_lev','z '/) IF ( ll_xycoo ) THEN ALLOCATE ( z2d (kpi,kpj) ) IF (PRESENT(pnavlon) ) THEN z2d = pnavlon ELSE IF ( chkvar ( cdfile, cn_vlon2d )) THEN PRINT *, '... dummy value used!' z2d = 0. ELSE z2d=getvar(cdfile,cn_vlon2d, 1,kpi,kpj) ENDIF ENDIF istatus = putvar(kout, nid_lon,z2d,1,kpi,kpj) IF (PRESENT(pnavlat) ) THEN z2d = pnavlat ELSE IF ( chkvar ( cdfile, cn_vlat2d )) THEN PRINT *, '... dummy value used!' z2d = 0. ELSE z2d=getvar(cdfile,cn_vlat2d, 1,kpi,kpj) ENDIF ENDIF istatus = putvar(kout, nid_lat,z2d,1,kpi,kpj) DEALLOCATE (z2d) ENDIF IF (kpk /= 0 ) THEN IF (PRESENT(pdep) ) THEN z1d = pdep ELSE idep = NF90_NOERR IF ( PRESENT (cdep)) THEN z1d=getvar1d(cdfile,cdep,kpk,idep) ENDIF IF ( .NOT. PRESENT(cdep) .OR. idep /= NF90_NOERR ) THEN ! look for standard dep name DO jj = 1,jpdep cldep=cldept(jj) z1d=getvar1d(cdfile,cldep,kpk,idep) IF ( idep == NF90_NOERR ) EXIT END DO IF (jj == jpdep +1 ) THEN PRINT *,' No depth variable found in ', TRIM(cdfile) STOP ENDIF ENDIF ENDIF istatus = putvar1d(kout,z1d,kpk,'D') ENDIF putheadervar=istatus END FUNCTION putheadervar INTEGER(KIND=4) FUNCTION putvarr8(kout, kid, ptab, klev, kpi, kpj, ktime, kwght) !!--------------------------------------------------------------------- !! *** FUNCTION putvarr8 *** !! !! ** Purpose : copy a 2D level of ptab in already open file kout, !! using variable kid !! !! ** Method : this corresponds to the generic function putvar with r8 arg. !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file INTEGER(KIND=4), INTENT(in) :: kid ! varid of output variable REAL(KIND=8), DIMENSION(kpi,kpj), INTENT(in) :: ptab ! 2D array to write in file INTEGER(KIND=4), INTENT(in) :: klev ! level at which ptab will be written INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of ptab INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! dimension of ptab INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kwght ! weight of this variable INTEGER(KIND=4) :: istatus, itime, id_dimunlim INTEGER(KIND=4), DIMENSION(4) :: istart, icount, inldim !!---------------------------------------------------------------------- IF (PRESENT(ktime) ) THEN itime=ktime ELSE itime=1 ENDIF ! Look for a unlimited dimension istatus=NF90_INQUIRE(kout, unlimitedDimId = id_dimunlim) inldim(:) = 0 istart(:) = 1 istatus=NF90_INQUIRE_VARIABLE(kout, kid, dimids = inldim(:) ) IF ( inldim(3) == id_dimunlim) THEN ! this is a x,y,t file istart(3)=itime ; istart(4)=1 ELSE istart(3)=klev ; istart(4)=itime ! this is a x,y,z, t file ENDIF icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj istatus=NF90_PUT_VAR(kout,kid, ptab, start=istart,count=icount) IF (PRESENT(kwght) ) THEN istatus=NF90_PUT_ATT(kout, kid, 'iweight', kwght) ENDIF putvarr8=istatus END FUNCTION putvarr8 INTEGER(KIND=4) FUNCTION putvarr4(kout, kid, ptab, klev, kpi, kpj, ktime, kwght) !!--------------------------------------------------------------------- !! *** FUNCTION putvarr4 *** !! !! ** Purpose : copy a 2D level of ptab in already open file kout, !! using variable kid !! !! ** Method : this corresponds to the generic function putvar with r4 arg. !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file INTEGER(KIND=4), INTENT(in) :: kid ! varid of output variable REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptab ! 2D array to write in file INTEGER(KIND=4), INTENT(in) :: klev ! level at which ptab will be written INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of ptab INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! dimension of ptab INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kwght ! weight of this variable INTEGER(KIND=4) :: istatus, itime, id_dimunlim INTEGER(KIND=4), DIMENSION(4) :: istart, icount, inldim !!---------------------------------------------------------------------- IF (PRESENT(ktime) ) THEN itime=ktime ELSE itime=1 ENDIF ! Look for a unlimited dimension istatus=NF90_INQUIRE(kout, unlimitedDimId = id_dimunlim) inldim(:) = 0 istart(:) = 1 istatus=NF90_INQUIRE_VARIABLE(kout, kid, dimids = inldim(:) ) IF ( inldim(3) == id_dimunlim) THEN ! this is a x,y,t file istart(3)=itime ; istart(4)=1 ELSE istart(3)=klev ; istart(4)=itime ! this is a x,y,z, t file ENDIF icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj istatus=NF90_PUT_VAR(kout,kid, ptab, start=istart,count=icount) IF (PRESENT(kwght) ) THEN istatus=NF90_PUT_ATT(kout, kid, 'iweight', kwght) ENDIF putvarr4=istatus END FUNCTION putvarr4 INTEGER(KIND=4) FUNCTION putvari2(kout, kid, ktab, klev, kpi, kpj, ktime, kwght) !!--------------------------------------------------------------------- !! *** FUNCTION putvari2 *** !! !! ** Purpose : copy a 2D level of ptab in already open file kout, !! using variable kid !! !! ** Method : this corresponds to the generic function putvar with i2 arg. !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file INTEGER(KIND=4), INTENT(in) :: kid ! varid of output variable INTEGER(KIND=2), DIMENSION(kpi,kpj), INTENT(in) :: ktab ! 2D array to write in file INTEGER(KIND=4), INTENT(in) :: klev ! level at which ktab will be written INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of ktab INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! dimension of ktab INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kwght ! weight of this variable INTEGER(KIND=4) :: istatus, itime, id_dimunlim INTEGER(KIND=4), DIMENSION(4) :: istart, icount, inldim !!---------------------------------------------------------------------- IF (PRESENT(ktime) ) THEN itime=ktime ELSE itime=1 ENDIF ! Look for a unlimited dimension istatus=NF90_INQUIRE(kout, unlimitedDimId = id_dimunlim) inldim(:) = 0 istart(:) = 1 istatus=NF90_INQUIRE_VARIABLE(kout, kid, dimids = inldim(:) ) IF ( inldim(3) == id_dimunlim) THEN ! this is a x,y,t file istart(3)=itime ; istart(4)=1 ELSE istart(3)=klev ; istart(4)=itime ! this is a x,y,z, t file ENDIF icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj istatus=NF90_PUT_VAR(kout,kid, ktab, start=istart,count=icount) IF (PRESENT(kwght) ) THEN istatus=NF90_PUT_ATT(kout, kid, 'iweight', kwght) ENDIF putvari2=istatus END FUNCTION putvari2 INTEGER(KIND=4) FUNCTION reputvarr4 (cdfile, cdvar, klev, kpi, kpj, kimin, kjmin, ktime, ptab, kwght) !!--------------------------------------------------------------------- !! *** FUNCTION reputvarr4 *** !! !! ** Purpose : Change an existing variable in inputfile !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with INTEGER(KIND=4), OPTIONAL, INTENT(in) :: klev ! Optional variable. If missing 1 is assumed INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! horizontal size of the 2D variable INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kimin, kjmin ! Optional variable. If missing 1 is assumed INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptab ! 2D REAL 4 holding variable field at klev INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kwght ! weight of this variable INTEGER(KIND=4), DIMENSION(4) :: istart, icount, inldim INTEGER(KIND=4) :: incid, id_var, id_dimunlim INTEGER(KIND=4) :: istatus, ilev, iimin, ijmin, itime !!---------------------------------------------------------------------- ilev = 1 ; IF (PRESENT(klev ) ) ilev = klev iimin = 1 ; IF (PRESENT(kimin) ) iimin = kimin ijmin = 1 ; IF (PRESENT(kjmin) ) ijmin = kjmin itime = 1 ; IF (PRESENT(ktime) ) itime = ktime istatus=NF90_OPEN(cdfile,NF90_WRITE,incid) istatus=NF90_INQ_VARID(incid,cdvar,id_var) !! look for eventual unlimited dim (time_counter) istatus=NF90_INQUIRE(incid, unlimitedDimId=id_dimunlim) inldim=0 istatus=NF90_INQUIRE_VARIABLE(incid, id_var,dimids=inldim(:) ) ! if the third dim of id_var is time, then adjust the starting point ! to take ktime into account (case XYT file) IF ( inldim(3) == id_dimunlim) THEN ; ilev=itime ; itime=1 ; ENDIF istatus=NF90_PUT_VAR(incid,id_var, ptab,start=(/iimin,ijmin,ilev,itime/), count=(/kpi,kpj,1,1/) ) IF (PRESENT(kwght)) THEN istatus=NF90_PUT_ATT(incid,id_var,'iweight',kwght) ENDIF reputvarr4=istatus istatus=NF90_CLOSE(incid) END FUNCTION reputvarr4 INTEGER(KIND=4) FUNCTION putvarzo(kout, kid, ptab, klev, kpi, kpj, ktime) !!--------------------------------------------------------------------- !! *** FUNCTION putvarzo *** !! !! ** Purpose : Copy a 2D level of ptab in already open file kout, using variable kid !! This variant deals with degenerated 2D (1 x jpj) zonal files !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file INTEGER(KIND=4), INTENT(in) :: kid ! varid of output variable REAL(KIND=4), DIMENSION(kpj), INTENT(in) :: ptab ! 2D array to write in file INTEGER(KIND=4), INTENT(in) :: klev ! level at which ptab will be written INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of ptab INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! time to write INTEGER(KIND=4) :: istatus, itime, ilev, id_dimunlim INTEGER(KIND=4), DIMENSION(4) :: istart, icount,inldim !!---------------------------------------------------------------------- ilev=klev IF (PRESENT(ktime) ) THEN itime=ktime ELSE itime=1 ENDIF ! look for unlimited dim (time_counter) istatus=NF90_INQUIRE(kout, unlimitedDimId=id_dimunlim) inldim=0 istatus=NF90_INQUIRE_VARIABLE(kout,kid,dimids=inldim(:) ) ! if the third dim of id_var is time, then adjust the starting point ! to take ktime into account (case XYT file) IF ( inldim(3) == id_dimunlim) THEN ; ilev=itime ; itime=1 ; ENDIF istart(:) = 1 ; istart(3)=ilev ; istart(4)=itime icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj istatus=NF90_PUT_VAR(kout,kid, ptab, start=istart,count=icount) putvarzo=istatus END FUNCTION putvarzo INTEGER(KIND=4) FUNCTION putvar1d4(kout, ptab, kk, cdtype) !!--------------------------------------------------------------------- !! *** FUNCTION putvar1d4 *** !! !! ** Purpose : Copy 1D variable (size kk) hold in ptab, with id !! kid, into file id kout !! !! ** Method : cdtype is either T (time_counter) or D (depth.) !! LON (1D longitude) or LAT (1D latitude) !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file REAL(KIND=4), DIMENSION(kk),INTENT(in) :: ptab ! 1D array to write in file INTEGER(KIND=4), INTENT(in) :: kk ! number of elements in ptab CHARACTER(LEN=1), INTENT(in) :: cdtype ! either T or D LON or LAT INTEGER(KIND=4) :: istatus, iid INTEGER(KIND=4), DIMENSION(1) :: istart, icount !!---------------------------------------------------------------------- SELECT CASE ( cdtype ) CASE ('T', 't' ) iid = nid_tim CASE ('D', 'd' ) iid = nid_dep CASE ('X', 'x' ) iid = nid_lon1d CASE ('Y', 'y' ) iid = nid_lat1d END SELECT istart(:) = 1 icount(:) = kk istatus=NF90_PUT_VAR(kout,iid, ptab, start=istart,count=icount) putvar1d4=istatus END FUNCTION putvar1d4 INTEGER(KIND=4) FUNCTION reputvar1d4(cdfile, cdvar, ptab, kk ) !!--------------------------------------------------------------------- !! *** FUNCTION reputvar1d4 *** !! !! ** Purpose : Copy 1d variable cdfvar in cdfile, an already existing file !! ptab is the 1d array to write and kk the size of ptab !! !! ** Method : !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! filename CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name REAL(KIND=4), DIMENSION(kk), INTENT(in) :: ptab ! 1D array to write in file INTEGER(KIND=4), INTENT(in) :: kk ! number of elements in ptab INTEGER :: istatus, incid, id !!----------------------------------------------------------- istatus = NF90_OPEN(cdfile, NF90_WRITE, incid) istatus = NF90_INQ_VARID(incid, cdvar, id ) istatus = NF90_PUT_VAR(incid, id, ptab, start=(/1/), count=(/kk/) ) reputvar1d4 = istatus istatus = NF90_CLOSE(incid) END FUNCTION reputvar1d4 INTEGER(KIND=4) FUNCTION putvar0dt(kout, kvarid, pvalue, ktime) !!--------------------------------------------------------------------- !! *** FUNCTION putvar0dt *** !! !! ** Purpose : Copy single value, with id varid, into file id kout !! !! ** Method : use argument as dummy array(1,1) !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file INTEGER(KIND=4), INTENT(in) :: kvarid ! id of the variable REAL(KIND=4), DIMENSION(1,1), INTENT(in) :: pvalue ! single value to write in file INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! time frame to write INTEGER(KIND=4) :: istatus INTEGER(KIND=4) :: itime !!---------------------------------------------------------------------- IF (PRESENT(ktime) ) THEN itime = ktime ELSE itime = 1 ENDIF istatus=NF90_PUT_VAR(kout, kvarid, pvalue, start=(/1,1,itime/), count=(/1,1,1/) ) putvar0dt=istatus END FUNCTION putvar0dt INTEGER(KIND=4) FUNCTION putvar0ds(kout, kvarid, pvalue, ktime) !!--------------------------------------------------------------------- !! *** FUNCTION putvar0ds *** !! !! ** Purpose : Copy single value, with id varid, into file id kout !! !! ** Method : use argument as scalar !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file INTEGER(KIND=4), INTENT(in) :: kvarid ! id of the variable REAL(KIND=4), INTENT(in) :: pvalue ! single value to write in file INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! time frame to write INTEGER(KIND=4) :: istatus INTEGER(KIND=4) :: itime REAL(KIND=4), DIMENSION(1,1) :: ztab ! dummy array for PUT_VAR !!---------------------------------------------------------------------- IF (PRESENT(ktime) ) THEN itime = ktime ELSE itime = 1 ENDIF ztab = pvalue istatus=NF90_PUT_VAR(kout, kvarid, ztab, start=(/1,1,itime/), count=(/1,1,1/) ) putvar0ds=istatus END FUNCTION putvar0ds INTEGER(KIND=4) FUNCTION closeout(kout) !!--------------------------------------------------------------------- !! *** FUNCTION closeout *** !! !! ** Purpose : close opened output files !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kout ! ncid of file to be closed !!---------------------------------------------------------------------- closeout=NF90_CLOSE(kout) END FUNCTION closeout INTEGER(KIND=4) FUNCTION ncopen(cdfile) !!--------------------------------------------------------------------- !! *** FUNCTION ncopen *** !! !! ** Purpose : open file cdfile and return file ID !! !!--------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name INTEGER(KIND=4) :: istatus, incid !!--------------------------------------------------------------------- istatus = NF90_OPEN(cdfile,NF90_WRITE,incid) ncopen=incid END FUNCTION ncopen SUBROUTINE ERR_HDL(kstatus) !!--------------------------------------------------------------------- !! *** ROUTINE ERR_HDL *** !! !! ** Purpose : Error handle for NetCDF routine. !! Stop if kstatus indicates error conditions. !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kstatus !!---------------------------------------------------------------------- IF (kstatus /= NF90_NOERR ) THEN PRINT *, 'ERROR in NETCDF routine, status=',kstatus PRINT *,NF90_STRERROR(kstatus) STOP END IF END SUBROUTINE ERR_HDL SUBROUTINE gettimeseries (cdfile, cdvar, kilook, kjlook, klev) !!--------------------------------------------------------------------- !! *** ROUTINE gettimeseries *** !! !! ** Purpose : Display a 2 columns output ( time, variable) for !! a given variable of a given file at a given point !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfile, cdvar INTEGER(KIND=4), INTENT(in) :: kilook,kjlook INTEGER(KIND=4), OPTIONAL, INTENT(in) :: klev INTEGER(KIND=4) :: jt, jk INTEGER(KIND=4) :: iint INTEGER(KIND=4) :: istatus INTEGER(KIND=4) :: incid, id_t, id_var INTEGER(KIND=4) :: indim REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: ztime, zval REAL(KIND=4) :: ztmp REAL(KIND=4) :: zao=0., zsf=1.0 !: add_offset, scale_factor !!---------------------------------------------------------------------- ! Klev can be used to give the model level we want to look at IF ( PRESENT(klev) ) THEN jk=klev ELSE jk=1 ENDIF ! Open cdf dataset istatus=NF90_OPEN(cdfile,NF90_NOWRITE,incid) ! read time dimension istatus=NF90_INQ_DIMID(incid, cn_t, id_t) istatus=NF90_INQUIRE_DIMENSION(incid,id_t, len=iint) ! Allocate space ALLOCATE (ztime(iint), zval(iint) ) ! gettime istatus=NF90_INQ_VARID(incid,cn_vtimec,id_var) istatus=NF90_GET_VAR(incid,id_var,ztime,(/1/),(/iint/) ) ! read variable istatus=NF90_INQ_VARID(incid,cdvar,id_var) ! look for scale_factor and add_offset attribute: istatus=NF90_GET_ATT(incid,id_var,'add_offset',ztmp) IF ( istatus == NF90_NOERR ) zao = ztmp istatus=NF90_GET_ATT(incid,id_var,'scale_factor',ztmp) IF ( istatus == NF90_NOERR ) zsf = ztmp ! get number of dimension of the variable ( either x,y,t or x,y,z,t ) istatus=NF90_INQUIRE_VARIABLE(incid,id_var, ndims=indim) IF ( indim == 3 ) THEN istatus=NF90_GET_VAR(incid,id_var,zval,(/kilook,kjlook,1/),(/1,1,iint/) ) ELSE IF ( indim == 4 ) THEN istatus=NF90_GET_VAR(incid,id_var,zval,(/kilook,kjlook,jk,1/),(/1,1,1,iint/) ) ELSE PRINT *,' ERROR : variable ',TRIM(cdvar),' has ', indim, & & ' dimensions !. Only 3 or 4 supported' STOP ENDIF ! convert to physical values zval=zval*zsf + zao ! display results : DO jt=1,iint PRINT *,ztime(jt)/86400., zval(jt) ENDDO istatus=NF90_CLOSE(incid) END SUBROUTINE gettimeseries LOGICAL FUNCTION chkfile (cd_file, ld_verbose ) !!--------------------------------------------------------------------- !! *** FUNCTION chkfile *** !! !! ** Purpose : Check if cd_file exists. !! Return false if it exists, true if it does not !! Do nothing is filename is 'none' !! !! ** Method : Doing it this way allow statements such as !! IF ( chkfile( cf_toto) ) STOP ! missing file !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cd_file LOGICAL, OPTIONAL, INTENT(in) :: ld_verbose LOGICAL :: ll_exist, ll_verbose !!---------------------------------------------------------------------- IF ( PRESENT(ld_verbose) ) THEN ll_verbose = ld_verbose ELSE ll_verbose = .TRUE. ENDIF IF ( TRIM(cd_file) /= 'none') THEN INQUIRE (file = TRIM(cd_file), EXIST=ll_exist) IF (ll_exist) THEN chkfile = .false. ELSE IF ( ll_verbose ) PRINT *, ' File ',TRIM(cd_file),' is missing ' chkfile = .true. ENDIF ELSE chkfile = .false. ! 'none' file is not checked ENDIF END FUNCTION chkfile LOGICAL FUNCTION chkvar (cd_file, cd_var) !!--------------------------------------------------------------------- !! *** FUNCTION chkvar *** !! !! ** Purpose : Check if cd_var exists in file cd_file. !! Return false if it exists, true if it does not !! Do nothing is varname is 'none' !! !! ** Method : Doing it this way allow statements such as !! IF ( chkvar( cf_toto, cv_toto) ) STOP ! missing var !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cd_file CHARACTER(LEN=*), INTENT(in) :: cd_var INTEGER(KIND=4) :: istatus INTEGER(KIND=4) :: incid, id_t, id_var !!---------------------------------------------------------------------- IF ( TRIM(cd_var) /= 'none') THEN ! Open cdf dataset istatus = NF90_OPEN(cd_file, NF90_NOWRITE,incid) ! Read variable istatus = NF90_INQ_VARID(incid, cd_var, id_var) IF ( istatus == NF90_NOERR ) THEN chkvar = .false. ELSE PRINT *, ' ' PRINT *, ' Var ',TRIM(cd_var),' is missing in file ',TRIM(cd_file) chkvar = .true. ENDIF ! Close file istatus = NF90_CLOSE(incid) ELSE chkvar = .false. ! 'none' file is not checked ENDIF END FUNCTION chkvar CHARACTER(LEN=256) FUNCTION Get_Env ( cd_env ) !!--------------------------------------------------------------------- !! *** FUNCTION Get_Env *** !! !! ** Purpose : A wrapper for system routine getenv !! !! ** Method : Call getenv !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cd_env !!---------------------------------------------------------------------- CALL getenv( TRIM(cd_env), Get_Env ) IF ( TRIM(Get_Env) /= '' ) THEN PRINT *,'Environment found : ',TRIM(cd_env),' = ', TRIM(Get_Env) ENDIF END FUNCTION Get_Env END MODULE cdfio cdftools-3.0/cdftransig_xy3d.f900000644000175000017500000004640612241227304017745 0ustar amckinstryamckinstryPROGRAM cdftransig_xy3d !!====================================================================== !! *** PROGRAM cdftransig_xy3d *** !!===================================================================== !! ** Purpose : Calculates u and v transports at each grid cell !! in rho coordinates. produces a 3D field. !! !! ** Method : allow two 3D arrays for more efficient reading !! !! History : 2.1 : 02/2006 : A.M. Treguier : Original code !! 2.1 : 02/2011 : A.M. Treguier : Allow increased resolution in density !! in deeper layers !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames USE modutils ! for SetFileName, SetGlobalAtt !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index INTEGER(KIND=4) :: jt, jtag ! dummy loop index INTEGER(KIND=4) :: ijb INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq, istag INTEGER(KIND=4) :: iset INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nbins ! density bins INTEGER(KIND=4) :: ncout INTEGER(KIND=4) :: ntags, nframes INTEGER(KIND=4) :: nsigmax , ijtrans ! dimension for itab, intermediate index INTEGER(KIND=4), DIMENSION(2) :: id_varout , ipk ! INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: itab ! look up table for density intervals INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ibinu, ibinv ! integer value corresponding to density for binning REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmasku,zmaskv ! masks x,1,nbins REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, gphiv ! 2D x,y metrics, velocity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2u ! metrics, velocity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zt, zs, zv, e3v ! x,1,z arrays metrics, velocity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, e3u ! metrics, velocity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zdensu, zdensv ! density on u and v points REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! array for depth of T points REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metric in case of full step REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim REAL(KIND=4), DIMENSION(1) :: timean REAL(KIND=4) :: pref ! reference for density REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dusigsig,dvsigsig ! cumulated transports, REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dens2d REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dsigma ! density coordinate, center of bins REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dsig_edge ! density coordinate, edge of bins. REAL(KIND=8) :: dsigtest REAL(KIND=8) :: ds1min, ds1scal ! min sigma and delta_sigma REAL(KIND=8) :: ds1zoom = 999., ds1scalmin ! min sigma for increased resolution REAL(KIND=8) :: dtotal_time CHARACTER(LEN=80 ) :: cf_out='uvxysig.nc' CHARACTER(LEN=80 ) :: cf_tfil CHARACTER(LEN=80 ) :: cf_ufil CHARACTER(LEN=80 ) :: cf_vfil CHARACTER(LEN=80 ) :: cv_outu='vouxysig' CHARACTER(LEN=80 ) :: cv_outv='vovxysig' CHARACTER(LEN=80 ) :: config CHARACTER(LEN=80 ) :: ctag CHARACTER(LEN=80 ) :: cldum CHARACTER(LEN=80 ) :: cldepcode='1000' CHARACTER(LEN=256) :: cglobal CHARACTER(LEN=7 ) :: clsigma TYPE (variable), DIMENSION(2) :: stypvar ! structure for attributes LOGICAL :: lprint = .FALSE. LOGICAL :: lfull = .FALSE. LOGICAL :: lnotset = .FALSE. LOGICAL :: lchk = .FALSE. ! flag for missing files LOGICAL :: lperio = .FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdftransig_xyz CONFCASE ''list_of_tags'' [-depref depcode ] ...' PRINT *,' ... [-depref depref ] [ -nbins nbins ] ... ' PRINT *,' ... [-sigmin smin s-scal] [-sigzoom sminr s-scalr ] ...' PRINT *,' ... [-full ] [-v ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Computes the volume transport at each grid cell in density space ' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' CONFCASE : a DRAKKAR CONFIG-CASE name ' PRINT *,' list_of_tags : a list of time tags to be processed' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-depcode depcode ] : depcode corresponds to pre-defined parameter ' PRINT *,' setting, in term of reference depths, density limits for ' PRINT *,' binning, number of bins, deeper layer refinement.' PRINT *,' AVAILABLE depcode are :' PRINT *,' _______________________________________________________________' PRINT *,' depcode | depth_ref nbins smin s-scal szoommin szoom-scal ' PRINT *,' ---------------------------------------------------------------' PRINT *,' 0 | 0 101 23.0 0.05 ' PRINT *,' 1000 | 1000 93 24.2 0.10 32.3 0.05 ' PRINT *,' 1000-acc | 1000 88 24.5 0.10 ' PRINT *,' 2000 | 2000 174 29.0 0.05 ' PRINT *,' none | parameters must be set individually ' PRINT *,' ---------------------------------------------------------------' PRINT *,' DEFAULT depcode is : ',TRIM(cldepcode) PRINT *,' For other setting use the options to specify the settings' PRINT *,' individually.' PRINT *,' [-depref depref ] : give the depth reference for potential density' PRINT *,' [-nbins nbins ] : give the number of density bins.' PRINT *,' [-sigmin smin s-scal ] : give the minimum of density for binning and' PRINT *,' the bin width. ( take care of the reference depth).' PRINT *,' [-sigzoom sminr s-scalr ] : allow density refinement from sminr, with' PRINT *,' s-scalr bin width.' PRINT *,' [-full ] : indicate a full step configuration.' PRINT *,' [-v ] : verbose mode : extra print are performed during execution.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ',TRIM(cv_outu),' and ', TRIM(cv_outv),' in m3/s.' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfrhoproj, cdfsigtrp' PRINT *,' ' STOP ENDIF ! browse command line according to options ijarg = 1 ; ireq = 0 ; ntags = 0 ; iset = 0 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE ( '-depcode' ) ; CALL getarg(ijarg, cldepcode ) ; ijarg=ijarg+1 CASE ( '-depref' ) ; CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) pref ; iset = iset+1 WRITE(clsigma,'("sigma_",I1)'), NINT(pref/1000.) CASE ( '-nbins' ) ; CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) nbins ; iset = iset+1 CASE ( '-sigmin' ) ; CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) ds1min CASE ( '-sigzoom' ) ; CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) ds1zoom ; iset = iset+1 CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) ds1scalmin CASE ( '-full' ) ; lfull = .TRUE. CASE ( '-v' ) ; lprint = .TRUE. CASE DEFAULT ! mandatory arguments ireq=ireq+1 SELECT CASE (ireq) CASE ( 1 ) ; config=cldum CASE DEFAULT IF ( ntags == 0 ) istag = ijarg - 1 ! remember the argument number corresponding to 1rst tag ntags=ntags + 1 END SELECT END SELECT ENDDO ! set parameters for pre-defined depcode SELECT CASE ( cldepcode ) CASE ( '0' ) pref = 0. ; nbins = 101 ; ds1min = 23.0 ; ds1scal = 0.03 ; ds1zoom = 999. ; ds1scalmin = 999. ; clsigma='sigma_0' CASE ( '1000' ) pref = 1000. ; nbins = 93 ; ds1min = 24.2d0 ; ds1scal = 0.10d0 ; ds1zoom = 32.3d0 ; ds1scalmin = 0.05d0 ; clsigma='sigma_1' CASE ( '1000-acc', '1000-ACC' ) pref = 1000. ; nbins = 88 ; ds1min = 24.5 ; ds1scal = 0.10 ; ds1zoom = 999. ; ds1scalmin = 999. ; clsigma='sigma_1' CASE ( '2000' ) pref = 2000. ; nbins = 174 ; ds1min = 29.0 ; ds1scal = 0.05 ; ds1zoom = 999. ; ds1scalmin = 999. ; clsigma='sigma_2' CASE ( 'none' ) ! in this case check that all parameters are set individually IF ( iset /= 3 ) THEN PRINT *, ' You must set depref, nbins, sigmin individually' ; STOP ENDIF CASE DEFAULT PRINT *, ' this depcode :',TRIM(cldepcode),' is not available.' ; STOP END SELECT ds1scalmin = MIN ( ds1scalmin, ds1scal ) IF ( lprint ) THEN PRINT *,' DEP REF : ', pref, ' m' PRINT *,' NBINS : ', nbins PRINT *,' SIGMIN : ', ds1min PRINT *,' SIGSTP : ', ds1scal PRINT *,' SIGIN R : ', ds1zoom PRINT *,' SIGSTP R : ', ds1scalmin ENDIF ! use first tag to look for file dimension CALL getarg (istag, ctag) cf_vfil = SetFileName (config, ctag, 'V' ) IF ( chkfile(cf_vfil) ) STOP ! missing file npiglo = getdim (cf_vfil, cn_x) npjglo = getdim (cf_vfil, cn_y) npk = getdim (cf_vfil, cn_z) ALLOCATE ( dsigma(nbins), dsig_edge(nbins+1) ) ! define densities at middle of bins and edges of bins ijtrans = 0 DO ji=1,nbins dsigtest = ds1min +(ji-0.5)*ds1scal IF ( dsigtest > ds1zoom ) THEN IF ( ijtrans == 0 ) ijtrans = ji dsigma(ji) = ds1zoom + (ji-ijtrans+0.5)*ds1scalmin ELSE dsigma(ji) = dsigtest ENDIF ENDDO IF (lprint) PRINT *, ' min density:',dsigma(1), ' max density:', dsigma(nbins) IF (lprint) PRINT *, ' verify sigma:', dsigma dsig_edge(1) = ds1min DO ji=2,nbins dsig_edge(ji) = 0.5* (dsigma(ji)+dsigma(ji-1)) END DO dsig_edge(nbins+1) = dsig_edge(nbins) + ds1scalmin IF (lprint) PRINT *, ' sig_edge : ', dsig_edge ! ! define a lookup table array so that the density can be binned according to ! the smallest interval ds1scalmin nsigmax = NINT( (dsig_edge(nbins+1)-dsig_edge(1))/ds1scalmin ) !+1 ALLOCATE ( itab(nsigmax)) itab(:) = 0 DO ji=1,nsigmax dsigtest = ds1min+ (ji-0.5) * ds1scalmin DO jj=1,nbins IF ( dsigtest > dsig_edge(jj) .AND. dsigtest <= dsig_edge(jj+1) ) THEN itab(ji) = jj ENDIF END DO ENDDO IF (lprint) PRINT *, ' nsigmax=' , nsigmax IF (lprint) PRINT *, ' verify itab:', itab ! define new variables for output ( must update att.txt) ! define output variables CALL SetGlobalAtt(cglobal) ipk(:) = nbins ! output file has nbins sigma values stypvar%cunits = 'm3/s' ! transports stypvar%rmissing_value = 0. stypvar%valid_min = -10. ! seem to be small stypvar%valid_max = 10. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TSYX' stypvar(1)%cname = cv_outu ; stypvar(2)%cname = cv_outv stypvar(1)%clong_name = 'Zonal_trsp_sig_coord' ; stypvar(2)%clong_name = 'Meridional_trsp_sig_coord' stypvar(1)%cshort_name = cv_outu ; stypvar(2)%cshort_name = cv_outv PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'nbins = ', nbins ! Allocate arrays ALLOCATE ( zv (npiglo,npjglo), zu (npiglo,npjglo) ) ALLOCATE ( zt (npiglo,npjglo), zs (npiglo,npjglo) ) ALLOCATE ( e3v(npiglo,npjglo), e3u(npiglo,npjglo) ) ALLOCATE ( ibinu(npiglo, npjglo), ibinv(npiglo, npjglo) ) ALLOCATE ( e1v(npiglo,npjglo), gphiv(npiglo,npjglo), gdept(npk) ) ALLOCATE ( e2u(npiglo,npjglo) ) ALLOCATE ( zdensu(npiglo,npjglo), zdensv(npiglo,npjglo) ) ALLOCATE ( zmasku(npiglo,npjglo), zmaskv(npiglo,npjglo)) ALLOCATE ( dusigsig(npiglo,npjglo,nbins), dvsigsig(npiglo,npjglo,nbins)) ! huge as nbins can be > 100 ALLOCATE ( dens2d(npiglo,npjglo) ) e1v(:,:) = getvar (cn_fhgr, cn_ve1v, 1, npiglo, npjglo) e2u(:,:) = getvar (cn_fhgr, cn_ve2u, 1, npiglo, npjglo) gphiv(:,:) = getvar (cn_fhgr, cn_gphiv, 1, npiglo, npjglo) gdept(:) = getvare3(cn_fzgr, cn_gdept, npk ) ! look for E-W periodicity (using zu for temporary array zu(:,:) = getvar (cn_fhgr, cn_glamv, 1, npiglo, npjglo) IF ( zu(1,1) == zu(npiglo-1,1) ) lperio = .TRUE. IF ( lfull ) THEN ALLOCATE ( e31d(npk) ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk ) ENDIF ! create output fileset IF (lprint) PRINT *, ' ready to create file:',TRIM( cf_out), ' from reference:',TRIM(cf_vfil ) ncout = create (cf_out, cf_vfil, npiglo, npjglo, nbins, cdep=clsigma ) ierr = createvar (ncout, stypvar, 2, ipk, id_varout, cdglobal=TRIM(cglobal) ) ierr = putheadervar(ncout, cf_vfil, npiglo, npjglo, nbins, pdep=REAL(dsigma) ) dtotal_time = 0.d0 ! initialize transport to 0 dusigsig (:,:,:) = 0.d0 ; dvsigsig (:,:,:) = 0.d0; ! loop on time and depth --------------------------------------------------- ! DO jk= 1, npk-1 IF ( lprint ) PRINT *, ' working on depth jk=',jk IF ( lfull ) THEN e3v(:,:) = e31d(jk) e3u(:,:) = e31d(jk) ELSE e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo,npjglo ) e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo,npjglo ) ENDIF ijarg = istag ; nframes = 0 DO jtag = 1, ntags CALL getarg (ijarg, ctag) ; ijarg = ijarg + 1 IF (lprint ) PRINT *, ' working on ctag=',TRIM(ctag) cf_tfil = SetFileName(config, ctag, 'T') cf_ufil = SetFileName(config, ctag, 'U') cf_vfil = SetFileName(config, ctag, 'V') ! check existence of files lchk = chkfile ( cf_tfil) lchk = lchk .OR. chkfile ( cf_ufil) lchk = lchk .OR. chkfile ( cf_vfil) IF ( lchk ) STOP ! missing file IF (jk== 1 ) THEN npt = getdim (cf_tfil, cn_t) ! assuming all files (U V ) contains same number of time frame ALLOCATE ( tim(npt) ) tim = getvar1d(cf_tfil, cn_vtimec, npt ) dtotal_time = dtotal_time + SUM( DBLE(tim) ) DEALLOCATE ( tim ) ENDIF DO jt = 1, npt nframes = nframes + 1 ! Get velocities u, v and mask if first time slot only zv(:,:)= getvar ( cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt ) zu(:,:)= getvar ( cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jt) IF (jtag == 1) THEN zmasku(:,:)= 1; zmaskv(:,:)= 1.0 ; WHERE( zu == 0) zmasku(:,:)= 0.0 ; WHERE( zv == 0) zmaskv(:,:)= 0.0; IF (lprint ) PRINT *, ' min,max u:',MINVAL(zu),MAXVAL(zu) ENDIF ! density zt(:,:)= getvar ( cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt ) zs(:,:)= getvar ( cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt ) IF ( pref == 0. ) THEN dens2d = sigma0(zt, zs, npiglo, npjglo) ELSE dens2d = sigmai(zt, zs, pref, npiglo, npjglo) ENDIF ! density on u points masked by u , single precision zdensu(1:npiglo-1,:) = 0.5*( dens2d(1:npiglo-1,:) + dens2d(2:npiglo,:)) ! check for periodic EW condition IF ( lperio ) THEN ; zdensu(npiglo,:) = zdensu(2,:) ELSE ; zdensu(npiglo,:) = 0. ENDIF zdensu(:,:) = zdensu(:,:) * zmasku(:,:) ! density on v points masked by v , single precision zdensv(:,1:npjglo-1) = 0.5*( dens2d(:,1:npjglo-1) + dens2d(:,2:npjglo) ) zdensv(:,:) = zdensv(:,:) * zmaskv(:,:) ! bins density - bins based on dens2d DO jj=1,npjglo DO ji=1,npiglo ijb = INT( (zdensu(ji,jj) - ds1min)/ds1scalmin )+1 ijb = MAX( ijb ,1 ) ijb = MIN( ijb,nsigmax) ibinu(ji,jj) = itab (ijb) ijb = INT( (zdensv(ji,jj) - ds1min)/ds1scalmin )+1 ijb = MAX( ijb ,1 ) ijb = MIN( ijb,nsigmax) ibinv(ji,jj) = itab(ijb) ENDDO ENDDO zu(:,:) = zu(:,:)*e3u(:,:) zv(:,:) = zv(:,:)*e3v(:,:) DO jj=1,npjglo DO ji=1,npiglo dusigsig(ji,jj,ibinu(ji,jj)) = dusigsig(ji,jj,ibinu(ji,jj))+ e2u(ji,jj)*zu(ji,jj)*1.d0 dvsigsig(ji,jj,ibinv(ji,jj)) = dvsigsig(ji,jj,ibinv(ji,jj))+ e1v(ji,jj)*zv(ji,jj)*1.d0 END DO END DO END DO ! end of loop on file time frame ! -----------------------------------------end of loop on ctags END DO ! ! ----------------- end of loop on jk END DO timean(1) = dtotal_time/nframes ierr = putvar1d(ncout, timean, 1, 'T') DO jk=1, nbins zt = dusigsig(:,:,jk) / nframes ierr = putvar (ncout, id_varout(1), zt, jk, npiglo, npjglo, kwght=nframes) ENDDO DO jk=1, nbins zt = dvsigsig(:,:,jk) / nframes ierr = putvar (ncout, id_varout(2), zt, jk, npiglo, npjglo, kwght=nframes) ENDDO ierr = closeout(ncout) END PROGRAM cdftransig_xy3d cdftools-3.0/cdfcofdis.f900000644000175000017500000003355412241227304016576 0ustar amckinstryamckinstryPROGRAM cdfcofdis !!====================================================================== !! *** PROGRAM cdfcofdis *** !!===================================================================== !! ** Purpose : A wrapper for NEMO routine cofdis: create a file !! with the distance to coast variable !! !! ** Method : Mimic some NEMO global variables to be able to use !! NEMO cofdis with minimum changes. Use cdfio instead !! of IOIPSL for the output file. Due to this constaint !! DOCTOR norm is not fully respected (eg jpi not PARAMETER) !! pdct is not a routine argument ... !! !! History : 2.1 : 11/2009 : J.M. Molines : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! cofdis : compute distance to coast (NEMO routine ) !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jpi, jpj, jpk INTEGER(KIND=4) :: jpim1, jpjm1, nperio=4 INTEGER(KIND=4) :: narg, iargc, iarg INTEGER(KIND=4) :: ncout, ierr INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! from phycst REAL(KIND=4) :: rpi = 3.141592653589793 !: pi REAL(KIND=4) :: rad = 3.141592653589793 / 180. !: conv. from degre into radian REAL(KIND=4) :: ra = 6371229. !: earth radius (meter) REAL(KIND=4) ,DIMENSION(1) :: timean ! to be read in mesh_hgr REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamt, glamu,glamv, glamf REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: gphit, gphiu,gphiv, gphif REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask, umask, vmask, fmask ! REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: pdct ! 2D only in this version ! It is a 3D arg in original cofdis CHARACTER(LEN=256) :: cf_out='dist.coast' CHARACTER(LEN=256) :: cf_tfil CHARACTER(LEN=256) :: cv_out='Tcoast' CHARACTER(LEN=256) :: cldum TYPE(variable), DIMENSION(1) :: stypvar LOGICAL :: lchk !!---------------------------------------------------------------------- CALL ReadCdfNames() ! narg=iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfcofdis mesh_hgr.nc mask.nc gridT.nc [-jperio jperio ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the distance to the coast and create a file with ' PRINT *,' the ',TRIM(cv_out),' variable, indicating the distance to the coast.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' HGR-file : name of the mesh_hgr file ' PRINT *,' MSK-file : name of the mask file ' PRINT *,' T-file : netcdf file at T point.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -jperio jperio ] : define the NEMO jperio variable for north fold condition' PRINT *,' Default is 4.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_out),' (m)' PRINT *,' ' PRINT *,' ' STOP ENDIF CALL getarg(1,cn_fhgr) ! overwrite standard name eventually CALL getarg(2,cn_fmsk) ! "" "" CALL getarg(3,cf_tfil ) lchk = chkfile ( cn_fhgr ) lchk = lchk .OR. chkfile ( cn_fmsk ) lchk = lchk .OR. chkfile ( cf_tfil ) IF ( lchk ) STOP ! missing files iarg = 4 DO WHILE ( iarg <= narg ) CALL getarg(iarg, cldum ) ; iarg = iarg + 1 SELECT CASE ( cldum ) CASE ( '-jperio' ) CALL getarg (iarg,cldum) ; READ(cldum, * ) nperio ; iarg = iarg + 1 CASE DEFAULT PRINT *,' unknown option : ', TRIM(cldum) STOP END SELECT END DO ! read domain dimensions in the mask file jpi = getdim(cf_tfil,cn_x) jpj = getdim(cf_tfil,cn_y) jpk = getdim(cf_tfil,cn_z) IF (jpk == 0 ) THEN jpk = getdim(cf_tfil,'z') IF ( jpk == 0 ) THEN PRINT *,' ERROR in determining jpk form gridT file ....' STOP ENDIF ENDIF PRINT *, ' JPI = ', jpi PRINT *, ' JPJ = ', jpj PRINT *, ' JPK = ', jpk jpim1=jpi-1 ; jpjm1=jpj-1 ! ALLOCATION of the arrays ALLOCATE ( glamt(jpi,jpj), glamu(jpi,jpj), glamv(jpi,jpj), glamf(jpi,jpj) ) ALLOCATE ( gphit(jpi,jpj), gphiu(jpi,jpj), gphiv(jpi,jpj), gphif(jpi,jpj) ) ALLOCATE ( tmask(jpi,jpj), umask(jpi,jpj), vmask(jpi,jpj), fmask(jpi,jpj) ) ALLOCATE ( pdct(jpi,jpj) ) PRINT *, 'ALLOCATION DONE.' ! read latitude an longitude glamt(:,:) = getvar(cn_fhgr,cn_glamt,1,jpi,jpj) glamu(:,:) = getvar(cn_fhgr,cn_glamu,1,jpi,jpj) glamv(:,:) = getvar(cn_fhgr,cn_glamv,1,jpi,jpj) glamf(:,:) = getvar(cn_fhgr,cn_glamf,1,jpi,jpj) gphit(:,:) = getvar(cn_fhgr,cn_gphit,1,jpi,jpj) gphiu(:,:) = getvar(cn_fhgr,cn_gphiu,1,jpi,jpj) gphiv(:,:) = getvar(cn_fhgr,cn_gphiv,1,jpi,jpj) gphif(:,:) = getvar(cn_fhgr,cn_gphif,1,jpi,jpj) ! prepare file output ipk(1) = jpk stypvar(1)%cname = cv_out stypvar(1)%cunits = 'm' stypvar(1)%rmissing_value = 0 stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 1. stypvar(1)%clong_name = cv_out stypvar(1)%cshort_name = cv_out stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' stypvar(1)%cprecision = 'r4' ncout = create (cf_out, cf_tfil, jpi, jpj, jpk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, jpi, jpj, jpk ) CALL cofdis CONTAINS SUBROUTINE cofdis() !!---------------------------------------------------------------------- !! *** ROUTINE cofdis *** !! !! ** Purpose : Compute the distance between ocean T-points and the !! ocean model coastlines. Save the distance in a NetCDF file. !! !! ** Method : For each model level, the distance-to-coast is !! computed as follows : !! - The coastline is defined as the serie of U-,V-,F-points !! that are at the ocean-land bound. !! - For each ocean T-point, the distance-to-coast is then !! computed as the smallest distance (on the sphere) between the !! T-point and all the coastline points. !! - For land T-points, the distance-to-coast is set to zero. !! C A U T I O N : Computation not yet implemented in mpp case. !! !! ** Action : - pdct, distance to the coastline (argument) !! - NetCDF file 'dist.coast' !!---------------------------------------------------------------------- INTEGER(KIND=4) :: ji, jj, jk, jl ! dummy loop indices INTEGER(KIND=4) :: iju, ijt ! temporary integers INTEGER(KIND=4) :: icoast, itime INTEGER(KIND=4) :: icot ! logical unit for file distance to the coast LOGICAL, DIMENSION(jpi,jpj) :: llcotu, llcotv, llcotf ! ??? CHARACTER (len=32) :: clname REAL(KIND=4) :: zdate0 REAL(KIND=4), DIMENSION(jpi,jpj) :: zxt, zyt, zzt, zmask ! cartesian coordinates for T-points REAL(KIND=4), DIMENSION(3*jpi*jpj) :: zxc, zyc, zzc, zdis ! temporary workspace !!---------------------------------------------------------------------- ! 0. Initialization ! ----------------- PRINT *, 'COFDIS init' zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) ) zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) ) zzt(:,:) = SIN( rad * gphit(:,:) ) ! 1. Loop on vertical levels ! -------------------------- ! ! =============== DO jk = 1, jpk ! Horizontal slab ! ! =============== PRINT *,'WORKING for level ', jk, nperio pdct(:,:) = 0.e0 ! read the masks ! temp(:,:) = getvar(cbathy,'Bathy_level',1, npiglo, npjglo) tmask(:,:)=getvar(cn_fmsk,'tmask',jk,jpi,jpj) umask(:,:)=getvar(cn_fmsk,'umask',jk,jpi,jpj) vmask(:,:)=getvar(cn_fmsk,'vmask',jk,jpi,jpj) fmask(:,:)=getvar(cn_fmsk,'fmask',jk,jpi,jpj) PRINT *, ' READ masks done.' ! Define the coastline points (U, V and F) DO jj = 2, jpjm1 DO ji = 2, jpim1 zmask(ji,jj) = ( tmask(ji,jj+1) + tmask(ji+1,jj+1) & & + tmask(ji,jj ) + tmask(ji+1,jj ) ) llcotu(ji,jj) = ( tmask(ji,jj ) + tmask(ji+1,jj ) == 1. ) llcotv(ji,jj) = ( tmask(ji,jj ) + tmask(ji ,jj+1) == 1. ) llcotf(ji,jj) = ( zmask(ji,jj) > 0. ) .AND. ( zmask(ji,jj) < 4. ) END DO END DO PRINT *,' llcot? set now.' ! Lateral boundaries conditions llcotu(:, 1 ) = umask(:, 2 ) == 1 llcotu(:,jpj) = umask(:,jpjm1) == 1 llcotv(:, 1 ) = vmask(:, 2 ) == 1 llcotv(:,jpj) = vmask(:,jpjm1) == 1 llcotf(:, 1 ) = fmask(:, 2 ) == 1 llcotf(:,jpj) = fmask(:,jpjm1) == 1 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN llcotu( 1 ,:) = llcotu(jpim1,:) llcotu(jpi,:) = llcotu( 2 ,:) llcotv( 1 ,:) = llcotv(jpim1,:) llcotv(jpi,:) = llcotv( 2 ,:) llcotf( 1 ,:) = llcotf(jpim1,:) llcotf(jpi,:) = llcotf( 2 ,:) ELSE llcotu( 1 ,:) = umask( 2 ,:) == 1 llcotu(jpi,:) = umask(jpim1,:) == 1 llcotv( 1 ,:) = vmask( 2 ,:) == 1 llcotv(jpi,:) = vmask(jpim1,:) == 1 llcotf( 1 ,:) = fmask( 2 ,:) == 1 llcotf(jpi,:) = fmask(jpim1,:) == 1 ENDIF IF( nperio == 3 .OR. nperio == 4 ) THEN DO ji = 1, jpim1 iju = jpi - ji + 1 llcotu(ji,jpj ) = llcotu(iju,jpj-2) llcotf(ji,jpjm1) = llcotf(iju,jpj-2) llcotf(ji,jpj ) = llcotf(iju,jpj-3) END DO DO ji = jpi/2, jpim1 iju = jpi - ji + 1 llcotu(ji,jpjm1) = llcotu(iju,jpjm1) END DO DO ji = 2, jpi ijt = jpi - ji + 2 llcotv(ji,jpjm1) = llcotv(ijt,jpj-2) llcotv(ji,jpj ) = llcotv(ijt,jpj-3) END DO ENDIF IF( nperio == 5 .OR. nperio == 6 ) THEN DO ji = 1, jpim1 iju = jpi - ji llcotu(ji,jpj ) = llcotu(iju,jpjm1) llcotf(ji,jpj ) = llcotf(iju,jpj-2) END DO DO ji = jpi/2, jpim1 iju = jpi - ji llcotf(ji,jpjm1) = llcotf(iju,jpjm1) END DO DO ji = 1, jpi ijt = jpi - ji + 1 llcotv(ji,jpj ) = llcotv(ijt,jpjm1) END DO DO ji = jpi/2+1, jpi ijt = jpi - ji + 1 llcotv(ji,jpjm1) = llcotv(ijt,jpjm1) END DO ENDIF ! Compute cartesian coordinates of coastline points ! and the number of coastline points icoast = 0 PRINT *,' START computing cartesian coord of coastlines ' DO jj = 1, jpj DO ji = 1, jpi IF( llcotf(ji,jj) ) THEN icoast = icoast + 1 zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) ) zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) ) zzc(icoast) = SIN( rad*gphif(ji,jj) ) ENDIF IF( llcotu(ji,jj) ) THEN icoast = icoast+1 zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) ) zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) ) zzc(icoast) = SIN( rad*gphiu(ji,jj) ) ENDIF IF( llcotv(ji,jj) ) THEN icoast = icoast+1 zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) ) zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) ) zzc(icoast) = SIN( rad*gphiv(ji,jj) ) ENDIF END DO END DO PRINT *,' END computing cartesian coord of coastlines ' ! Distance for the T-points PRINT *,' START computing distance for T points', icoast DO jj = 1, jpj print *, jj DO ji = 1, jpi IF( tmask(ji,jj) == 0. ) THEN pdct(ji,jj) = 0. ELSE DO jl = 1, icoast zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2 & & + ( zyt(ji,jj) - zyc(jl) )**2 & & + ( zzt(ji,jj) - zzc(jl) )**2 END DO pdct(ji,jj) = ra * SQRT( MINVAL( zdis(1:icoast) ) ) ENDIF END DO END DO PRINT *,' END computing distance for T points' ierr=putvar(ncout,id_varout(1),pdct,jk,jpi,jpj) ! ! =============== END DO ! End of slab ! ! =============== timean(:)=0. ierr=putvar1d(ncout,timean,1,'T') ierr = closeout(ncout) END SUBROUTINE cofdis END PROGRAM cdfcofdis cdftools-3.0/cdfzisot.f900000644000175000017500000002306012241227304016466 0ustar amckinstryamckinstryPROGRAM cdfzisot !!====================================================================== !! *** PROGRAM cdfzisot *** !!===================================================================== !! ** Purpose : Compute isothermal depth !! !! ** Method : - compute surface properties !! - initialize depths and model levels number !! !! History : 3.0 : 07/2012 : F.Hernandez: Original code !! !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2012, F. Hernandez !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4),PARAMETER :: pnvarout = 2 ! number of output variables INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: jref ! dummy loop index INTEGER(KIND=4) :: narg, iargc, ii ! browse line INTEGER(KIND=4) :: npiglo, npjglo ! domain size INTEGER(KIND=4) :: npk, npt ! domain size INTEGER(KIND=4) :: ncout, ierr ! ncid of output file, error status INTEGER(KIND=4), DIMENSION(pnvarout) :: ipk, id_varout ! levels and varid's of output vars INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mbathy ! mbathy metric REAL(KIND=4) :: rtref ! reference temperature REAL(KIND=4) :: rmisval ! Missing value of temperature REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! depth of T levels REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of W levels REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth for output REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rtem, rtemxz ! temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! temperature mask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glam,gphi ! lon/lat REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rzisot ! depth of the isotherm REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rzisotup ! depth of the isotherm above ! in case of inversion CHARACTER(LEN=256) :: cf_tfil ! input T file CHARACTER(LEN=256) :: cf_out='zisot.nc'! defaults output file name CHARACTER(LEN=256) :: cdum ! dummy value TYPE(variable), DIMENSION(pnvarout) :: stypvar ! structure for output var. attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg < 2 ) THEN PRINT *,' usage : cdfzisot T-file RefTemp [Output File]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute depth of an isotherm given as argument' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : input netcdf file (gridT)' PRINT *,' RefTemp : Temperature of the isotherm.' PRINT *,' Output File : netCDF Optional (defaults: zisot.nc)' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fzgr) PRINT *,' In case of FULL STEP configuration, ',TRIM(cn_fbathylev),' is also required.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) STOP ENDIF ! get input gridT filename CALL getarg (1, cf_tfil) IF ( chkfile(cf_tfil) .OR. chkfile(cn_fzgr) ) STOP ! missing file ! get reference temperature CALL getarg (2, cdum) IF (INDEX(cdum,'.') == 0 ) THEN READ(cdum,'(I10)') ii rtref = float(ii) ELSE READ(cdum,'(f12.6)') rtref cdum=cdum( 1:INDEX(cdum,'.')-1 )//'_'//cdum( INDEX(cdum,'.')+1:LEN_TRIM(cdum) ) ENDIF IF ( rtref > 50 .OR. rtref < -3. ) THEN PRINT*,'Sea Water temperature on Earth, not Pluton ! ',rtref STOP ENDIF ! get (optional) output file name IF ( narg == 3 ) CALL getarg (3, cf_out) PRINT*,TRIM(cf_out) ! read dimensions npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) !!$ PRINT *, 'npiglo = ', npiglo !!$ PRINT *, 'npjglo = ', npjglo !!$ PRINT *, 'npk = ', npk !!$ PRINT *, 'npt = ', npt ! define structure to write the computed isotherm depth rdep(1) = 0. ipk(:) = 1 stypvar(1)%cname = 'zisot'//TRIM(cdum) stypvar(2)%cname = 'zisotup'//TRIM(cdum) stypvar%cunits = 'm' stypvar%rmissing_value = 32767. stypvar%valid_min = 0. stypvar%valid_max = 7000. stypvar(1)%clong_name = 'Depth_of_'//TRIM(cdum)//'C_isotherm' stypvar(2)%clong_name = 'Depth_of_'//TRIM(cdum)//'C_upper_isotherm' stypvar(1)%cshort_name = 'D'//TRIM(cdum) stypvar(2)%cshort_name = 'D'//TRIM(cdum)//'up' stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' ! dynamical allocations ALLOCATE (gdept(npk), gdepw(npk), tim(npt) ) ALLOCATE (rtem(npiglo,npjglo), rtemxz(npiglo,npk) ) ALLOCATE (tmask(npiglo,npjglo), glam(npiglo,npjglo), gphi(npiglo,npjglo) ) ALLOCATE (rzisot(npiglo,npjglo) , rzisotup(npiglo,npjglo) ) ALLOCATE (mbathy(npiglo,npjglo) ) ! read metrics gdept and gdepw gdept(:) = getvare3(cn_fzgr, cn_gdept, npk ) gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk) ! read "mbathy" mbathy(:,:) = getvar(cn_fzgr, 'mbathy', 1, npiglo, npjglo) ! get missing value of votemper rmisval = getatt(cf_tfil, cn_votemper, cn_missing_value ) ! get longitude and latitude glam(:,:) = getvar(cf_tfil, cn_vlon2d, 1, npiglo, npjglo) gphi(:,:) = getvar(cf_tfil, cn_vlat2d, 1, npiglo, npjglo) ! initialize tmask: 1=valid / 0= no valid of SST tmask(:,:) = 1. rtem( :,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=1 ) WHERE ( rtem == rmisval ) tmask = 0. ! initialise matrix of results rzisot = 0. ; WHERE ( rtem == rmisval ) rzisot = rmisval rzisotup = 0. ; WHERE ( rtem == rmisval ) rzisotup = rmisval ! Create output file, based on existing input gridT file ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, pnvarout, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=rdep) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ! compute depth for the isotherm, loop first on time DO jt=1,npt ! then loop on Y axis DO jj = 1 , npjglo ! read temperature on x-z slab rtemxz(:,:) = getvarxz(cf_tfil, cn_votemper, jj, npiglo, npk, kimin=1, kkmin=1, ktime=jt ) ! loop on X axis DO ji = 1, npiglo ! proceed to the depth of isotherm computation if mask = OK IF ( tmask(ji,jj) == 1 ) THEN IF ( COUNT( rtemxz(ji,:)>=rtref .AND. rtemxz(ji,:) .NE.rmisval ) > 0 ) THEN jk = 1 ! count level down ! take into account temperature inversion from the surface IF ( rtemxz(ji,1)= rtref DO WHILE ( jk < npk .AND. rtemxz(ji,jk) < rtref .AND. rtemxz(ji,jk) .NE. rmisval ) jref = jk jk = jk + 1 ENDDO ! compute depth of the above isotherm rzisotup(ji,jj) = ( gdept(jk-1)*( rtemxz(ji,jk)-rtref ) + & & gdept(jk)*( rtref-rtemxz(ji,jk-1) ) ) / & & ( rtemxz(ji,jk)-rtemxz(ji,jk-1) ) !write(12,*)ji,jj,glam(ji,jj),gphi(ji,jj),rzisotup(ji,jj) ENDIF ! then start from the first level with T >= rtref ! and search first value below rtref jref = 0 DO WHILE ( jk < npk .AND. rtemxz(ji,jk) > rtref .AND. rtemxz(ji,jk) .NE. rmisval ) jref = jk jk = jk + 1 ENDDO ! test if the level is the last "wet level" in model metrics ! OR if next temperature value is missing ! Or at the bottom ! --> give value of the bottom of the layer: gdepw(k+1) IF ( jref == mbathy(ji,jj) .OR. rtemxz(ji,jref+1) == rmisval .OR. jref == npk-1 ) THEN rzisot(ji,jj) = gdepw(jref+1) ELSE rzisot(ji,jj) = ( gdept(jref)*( rtemxz(ji,jref+1)-rtref ) + & & gdept(jref+1)*( rtref-rtemxz(ji,jref) ) ) / & & ( rtemxz(ji,jref+1)-rtemxz(ji,jref) ) ENDIF ENDIF ! COUNT( rtemxz(ji,:)>=rtref ENDIF ! tmask(ji,jj) == 1 ENDDO ! ji = 1, npiglo ENDDO ! jj = 1 , npjglo ! Store the zisot variable in output file ierr = putvar(ncout, id_varout(1), rzisot, 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(2), rzisotup, 1, npiglo, npjglo, ktime=jt) END DO ! time loop ierr = closeout(ncout) END PROGRAM cdfzisot cdftools-3.0/cdfmxl.f900000644000175000017500000004230712241227304016123 0ustar amckinstryamckinstryPROGRAM cdfmxl !!====================================================================== !! *** PROGRAM cdfmxl *** !!===================================================================== !! ** Purpose : Compute mixed layer depth !! !! ** Method : - compute surface properties !! - initialize depths and model levels number !! - from bottom to top compute rho and !! check if rho > rho_surf +rho_c !! where rho_c is a density criteria given as argument !! !! History : 2.1 : 10/2005 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !! 3.0 : 07/2012 : F. Hernandez: Optional S-FILE input !! 3.0 : 07/2012 : F. Hernandez: Add new MLD computation for GSOP/GODAE !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4),PARAMETER :: pnvarout = 7 ! number of output variables INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: ik1, ik2, ikt ! k vertical index of mixed layers INTEGER(KIND=4), DIMENSION(1) :: nkref10 ! vertical index for 10m depth T layer INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: npiglo, npjglo ! domain size INTEGER(KIND=4) :: npk, npt ! domain size INTEGER(KIND=4) :: ncout, ierr ! ncid of output file, error status INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mbathy ! number of w levels in water <= npk INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmln1 ! last level where rho > rho + rho_c1 INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmln2 ! last level where rho > rho + rho_c2 INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmln3 ! last level where rho > rho10 + rho_c2 INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmln4 ! last level where rho > rho10 + rho_c3 INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmlnt ! last level where T - SST > temp_c INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmlnt2 ! last level where T-T10 > temp_c INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmlnt3 ! last level where T-T10 > temp_c2 INTEGER(KIND=4), DIMENSION(pnvarout) :: ipk, id_varout ! levels and varid's of output vars REAL(KIND=4) :: rmisval=32767. ! Missing value of Mercator fields REAL(KIND=4) :: rr1,rr2 ! Coef for T(z=10m) interp. REAL(KIND=4) :: rho_c1=0.01 ! 1rst density criterium REAL(KIND=4) :: rho_c2=0.03 ! 2nd density criterium REAL(KIND=4) :: rho_c3=0.125 ! 3rd density criterium REAL(KIND=4) :: temp_c=-0.2 ! temperature criterium REAL(KIND=4) :: temp_c2=-0.5 ! 2nd temperature criterium REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rtem ! temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rtem10 ! 10m depth temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rsal ! salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rsal10 ! 10m depth salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rho ! density REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rho10 ! 10m depth density REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rho_surf ! surface density REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tem_surf ! surface temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask_surf ! surface tmask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask_10 ! 10m-depth tmask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! level tmask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmlp1 ! mxl depth based on density criterium 1 REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmlp2 ! mxl depth based on density criterium 2 REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmlp3 ! mxl depth based on density criterium 2 and 10m REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmlp4 ! mxl depth based on density criterium 3 and 10m REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmlt ! mxl depth based on temperature criterium REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmlt2 ! mxl depth based on temperature criterium and 10m REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmlt3 ! mxl depth based on temperature criterium 2 and 10m REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of w levels REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! depth of T levels REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth for output CHARACTER(LEN=256) :: cf_tfil ! input T file CHARACTER(LEN=256) :: cf_sfil ! input S file (F.Hernandez) CHARACTER(LEN=256) :: cf_out='mxl.nc'! output file name TYPE(variable), DIMENSION(pnvarout) :: stypvar ! structure for attributes LOGICAL :: lexist ! flag for existence of bathy_level file !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmxl T-file [S-file]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute 7 estimates of the mixed layer depth from temperature' PRINT *,' and salinity given in the input file, based on 3 different criteria:' PRINT *,' 1- Density criterium (0.01 kg/m3 difference between surface and MLD)' PRINT *,' 2- Density criterium (0.03 kg/m3 difference between surface and MLD)' PRINT *,' 3- Temperature criterium (0.2 C absolute difference between surface ' PRINT *,' and MLD)' PRINT *,' 4- Temperature criterium (0.2 C absolute difference between T at 10m ' PRINT *,' and MLD)' PRINT *,' 5- Temperature criterium (0.5 C absolute difference between T at 10m ' PRINT *,' and MLD)' PRINT *,' 6- Density criterium (0.03 kg/m3 difference between rho at 10m and MLD) ' PRINT *,' 7- Density criterium (0.125 kg/m3 difference between rho at 10m and MLD) ' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : input netcdf file (gridT)' PRINT *,' [S-file] : input netcdf file (gridS) Optional if vosaline not in T-file' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fzgr) PRINT *,' In case of FULL STEP configuration, ',TRIM(cn_fbathylev),' is also required.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : somxl010 = mld on density criterium 0.01 ref. surf.' PRINT *,' somxl030 = mld on density criterium 0.03 ref. surf.' PRINT *,' somxlt02 = mld on temperature criterium -0.2 ref. surf.' PRINT *,' somxlt02z10 = mld on temperature criterium -0.2 ref. 10m' PRINT *,' somxlt05z10 = mld on temperature criterium -0.5 ref. 10m' PRINT *,' somxl030z10 = mld on density criterium 0.03 ref. 10m' PRINT *,' somxl125z10 = mld on density criterium 0.125 ref. 10m' STOP ENDIF CALL getarg (1, cf_tfil) cf_sfil = cf_tfil ! default case ! If second argument file --> for salinity IF ( narg == 2 ) THEN CALL getarg (2, cf_sfil) ENDIF IF ( chkfile(cf_tfil) .OR. chkfile(cn_fzgr) .OR. chkfile(cf_sfil) ) STOP ! missing file ! read dimensions npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) rdep(1) = 0. ipk(:) = 1 stypvar(1)%cname = 'somxl010' stypvar(2)%cname = 'somxl030' stypvar(3)%cname = 'somxlt02' stypvar(4)%cname = 'somxlt02z10' stypvar(5)%cname = 'somxlt05z10' stypvar(6)%cname = 'somxl030z10' stypvar(7)%cname = 'somxl125z10' stypvar%cunits = 'm' stypvar%rmissing_value = rmisval ! to be compliant with Mercator standards stypvar%valid_min = 0. stypvar%valid_max = 7000. stypvar(1)%clong_name = 'Mixed_Layer_Depth_on_0.01_rho_crit' stypvar(2)%clong_name = 'Mixed_Layer_Depth_on_0.03_rho_crit' stypvar(3)%clong_name = 'Mixed_Layer_Depth_on_-0.2_temp_crit' stypvar(4)%clong_name = 'Mixed_Layer_Depth_on_-0.2_temp_crit ref. 10m' stypvar(5)%clong_name = 'Mixed_Layer_Depth_on_-0.5_temp_crit ref. 10m' stypvar(6)%clong_name = 'Mixed_Layer_Depth_on_0.03_rho_crit ref. 10m' stypvar(7)%clong_name = 'Mixed_Layer_Depth_on_0.125_rho_crit ref. 10m' stypvar(1)%cshort_name = 'somxl010' stypvar(2)%cshort_name = 'somxl030' stypvar(3)%cshort_name = 'somxlt02' stypvar(4)%cshort_name = 'ILD02z10' stypvar(5)%cshort_name = 'ILD05z10' stypvar(6)%cshort_name = 'MLD030z10' stypvar(7)%cshort_name = 'MLD125z10' stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE (rtem (npiglo,npjglo), rsal (npiglo,npjglo), rho (npiglo,npjglo) ) ALLOCATE (rtem10(npiglo,npjglo), rsal10(npiglo,npjglo), rho10(npiglo,npjglo) ) ALLOCATE (hmlp1(npiglo,npjglo), hmlp2(npiglo,npjglo), hmlt(npiglo,npjglo) ) ALLOCATE (hmlp3(npiglo,npjglo), hmlp4(npiglo,npjglo) ) ALLOCATE (hmlt2(npiglo,npjglo), hmlt3(npiglo,npjglo) ) ALLOCATE (nmln1 (npiglo,npjglo), nmln2 (npiglo,npjglo), nmlnt(npiglo,npjglo) ) ALLOCATE (nmln3 (npiglo,npjglo), nmln4 (npiglo,npjglo) ) ALLOCATE (nmlnt2(npiglo,npjglo), nmlnt3(npiglo,npjglo) ) ALLOCATE (tmask(npiglo,npjglo), tmask_surf(npiglo,npjglo), tmask_10(npiglo,npjglo)) ALLOCATE (rho_surf(npiglo,npjglo), tem_surf(npiglo,npjglo) ) ALLOCATE (mbathy(npiglo,npjglo) ) ALLOCATE (gdepw(0:npk), gdept(npk), tim(npt) ) ! read mbathy and gdepw use real rtem(:,:) as template (getvar is used for real only) IF ( chkfile( cn_fbathylev) ) THEN PRINT *, 'Read mbathy in ', TRIM(cn_fzgr),' ...' rtem(:,:) = getvar(cn_fzgr, 'mbathy', 1, npiglo, npjglo) ELSE rtem(:,:) = getvar(cn_fbathylev, cn_bathylev, 1, npiglo, npjglo) ENDIF mbathy(:,:) = rtem(:,:) gdepw(0) = 99999. ! dummy value, always masked -but eventually accessed on land- gdepw(1:npk) = getvare3(cn_fzgr, cn_gdepw, npk) gdept(:) = getvare3(cn_fzgr, cn_gdept, npk) ! find the T-reference level for 10m (F.Hernandez) nkref10 = MINLOC(gdept,gdept>=10.) - 1 ; IF ( nkref10(1) < 1 ) nkref10(1)=1 ! coef for linear interpolation of T at 10m between nkref10 and nkref10+1 rr1 = (10. - gdept(nkref10(1)+1) ) / (gdept(nkref10(1))-gdept(nkref10(1)+1)) rr2 = (gdept(nkref10(1)) - 10. ) / (gdept(nkref10(1))-gdept(nkref10(1)+1)) ! find W levels for later computation nkref10 = MINLOC(gdepw(1:npk),gdepw(1:npk)>=10)-1 ; IF ( nkref10(1) < 1 ) nkref10(1)=1 ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, pnvarout, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=rdep) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jt=1,npt ! read T/S levels around 10m and interpolate rtem (:,:) = getvar(cf_tfil, cn_votemper, nkref10(1), npiglo, npjglo, ktime=jt ) rtem10(:,:) = getvar(cf_tfil, cn_votemper, nkref10(1)+1, npiglo, npjglo, ktime=jt ) WHERE ( rtem == rmisval ) rtem10 = rmisval WHERE ( .NOT. (rtem10 == rmisval) ) rtem10 = rtem*rr1 + rtem10*rr2 rsal (:,:) = getvar(cf_sfil, cn_vosaline, nkref10(1), npiglo, npjglo, ktime=jt ) rsal10(:,:) = getvar(cf_sfil, cn_vosaline, nkref10(1)+1, npiglo, npjglo, ktime=jt ) WHERE ( rsal == rmisval ) rsal10 = rmisval WHERE ( .NOT. (rsal10 == rmisval) ) rsal10 = rsal*rr1 + rsal10*rr2 ! read surface T/S rtem(:,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt ) rsal(:,:) = getvar(cf_sfil, cn_vosaline, 1, npiglo, npjglo, ktime=jt ) ! .. and deduce land-mask from salinity ! ... modified to take into account fill_value = 32767 F.Hernandez IF (jt == 1 ) THEN ! For surface criteria tmask(:,:) = 1. WHERE ( rsal == 0. .OR. rsal == rmisval .OR. rtem == rmisval ) tmask = 0. tmask_surf(:,:) = tmask(:,:) ! For 10m depth criteria (F. Hernandez) tmask(:,:) = 1. WHERE ( rsal10 == 0. .OR. rsal10 == rmisval .OR. rtem10 == rmisval) tmask = 0. tmask_10(:,:) = tmask(:,:) ENDIF ! compute rho_surf rho_surf(:,:) = sigma0 (rtem, rsal, npiglo, npjglo )* tmask_surf(:,:) tem_surf(:,:) = rtem(:,:) ! compute rho at 10m-depth rho10(:,:) = sigma0 (rtem10, rsal10, npiglo, npjglo )* tmask_10(:,:) ! Initialization to the number of w ocean point mbathy nmln1(:,:) = mbathy(:,:) nmln2(:,:) = mbathy(:,:) nmln3(:,:) = mbathy(:,:) nmln4(:,:) = mbathy(:,:) nmlnt(:,:) = mbathy(:,:) nmlnt2(:,:) = mbathy(:,:) nmlnt3(:,:) = mbathy(:,:) ! compute mixed layer depth ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1) ! (rhop defined at t-point, thus jk-1 for w-level just above) DO jk = npk-1, 2, -1 rtem (:,:) = getvar(cf_tfil, cn_votemper, jk ,npiglo, npjglo, ktime=jt) rsal (:,:) = getvar(cf_sfil, cn_vosaline, jk ,npiglo, npjglo, ktime=jt) tmask(:,:) = 1. ! take into account missing values 32767 WHERE ( rsal == 0. .OR. rsal >= rmisval .OR. rtem == rmisval ) tmask = 0. rho (:,:) = sigma0 (rtem, rsal, npiglo, npjglo )* tmask(:,:) DO jj = 1, npjglo DO ji = 1, npiglo IF( rho(ji,jj) > rho_surf(ji,jj) + rho_c1 ) nmln1(ji,jj) = jk IF( rho(ji,jj) > rho_surf(ji,jj) + rho_c2 ) nmln2(ji,jj) = jk IF( ABS(rtem(ji,jj) - tem_surf(ji,jj)) > ABS( temp_c) ) nmlnt(ji,jj) = jk END DO END DO ! Compute with the 10m depth reference: stop if level < nkref10+1 (F.Hernandez) IF ( jk > nkref10(1) ) THEN DO jj = 1, npjglo DO ji = 1, npiglo IF( rho(ji,jj) > rho10(ji,jj) + rho_c2 ) nmln3(ji,jj) = jk IF( rho(ji,jj) > rho10(ji,jj) + rho_c3 ) nmln4(ji,jj) = jk IF( ABS(rtem(ji,jj) - rtem10(ji,jj)) > ABS( temp_c) ) nmlnt2(ji,jj) = jk IF( ABS(rtem(ji,jj) - rtem10(ji,jj)) > ABS( temp_c2) ) nmlnt3(ji,jj) = jk END DO END DO ENDIF END DO ! Mixed layer depth DO jj = 1, npjglo DO ji = 1, npiglo ik1 = nmln1(ji,jj) ; ik2 = nmln2(ji,jj) ; ikt = nmlnt(ji,jj) hmlp1 (ji,jj) = gdepw(ik1) * tmask_surf(ji,jj) hmlp2 (ji,jj) = gdepw(ik2) * tmask_surf(ji,jj) hmlp3 (ji,jj) = gdepw(nmln3(ji,jj)) * tmask_10(ji,jj) hmlp4 (ji,jj) = gdepw(nmln4(ji,jj)) * tmask_10(ji,jj) hmlt (ji,jj) = gdepw(ikt) * tmask_surf(ji,jj) hmlt2 (ji,jj) = gdepw(nmlnt2(ji,jj)) * tmask_10(ji,jj) hmlt3 (ji,jj) = gdepw(nmlnt3(ji,jj)) * tmask_10(ji,jj) END DO END DO ! Correct for missing values = 32767 WHERE ( tmask_surf == 0. ) hmlp1 = rmisval ; hmlp2 = rmisval ; hmlt = rmisval END WHERE WHERE ( tmask_10 == 0. ) hmlp3 = rmisval ; hmlp4 = rmisval ; hmlt2 = rmisval ; hmlt3 = rmisval END WHERE ierr = putvar(ncout, id_varout(1), hmlp1, 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(2), hmlp2, 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(3), hmlt , 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(4), hmlt2, 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(5), hmlt3, 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(6), hmlp3, 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(7), hmlp4, 1, npiglo, npjglo, ktime=jt) END DO ! time loop ierr = closeout(ncout) END PROGRAM cdfmxl cdftools-3.0/cdfhflx.f900000644000175000017500000002425312241227304016264 0ustar amckinstryamckinstryPROGRAM cdfhflx !!====================================================================== !! *** PROGRAM cdfhflx *** !!===================================================================== !! ** Purpose : Compute the Meridional Heat Transport from the !! forcing fluxes. !! !! ** Method : Compute the zonaly integrated heat flux. !! The program looks for the file "new_maskglo.nc". !! If it does not exist, only the calculation over all !! the whole domain is performed (this is adequate for !! a basin configuration like NATL4). !! In new_maskglo.nc the masking corresponds to the global !! configuration. (Global, Atlantic, Indo-Pacific, !! Indian,Pacific ocean) !! !! History : 2.1 : 07/2005 : J.M. Molines : Original code !! 2.1 : 04/2006 : A.M. Treguier : adaptation to NATL4 case !! 2.1 : 07/2009 : R. Dussin : Netcdf output !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. + generalization !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jbasin, ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: npbasins ! number of subbasins INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: numout=10 ! logical unit of txt output file INTEGER(KIND=4) :: ikx=1, iky=1 ! dims of netcdf output file INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! levels and varid's of output vars INTEGER(KIND=4), DIMENSION(2) :: iloc ! used for maxloc REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: zmask ! npbasins x npiglo x npjglo REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t ! horizontal metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: gphit ! Latitide REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zflx ! fluxes read on file REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon ! dummy longitude = 0. REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlat ! latitude for i = north pole REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmht ! cumulated heat trp REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dhtrp ! MHT from fluxes TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! attributes output CHARACTER(LEN=256) :: cf_tfil ! input file CHARACTER(LEN=256) :: cf_out='hflx.out' ! output txt file CHARACTER(LEN=256) :: cf_outnc='cdfhflx.nc' ! output nc file LOGICAL :: lglo = .FALSE. ! global or subbasin computation LOGICAL :: lchk = .FALSE. ! missing file flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfhflx T-file ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Computes the Meridional Heat Transport (MHT) from surface heat fluxes,' PRINT *,' in function of the latitude.' PRINT *,' If a sub-basin file is available, MHT is computed for each sub-basin.' PRINT *,' Note that the latitude is in fact a line of constant J coordinate, not' PRINT *,' a true parallel, if the model grid is distorted as in the northern most' PRINT *,' part of ORCA configurations.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : a file with heat fluxes (gridT). ' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' Files ', TRIM(cn_fhgr),', ',TRIM(cn_fbasins),' and ',TRIM(cn_fmsk),'.' PRINT *,' If ',TRIM(cn_fbasins),' is not available, only global MHT is computed.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' ASCII file : ', TRIM(cf_out ) PRINT *,' netcdf file : ', TRIM(cf_outnc) PRINT *,' variables : hflx_glo, [hflx_atl, hflx_inp, hflx_pac, hflx_ind]' STOP ENDIF CALL getarg (1, cf_tfil) lchk = chkfile(cn_fhgr) lchk = chkfile(cn_fmsk) .OR. lchk lchk = chkfile(cf_tfil) .OR. lchk IF ( lchk ) STOP ! missing file npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! Detects newmaskglo file lglo = .NOT. ( chkfile(cn_fbasins) ) IF (lglo) THEN npbasins = 5 ELSE npbasins = 1 ENDIF ! Allocate arrays ALLOCATE ( zmask(npbasins,npiglo,npjglo) ) ALLOCATE ( zflx(npiglo,npjglo) ) ALLOCATE ( e1t(npiglo,npjglo), e2t(npiglo,npjglo), gphit(npiglo,npjglo) ) ALLOCATE ( dhtrp (npbasins,npjglo) ) ALLOCATE ( dmht(npbasins, npjglo) ) ALLOCATE ( rdumlon(1,npjglo), rdumlat(1,npjglo) ) ALLOCATE ( tim(npt) ) ALLOCATE (stypvar(npbasins), ipk(npbasins), id_varout(npbasins)) ! define new variables for output ipk(:) = 1 stypvar%cunits = 'PW' stypvar%rmissing_value = 99999. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%scale_factor = 1. stypvar%add_offset = 0. stypvar%savelog10 = 0. stypvar%cunits = 'PW' stypvar%conline_operation = 'N/A' stypvar%caxis = 'T' stypvar(1)%cname = 'hflx_glo' stypvar(1)%clong_name = 'Heat_Fluxes_Global' stypvar(1)%cshort_name = 'hflx_glo' IF (lglo) THEN stypvar(2)%cname = 'hflx_atl' ; stypvar(3)%cname = 'hflx_inp' stypvar(2)%clong_name = 'Heat_Fluxes_Atlantic' ; stypvar(3)%clong_name = 'Heat_Fluxes_Indo-Pacific' stypvar(2)%cshort_name = 'hflx_atl' ; stypvar(3)%cshort_name = 'hflx_inp' stypvar(4)%cname = 'hflx_ind' ; stypvar(5)%cname = 'hflx_pac' stypvar(4)%clong_name = 'Heat_Fluxes_Indian' ; stypvar(5)%clong_name = 'Heat_Fluxes_Pacific' stypvar(4)%cshort_name = 'hflx_ind' ; stypvar(5)%cshort_name = 'hflx_pac' ENDIF e1t( :,:) = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e2t( :,:) = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) gphit(:,:) = getvar(cn_fhgr, cn_gphit, 1, npiglo, npjglo) iloc = MAXLOC(gphit) rdumlat(1,:) = gphit(iloc(1),:) rdumlon(:,:) = 0. ! set the dummy longitude to 0 ! create output fileset ncout = create (cf_outnc, 'none', ikx, npjglo, npk ) ierr = createvar (ncout, stypvar, npbasins, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, ikx, npjglo, npk, pnavlon=rdumlon, pnavlat=rdumlat) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') OPEN(numout, FILE=cf_out, FORM='FORMATTED', RECL=256) ! to avoid wrapped line with ifort WRITE(numout,*)'! Zonal heat transport (integrated from surface fluxes) (in Pw)' ! reading the masks ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif zmask(1,:,:)= getvar(cn_fmsk, 'vmask', 1, npiglo, npjglo) IF (lglo) THEN zmask(2,:,:) = getvar(cn_fbasins, 'tmaskatl', 1, npiglo, npjglo) zmask(4,:,:) = getvar(cn_fbasins, 'tmaskind', 1, npiglo, npjglo) zmask(5,:,:) = getvar(cn_fbasins, 'tmaskpac', 1, npiglo, npjglo) zmask(3,:,:) = zmask(5,:,:) + zmask(4,:,:) ! ensure that there are no overlapping on the masks WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1 ! change global mask for GLOBAL periodic condition zmask(1,1,:) = 0. zmask(1,npiglo,:) = 0. ENDIF DO jt = 1, npt ! initialize dmht dmht(:,:) = 0.d0 dhtrp(:,:) = 0.d0 WRITE(numout,*)' TIME =', jt, tim(jt)/86400.,' days' ! Get fluxes zflx(:,:)= getvar(cf_tfil, cn_sohefldo, 1, npiglo, npjglo, ktime=jt) ! integrates 'zonally' (along i-coordinate) DO ji=1,npiglo ! For all basins DO jbasin = 1, npbasins dmht(jbasin,:) = dmht(jbasin,:) + e1t(ji,:)*e2t(ji,:)* zmask(jbasin,ji,:)*zflx(ji,:)*1.d0 END DO END DO ! cumulates transport from north to south DO jj=npjglo-1,1,-1 dhtrp(:,jj) = dhtrp(:,jj+1) - dmht(:,jj) END DO ! transform to peta watt dhtrp(:,:) = dhtrp(:,:) / 1.d15 IF (lglo) THEN WRITE(numout,*)'! J Global Atlantic INDO-PACIF INDIAN PACIF ' DO jj=npjglo, 1, -1 WRITE(numout,9000) jj, & rdumlat(1,jj), dhtrp(1,jj), dhtrp(2,jj), dhtrp(3,jj), dhtrp(4,jj), dhtrp(5,jj) ENDDO ELSE WRITE(numout,*)'! J Global ' DO jj=npjglo, 1, -1 WRITE(numout,9000) jj, rdumlat(1,jj), dhtrp(1,jj) ENDDO ENDIF 9000 FORMAT(I4,5(1x,f9.3,1x,f8.4)) DO jj=1, npbasins ierr = putvar(ncout, id_varout(jj), REAL(dhtrp(jj,:)), ipk(jj), ikx, npjglo, ktime=jt ) END DO END DO ! time loop ierr = closeout(ncout) CLOSE(numout) END PROGRAM cdfhflx cdftools-3.0/cdfbti.f900000644000175000017500000002777612241227304016116 0ustar amckinstryamckinstryPROGRAM cdfbti !!====================================================================== !! *** PROGRAM cdfbti *** !!===================================================================== !! ** Purpose : Compute the term of energetic transfert BTI !! for the barotropic instability for given gridU !! gridV gridU2 gridV2 files and variables !! !! ** Method : Take an input file which is preprocessed by !! cdfmoyuvwt. See also cdfbci !! !! History : 2.1 : 02/2008 : A. Melet : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4), PARAMETER :: jp_varout = 8 INTEGER(KIND=4), PARAMETER :: jp_dudx = 1, jp_dvdx = 2 INTEGER(KIND=4), PARAMETER :: jp_dudy = 3, jp_dvdy = 4 INTEGER(KIND=4), PARAMETER :: jp_anousqrt= 5, jp_anovsqrt= 6 INTEGER(KIND=4), PARAMETER :: jp_anouv = 7, jp_bti = 8 INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: npiglo, npjglo ! domain size INTEGER(KIND=4) :: npk, npt ! vertical and time INTEGER(KIND=4) :: narg, iargc ! INTEGER(KIND=4) :: ncout, ierr ! ncid of output file, error status INTEGER(KIND=4), DIMENSION(jp_varout) :: ipk, id_varout ! REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2t, e1t, e1f, e2f ! REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn, u2n, v2n, uvn ! REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: fmask, umask, vmask ! REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: anousqrt, anovsqrt ! REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: anouv, bti ! REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dudx, dudy, dvdx, dvdy ! CHARACTER(LEN=256) :: cf_out='bti.nc' ! output file name CHARACTER(LEN=256) :: cf_uvwtfil ! input file name TYPE (variable), DIMENSION(jp_varout) :: stypvar ! structure for attibutes LOGICAL :: lchk !!---------------------------------------------------------------------- CALL ReadCdfNames() !! narg = iargc() IF ( narg /= 1 ) THEN PRINT *,' usage : cdfbti UVWT-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the terms in the barotropic energy tranfert equation.' PRINT *,' The transfert of energy for the barotropic instability is ' PRINT *,' bti= -[(u''bar)^2*dubar/dx ...' PRINT *,' +(v''bar)^2*dvbar/dy ...' PRINT *,' +(u''v''*(dubar/dy +dvbar/dx))]' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' UVWT-file : netcdf file produced by cdfmoyuvwt' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fhgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ' PRINT *,' dudx : zonal derivate of ubar on T point' PRINT *,' dvdx : zonal derivate of vbar on T point' PRINT *,' dudy : meridional derivate of ubar on T point' PRINT *,' dvdy : meridional derivate of vbar on T point' PRINT *,' anousqrt : mean of (u-ubar)^2 on T point' PRINT *,' anovsqrt : mean of (v-vbar)^2 on T point' PRINT *,' anouv : mean of (u-ubar)*(v-vbar) on T point' PRINT *,' bti : transfert of energy for the barotropic instability.' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfmoyuvwt, cdfbci, cdfnrjcomp, cdfkempemekeepe' PRINT *,' ' STOP ENDIF CALL getarg(1, cf_uvwtfil) lchk = chkfile (cn_fhgr ) lchk = lchk .OR. chkfile (cf_uvwtfil ) IF ( lchk ) STOP ! missing file npiglo = getdim(cf_uvwtfil,cn_x) npjglo = getdim(cf_uvwtfil,cn_y) npk = getdim(cf_uvwtfil,cn_z) npt = getdim(cf_uvwtfil,cn_t) PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt ! define new variables for output ( must update att.txt) stypvar(jp_dudx)%cname = 'dudx' stypvar(jp_dudx)%clong_name = 'zonal derivate of u on T point' stypvar(jp_dudx)%cshort_name = 'dudx' stypvar(jp_dvdx)%cname = 'dvdx' stypvar(jp_dvdx)%clong_name = 'zonal derivate of v on T point' stypvar(jp_dvdx)%cshort_name = 'dvdx' stypvar(jp_dudy)%cname = 'dudy' stypvar(jp_dudy)%clong_name = 'meridional derivate of u on T point' stypvar(jp_dudy)%cshort_name = 'dudy' stypvar(jp_dvdy)%cname = 'dvdy' stypvar(jp_dvdy)%clong_name = 'meridional derivate of v on T point' stypvar(jp_dvdy)%cshort_name = 'dvdy' stypvar(jp_anousqrt)%cname = 'anousqrt' stypvar(jp_anousqrt)%clong_name = 'temporal mean of the square of the zonal speed anomaly' stypvar(jp_anousqrt)%cshort_name = 'anousqrt' stypvar(jp_anovsqrt)%cname = 'anovsqrt' stypvar(jp_anovsqrt)%clong_name = 'temporal mean of the square of the meridional speed anomaly' stypvar(jp_anovsqrt)%cshort_name = 'anovsqrt' stypvar(jp_anouv)%cname = 'anouv' stypvar(jp_anouv)%clong_name = 'temporal mean of the Reynolds term' stypvar(jp_anouv)%cshort_name = 'anouanov' stypvar(jp_bti)%cname = 'bti' stypvar(jp_bti)%clong_name = 'transfert of energy for the barotropic instability' stypvar(jp_bti)%cshort_name = 'bti' stypvar%cunits = '100000 s-1' stypvar%rmissing_value = 0. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' ipk(:) = npk ! create output fileset ncout = create (cf_out, cf_uvwtfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, jp_varout, ipk, id_varout ) ierr = putheadervar(ncout, cf_uvwtfil, npiglo, npjglo, npk ) ! Allocate the memory ALLOCATE ( e1t(npiglo,npjglo) , e1f(npiglo,npjglo) ) ALLOCATE ( e2t(npiglo,npjglo) , e2f(npiglo,npjglo) ) ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) ) ALLOCATE ( fmask(npiglo,npjglo) ) ALLOCATE ( umask(npiglo,npjglo) , vmask(npiglo,npjglo) ) ALLOCATE ( dudx(npiglo,npjglo) , dudy(npiglo,npjglo) ) ALLOCATE ( dvdx(npiglo,npjglo) , dvdy(npiglo,npjglo) ) ALLOCATE ( u2n(npiglo,npjglo) , v2n(npiglo,npjglo) ) ALLOCATE ( uvn(npiglo,npjglo) ) ALLOCATE ( anousqrt(npiglo,npjglo) , anovsqrt(npiglo,npjglo) ) ALLOCATE ( anouv(npiglo,npjglo), bti(npiglo,npjglo) ) ALLOCATE ( tim(npt) ) e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e1f = getvar(cn_fhgr, cn_ve1f, 1, npiglo, npjglo) e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) e2f = getvar(cn_fhgr, cn_ve2f, 1, npiglo, npjglo) tim = getvar1d(cf_uvwtfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T' ) DO jt = 1, npt DO jk=1, npk PRINT *,' level ',jk dudx(:,:) = 0.d0 dvdx(:,:) = 0.d0 dudy(:,:) = 0.d0 dvdy(:,:) = 0.d0 anousqrt(:,:) = 0.d0 anovsqrt(:,:) = 0.d0 anouv(:,:) = 0.d0 un(:,:) = getvar(cf_uvwtfil, 'ubar', jk ,npiglo,npjglo, ktime=jt) vn(:,:) = getvar(cf_uvwtfil, 'vbar', jk ,npiglo,npjglo, ktime=jt) u2n(:,:) = getvar(cf_uvwtfil, 'u2bar', jk ,npiglo,npjglo, ktime=jt) v2n(:,:) = getvar(cf_uvwtfil, 'v2bar', jk ,npiglo,npjglo, ktime=jt) uvn(:,:) = getvar(cf_uvwtfil, 'uvbar', jk ,npiglo,npjglo, ktime=jt) ! compute the masks umask(:,:) = 0. ; vmask(:,:) = 0. ; fmask(:,:) = 0. DO jj = 2, npjglo DO ji = 2, npiglo umask(ji,jj)= un(ji,jj)*un(ji-1,jj ) vmask(ji,jj)= vn(ji,jj)*vn(ji ,jj-1) ENDDO ENDDO WHERE ( umask /= 0. ) umask = 1. WHERE ( vmask /= 0. ) vmask = 1. DO jj = 1, npjglo-1 DO ji = 1, npiglo-1 fmask(ji,jj)= un(ji,jj)*un(ji,jj+1) * vn(ji,jj)*vn(ji+1,jj) ENDDO ENDDO WHERE ( fmask /= 0. ) fmask = 1. DO jj = 2, npjglo DO ji = 2, npiglo ! vector opt. ! compute derivates at T points dudx(ji,jj) = 100000 * ( un(ji,jj ) - un(ji-1,jj) ) & & * umask(ji,jj) / e1t(ji,jj) dvdy(ji,jj) = 100000 * ( vn(ji,jj ) - vn(ji,jj-1) ) & & * vmask(ji,jj) / e2t(ji,jj) dudy(ji,jj) = 100000/4 *( ( un(ji,jj+1 ) - un(ji,jj) ) & & * fmask(ji,jj) / e2f(ji,jj) & & + (un(ji,jj ) - un(ji,jj-1) ) & & * fmask(ji,jj-1) / e2f(ji,jj-1) & & + (un(ji-1,jj+1 ) - un(ji-1,jj) ) & & * fmask(ji-1,jj) / e2f(ji-1,jj) & & + (un(ji-1,jj ) - un(ji-1,jj-1) ) & & * fmask(ji-1,jj-1) / e2f(ji-1,jj-1) ) dvdx(ji,jj) = 100000/4 *( ( vn(ji,jj ) - vn(ji-1,jj) ) & & * fmask(ji-1,jj) / e1f(ji-1,jj) & & + (vn(ji+1,jj ) - vn(ji,jj) ) & & * fmask(ji,jj) / e1f(ji,jj) & & + (vn(ji-1,jj-1 ) - vn(ji,jj-1) ) & & * fmask(ji-1,jj-1) / e1f(ji-1,jj-1) & & + (vn(ji+1,jj-1 ) - vn(ji,jj-1) ) & & * fmask(ji,jj-1) / e1f(ji,jj-1) ) ! Compute Reynolds terms anousqrt(ji,jj) = 1000/2 * umask(ji,jj)*( ( u2n(ji,jj) - un(ji,jj)*un(ji,jj) ) & & + ( u2n(ji-1,jj) - un(ji-1,jj)*un(ji-1,jj) ) ) anovsqrt(ji,jj) = 1000/2 * vmask(ji,jj)*( ( v2n(ji,jj) - vn(ji,jj)*vn(ji,jj) ) & & + ( v2n(ji,jj-1) - vn(ji,jj)*vn(ji,jj-1) ) ) anouv(ji,jj) = 1000 * ( uvn(ji,jj) & & - 0.5 * umask(ji,jj)*( un(ji,jj) + un(ji-1,jj) ) & & * 0.5 * vmask(ji,jj)*( vn(ji,jj) + vn(ji,jj-1) ) ) ! Compute bti bti(ji,jj) = -1. * ( anousqrt(ji,jj) * dudx(ji,jj) & & + anovsqrt(ji,jj) * dvdy(ji,jj) & & + anouv(ji,jj) * ( dvdx(ji,jj) + dudy(ji,jj) )) END DO END DO ! ierr = putvar(ncout, id_varout(jp_dudx), dudx, jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(jp_dvdx), dvdx, jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(jp_dudy), dudy, jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(jp_dvdy), dvdy, jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(jp_anousqrt), anousqrt, jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(jp_anovsqrt), anovsqrt, jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(jp_anouv), anouv, jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(jp_bti), bti, jk, npiglo, npjglo, ktime=jt) END DO END DO ! time loop ierr = closeout(ncout) END PROGRAM cdfbti cdftools-3.0/DEV_TOOLS/0000755000175000017500000000000012241227304015716 5ustar amckinstryamckinstrycdftools-3.0/DEV_TOOLS/tagfunction.tpl0000644000175000017500000000042312241227304020757 0ustar amckinstryamckinstry !!--------------------------------------------------------------------- !! *** FUNCTION *** !! !! ** Purpose : !! !! ** Method : !! !!---------------------------------------------------------------------- cdftools-3.0/DEV_TOOLS/tagmodule.tpl0000644000175000017500000000151212241227304020417 0ustar amckinstryamckinstry !!====================================================================== !! *** MODULE *** !! < short_description> !!===================================================================== !! History : *** !! !! ** Purpose : !! !! ** Method : !! !! References : !!---------------------------------------------------------------------- cdftools-3.0/DEV_TOOLS/tagprogram.tpl0000644000175000017500000000166012241227304020605 0ustar amckinstryamckinstry !!====================================================================== !! *** PROGRAM *** !!===================================================================== !! ** Purpose : !! !! ** Method : !! !! History : 2.1 : 11/2006 : J.M. Molines : Original code !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2012 !! $Id$ !! Copyright (c) 2012, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- cdftools-3.0/DEV_TOOLS/liste0000644000175000017500000003663512241227304016776 0ustar amckinstryamckinstryPrograms cdf16bit.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfbathy.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add cdfvar capability. keep link cdfvar -> cdfbathy in Makefile * cdfbci.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfbn2.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfbottom.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfbottomsig.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfbti.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfbuoyflx.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfcensus.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfclip.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfcofdis.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfcsp.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfdifmask.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfeke.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfets.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdffindij.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfmoy.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfmoy_chsp (-spval0 option ) ** ** merge with cdfmoy3 (-cub -zeromean options) ** cdfhdy.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfhdy3d.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfzoom.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdficediags.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfcurl.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfinfo.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdflinreg.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfnan.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfspeed.f90: !! CDFTOOLS_3.0 , MEOM 2011 ** bug fixed in 3.0 ** chk cdfvita.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfsmooth.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfsum.f90: !! CDFTOOLS_3.0 , MEOM 2011 ** need clarifications for forcing vs model file ** chk cdfmean.f90: !! CDFTOOLS_3.0 , MEOM 2011 ** now also deal with full step, using -full option, and variance with -var option and zeromean with -zeromean option ** chk cdfstatcoord.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfmax.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfprobe.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfprofile.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfwhereij.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfmsk.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** not that important ! ** cdfmkmask.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merged with cdfmkmask-zone by adding -zoom option ** cdfpolymask.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfmltmask.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfnorth_unfold.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfimprovechk.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfsig0.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfsigi.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfsiginsitu.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfspice.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfmaskdmp.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfnrjcomp.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfkempemekeepe.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfpendep.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdffracinv.f90 !! CDFTOOLS_3.0 , MEOM 2011 chk cdfvertmean.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add -full option ** cdfmxlheatc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add -full option ** cdfmxl.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfgeo-uv.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** bug fix for fmask and ff ** cdfmxlsaltc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add -full option ** cdfmxlhcsc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** improved and optimized ** cdfheatc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add -full option ** cdfhflx.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfmppini.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfw.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfstd.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfnamelist.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** NEW tool ! cdf2matlab.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfisopsi.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** check effect of double precision ** cdfweight.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfweight2D ** cdfcoloc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfcoloc2, cdfcoloc3, cdfcoloc2D ** cdfmaxmoc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfmoc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfmoc_full, and with cdfmoc_gsop ! ** cdfmocsig.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfmocsig_full. Improve interface ** cdftransport.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with full, Magdalena version , add new options -noheat -time -plus_minus (-pm) and -obc for obc input files. ** cdffixtime.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** NEW tool ! cdfvhst.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with -full version ** cdfvT.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** cdfvsig.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** cdfmoy_weighted.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfmoy_annual with -old5d option ** cdfmoyt.f90 !! CDFTOOLS_3.0 , MEOM 2011 chk ** to be tested ** cdfwflx.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfrichardson.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** NEW tool ! cdfvtrp.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdftrp_bathy ** cdfmhst.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfmhst-full ** cdfzonalmean.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** improvement to be done for partial steps ... ** cdfzonalout.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfzonalsum.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** very similar to cdfzonalmean. Merge cdfzonalintdeg as an option (-pdeg) ** cdfstdevw.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfrmsssh.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfstdevts.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfconvert.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfpsi.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merged with variant of cdfspi-open ** cdfpvor.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merged with -full and cdfpv, cdflspv ** cdfrhoproj.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk cdfmoyuvwt.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merged/replace cdfmoyuv ** cdfsigtrp.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merged with cdfsigitrp, cdfsigtrp-full ** cdfsigintegr.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add -full ** cdfmoy_freq.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** in work ... ** cdftransig_xy3d.f90 !! CDFTOOLS_3.0 , MEOM 2011 chk ** same algo than original but options instead of editing program ** Modules cdfio.f90: !! CDFTOOLS_3.0 , MEOM 2011 cdftools.f90: !! CDFTOOLS_3.0 , MEOM 2011 eos.f90: !! CDFTOOLS_3.0 , MEOM 2011 modcdfnames.f90: !! CDFTOOLS_3.0 , MEOM 2011 modpoly.f90: !! CDFTOOLS_3.0 , MEOM 2011 modutils.f90 !! CDFTOOLS_3.0 , MEOM 2011 ** new module for general utilities ** TO DO ... #-------- cdfmht_gsop.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ cdfpsi_level.f90: !! $Date: 2009-07-21 17:49:27 +0200 (mar. 21 juil. 2009) $ cdfsections.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ! Nicolas Jourdain work cdftempvol-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** to be generalized for volume of cdfflxconv.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ cdfsstconv.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ cdfstrconv.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ # new since rev 355 # sans Id cdfcoastline.f90 cdfovide : working on it for simplification # REMOVED cdfmean-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** obsolete (see cdfmean) ** cdfmeanvar.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** obsolete (see cdfmean) ** cdfzeromean.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** obsolete (see cdfmean) ** cdfmax_sp.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** obsolete (see cdfmax) ** cdfmax-test.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** obsolete (removed) ** cdfbn2-full.f90: !! CDFTOOLS_3.0 , MEOM 2011 ** obsolete option -full coded in cdfbn2 ** cdfmsksal.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** removed see cdfmkmask ** cdfmkmask-zone.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** removed see cdfmkmask ** cdfmxlheatc-full.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** see cdfmxlheatc -full ** cdfmxl-full.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** see cdfmxl ** cdfheatc-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** cdf cdfheatc ** cdfvar.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfbathy ** cdfmoy_chsp.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmoy -spval0 ** cdfmoy_sp.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmoy -spval0 (with some diff) ** cdfweight2D.f90: !! $Date: 2007-12-14 09:21:24 +0100 (Fri, 14 Dec 2007) $ ** merged with cdfweight -2d ** cdfcoloc2.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfcoloc.f90 ** cdfcoloc2D.f90: !! $Date: 2007-05-18 16:31:17 +0200 (Fri, 18 May 2007) $ ** merged with cdfcoloc.f90 ** cdfcoloc3.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfcoloc.f90 ** cdfmoc-full.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmoc.f90 [-full] option ** cdfmocatl.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** use cdfmoc w/o basin mask file ** cdfmoc_gsop.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** use cdfmoc with -decomp cdfmoc_gsop_x.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** obsolete ** cdfmocsig-full.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** use cdfmocdig -full ** cdftransportiz.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ! Magdalena Alonso Balmaseda version cdftransportiz-old.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdftransport ** cdftransportiz-full.f90:!! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdftransport ** cdftransportiz_noheat.f90: !! $Date: 2010-06-08 17:51:34 +0200 (Tue, 08 Jun 2010) $ ** merged with cdftransport ** cdfmasstrp.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdftransport ** cdfmasstrp-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdftransport ** cdfvhst-full.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfvhst ** cdfbottomsigi.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfbottomsig cdfbottomsig0 ** cdfmoy_annual.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmoy_weighted -old5d ** cdfmoy_sal2_temp2.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** use cdfmoy and modify cdf namelist cdftrp_bathy.f90: !! $Date: 2010-12-15 00:26:11 +0100 (Wed, 15 Dec 2010) $ ** merged with cdfvtrp ** cdftrp_gaelle.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** a variant of cdfsigtrp with many bugs ... remove ! cdfmhst-full.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmhst ** cdfzonalintdeg.f90: !! $Date: 2009-07-21 17:49:27 +0200 (mar 21 jui 2009) $ ** merged with cdfzonalsum, option -pdeg ** cdfpsi-full.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfpsi ** cdfpsi-open.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfpsi ** cdfpsi-open_AM.f90 NO ID angelique ** merged with cdfpsi ** cdfpsi-open-zap.f90 NO ID zapiola ** merged with cdfpsi ** cdfpv.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfpvor ** cdfpvor-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfpvor ** cdflspv.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfpvor ** cdfisopycdep.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfrhoproj, -isodep option ** cdfmoyuv.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** obsolete, cdfmoyuvwt does the same ** cdfsigtrp2.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** obsolete ** cdfsigtrp-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfsigtrp ** cdfsigitrp.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfsigitrp ** cdfmoy3.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmoy ** cdfmoy_mpp.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** never used .. !** cdftransportizpm.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merge with cdftransport -pm option ** cdftemptrp-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merges with cdfsigtrp with -temp option ** cdftransportiz_noheat_obc.f90:!! $Date: 2009-09-08 17:49:35 +0200 (Tue, 08 Sep 2009) $ ** included with -obc option in cdftransport ** bimgcaltrans.f90: !! $Date: 2009-08-06 10:45:06 +0200 (Thu, 06 Aug 2009) $ ** obsolete, netcdf file are now used in cdfsigtrp bimgmoy4.f90: !! $Date: 2009-04-28 19:33:08 +0200 (Tue, 28 Apr 2009) $ ** obsolete, netcdf file are now used in cdfsigtrp coordinates2hgr.f90: !! $Date: 2010-11-23 13:57:24 +0100 (Tue, 23 Nov 2010) $ ** kept in 2.1,erased from 3.0 coordinates2hgr_karine.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** kept in 2.1,erased from 3.0 coordinates2zgr.f90: !! $Date: 2010-11-23 13:57:24 +0100 (Tue, 23 Nov 2010) $ ** kept in 2.1,erased from 3.0 coordinates2zgr_karine.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** kept in 2.1,erased from 3.0 cdfpsi-austral-ssh.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merge with cdfpsi option -ssh Tfile ** cdftools-3.0/cdfzonalmean.f900000644000175000017500000004056712241227304017315 0ustar amckinstryamckinstryPROGRAM cdfzonalmean !!====================================================================== !! *** PROGRAM cdfzonalmean *** !!===================================================================== !! ** Purpose : Compute the zonal mean of a file !! !! ** Method : In this program the 'zonal' mean is in fact a mean !! along the I coordinate. !! !! History : 2.1 : 11/2005 : J.M. Molines : Original code !! : 06/2007 : P. Mathiot : adaptation for 2D files !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- !! * Local variables IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk ,jt ! dummy loop index INTEGER(KIND=4) :: jbasin, jvar ! dummy loop index INTEGER(KIND=4) :: ijvar ! variable counter INTEGER(KIND=4) :: npbasins=1 ! number of subbasin INTEGER(KIND=4) :: ivar = 0 ! output variable counter INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvarin, nvar ! number of input variables: all/valid INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr, ik ! working integers INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipki, id_varin ! jpbasin x nvar INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipko, id_varout ! jpbasin x nvar INTEGER(KIND=4), DIMENSION(2) :: ijloc ! working array for maxloc REAL(KIND=4) :: zspval=99999. ! missing value REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep ! gdept or gdepw REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, gphi, zv ! metrics, latitude, data value REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdumlon ! dummy longitude = 0. REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdumlat ! latitude for i = north pole REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmaskvar ! variable mask REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask ! basin mask jpbasins x npiglo x npjglo REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dzomean , darea ! jpbasins x npjglo x npk CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cf_out='zonalmean.nc' ! output file name CHARACTER(LEN=256) :: cf_basins='none' ! sub basin file name CHARACTER(LEN=10 ) :: cv_e1, cv_e2 ! horizontal metrics variable names CHARACTER(LEN=10 ) :: cv_phi ! latitude variable name CHARACTER(LEN=10 ) :: cv_msk ! mask variable name CHARACTER(LEN=10 ) :: cv_depi, cv_depo ! depth variable name (input/output) CHARACTER(LEN=256) :: cldum ! dummy character variable CHARACTER(LEN=256) :: ctyp ! variable type on C-grid CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_namesi ! input variable names CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nameso ! output variable names CHARACTER(LEN=4 ), DIMENSION(5) :: cbasin=(/'_glo','_atl','_inp','_ind','_pac'/) ! sub basin suffixes TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvari ! structure for input variables TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvaro ! structure for output variables LOGICAL :: lpdep =.FALSE. ! flag for depth sign (default dep < 0) LOGICAL :: lndep_in =.FALSE. ! flag for depth sign (default dep < 0) in input file LOGICAL :: ldebug =.FALSE. ! flag for activated debug print LOGICAL :: l2d =.FALSE. ! flag for 2D files LOGICAL :: lchk =.FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfzonalmean IN-file point_type [ BASIN-file] ...' PRINT *,' ... [-pdep | --positive_depths]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the zonal mean of all the variables available in the' PRINT *,' input file. This program assume that all the variables are' PRINT *,' located on the same C-grid point, specified on the command line.' PRINT *,' ' PRINT *,' Zonal mean is in fact the mean value computed along the I coordinate.' PRINT *,' The result is a vertical slice, in the meridional direction.' PRINT *,' ' PRINT *,' REMARK : partial step are not handled properly (but probably ' PRINT *,' minor impact on results).' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : input netcdf file.' PRINT *,' point_type : indicate the location on C-grid (T|U|V|F|W)' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [BASIN-file] : netcdf file describing sub basins, similar to ' PRINT *,' ', TRIM(cn_fbasins),'. If this name is not given ' PRINT *,' as option, only the global zonal mean is computed.' PRINT *,' [-pdep | --positive_depths ] : use positive depths in the output file.' PRINT *,' Default behaviour is to have negative depths.' PRINT *,' [-ndep_in ] : negative depths are used in the input file.' PRINT *,' Default behaviour is to have positive depths.' PRINT *,' [-debug ] : add some print for debug' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),', ', TRIM(cn_fzgr),' and ', TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : output variable names are built with the following' PRINT *,' convention: zoxxxx_bas' PRINT *,' where zo replace vo/so prefix of the input variable' PRINT *,' where bas is a suffix for each sub-basins (or glo)' PRINT *,' if a BASIN-file is used.' STOP ENDIF ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg ) CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE (cldum) CASE ( '-pdep' , '--positive_depths' ) ; lpdep =.TRUE. CASE ( '-ndep_in' ) ; lndep_in =.TRUE. CASE ( '-debug' ) ; ldebug =.TRUE. CASE DEFAULT ireq=ireq+1 SELECT CASE (ireq) CASE (1) ; cf_in = cldum ! file name is the 1rst argument CASE (2) ; ctyp = cldum ! point type is the 2nd CASE (3) ; cf_basins = cldum ! sub basin file is the 3rd (optional) npbasins = 5 lchk = chkfile (cf_basins) CASE DEFAULT PRINT *,' Too many arguments ...' ; STOP END SELECT END SELECT END DO ! check files existence lchk = lchk .OR. chkfile (cn_fhgr) lchk = lchk .OR. chkfile (cn_fzgr) lchk = lchk .OR. chkfile (cn_fmsk) lchk = lchk .OR. chkfile (cf_in ) IF ( lchk ) STOP ! missing files ! set the metrics according to C grid point SELECT CASE (ctyp) CASE ('T', 't', 'S', 's') cv_e1 = cn_ve1t ; cv_e2 = cn_ve2t cv_depi = cn_gdept ; cv_depo = cn_vdeptht cv_phi = cn_gphit ; cv_msk = 'tmask' CASE ('U', 'u') cv_e1 = cn_ve1u ; cv_e2 = cn_ve2u cv_depi = cn_gdept ; cv_depo = cn_vdepthu cv_phi = cn_gphiu ; cv_msk = 'umask' CASE ('V', 'v') cv_e1 = cn_ve1v ; cv_e2 = cn_ve2v cv_depi = cn_gdept ; cv_depo = cn_vdepthv cv_phi = cn_gphiv ; cv_msk = 'vmask' CASE ('F', 'f') cv_e1 = cn_ve1f ; cv_e2 = cn_ve2f cv_depi = cn_gdept ; cv_depo = cn_vdeptht cv_phi = cn_gphif ; cv_msk = 'fmask' CASE ('W', 'w') cv_e1 = cn_ve1t ; cv_e2 = cn_ve2t cv_depi = cn_gdepw ; cv_depo = cn_vdepthw cv_phi = cn_gphit ; cv_msk = 'tmask' CASE DEFAULT PRINT *, ' C grid:', TRIM(ctyp),' point not known!' ; STOP END SELECT nvarin = getnvar(cf_in) ! number of input variables ALLOCATE ( cv_namesi(nvarin), ipki(nvarin), id_varin (nvarin) ) ALLOCATE ( cv_nameso(npbasins*nvarin), ipko(npbasins*nvarin), id_varout(npbasins*nvarin) ) ALLOCATE ( stypvari(nvarin) ) ALLOCATE ( stypvaro(npbasins*nvarin) ) cv_namesi(1:nvarin) = getvarname(cf_in, nvarin, stypvari ) ipki (1:nvarin) = getipk (cf_in, nvarin ) ! buildt output filename nvar = 0 ! over all number of valid variables for zonal mean ( < nvarin) ivar = 0 ! over all variable counter ( nvar x basins) DO jvar = 1,nvarin ! skip variables such as nav_lon, nav_lat, time_counter deptht ... IF (ipki(jvar) == 0 ) THEN cv_namesi(jvar)='none' ELSE nvar = nvar + 1 ! count for valid input variables id_varin(nvar) = jvar ! use indirect adressing for those variables DO jbasin=1,npbasins ivar=ivar + 1 ! count for output variables cv_nameso(ivar)='zo'//TRIM(cv_namesi(jvar)(3:))//TRIM(cbasin(jbasin) ) ! intercept case of duplicate zonal name IF (cv_namesi(jvar) == 'iowaflup' ) cv_nameso(ivar)='zowaflio' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'cfc11' ) cv_nameso(ivar)='zocfc11' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'bombc14' ) cv_nameso(ivar)='zobc14' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'invcfc' ) cv_nameso(ivar)='zoinvcfc' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'invc14' ) cv_nameso(ivar)='zoinvc14' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'qtrcfc' ) cv_nameso(ivar)='zoqtrcfc' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'qtrc14' ) cv_nameso(ivar)='zoqtrc14' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'qintcfc' ) cv_nameso(ivar)='zoqintcfc' // TRIM(cbasin(jbasin) ) IF (cv_namesi(jvar) == 'qintc14' ) cv_nameso(ivar)='zoqintc14' // TRIM(cbasin(jbasin) ) stypvaro(ivar)%cname = cv_nameso(ivar) stypvaro(ivar)%cunits = stypvari(jvar)%cunits stypvaro(ivar)%rmissing_value = zspval stypvaro(ivar)%valid_min = stypvari(jvar)%valid_min stypvaro(ivar)%valid_max = stypvari(jvar)%valid_max stypvaro(ivar)%clong_name = 'Zonal_Mean_'//TRIM(stypvari(jvar)%clong_name)//TRIM(cbasin(jbasin) ) stypvaro(ivar)%cshort_name = stypvaro(ivar)%cname stypvaro(ivar)%conline_operation = '/N/A' IF (ipki(jvar) == 1 ) THEN stypvaro(ivar)%caxis ='TY' ELSE stypvaro(ivar)%caxis ='TZY' ENDIF ipko(ivar)=ipki(jvar) END DO ENDIF END DO npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z) npt = getdim (cf_in, cn_t) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! if 2D fields, npk=0, assume 1 IF ( npk == 0 ) THEN npk = 1 l2d = .TRUE. PRINT *,' It is a 2D field, assume npk=1 and gdep=0' END IF ! Allocate arrays ALLOCATE ( zmask(npbasins,npiglo,npjglo) ) ALLOCATE ( zv(npiglo,npjglo), zmaskvar(npiglo,npjglo) ) ALLOCATE ( e1(npiglo,npjglo), e2 (npiglo,npjglo) ) ALLOCATE ( gphi(npiglo,npjglo), gdep(npk), tim(npt) ) ALLOCATE ( zdumlon(1,npjglo), zdumlat(1,npjglo) ) ALLOCATE ( dzomean(npjglo,npk), darea(npjglo,npk) ) ! get the metrics e1(:,:) = getvar(cn_fhgr, cv_e1, 1, npiglo, npjglo) e2(:,:) = getvar(cn_fhgr, cv_e2, 1, npiglo, npjglo) gphi(:,:) = getvar(cn_fhgr, cv_phi, 1, npiglo, npjglo) IF (l2d) THEN gdep(:) = 0 ELSE gdep(:) = getvare3(cn_fzgr, cv_depi ,npk) IF (ldebug) PRINT *, 'getvare3 : ', TRIM(cn_fzgr), TRIM(cv_depi), npk IF (ldebug) PRINT *, 'getvare3 : ', gdep ENDIF IF ( .NOT. lpdep ) gdep(:) = -1.* gdep(:) ! helps for plotting the results ! Look for the i-index that go through the North Pole ijloc = MAXLOC(gphi) zdumlat(1,:) = gphi(ijloc(1),:) zdumlon(:,:) = 0. ! set the dummy longitude to 0 ! create output fileset ncout = create (cf_out, cf_in, 1, npjglo, npk, cdep=cv_depo ) ierr = createvar (ncout, stypvaro, ivar, ipko, id_varout ) ierr = putheadervar(ncout, cf_in, 1, npjglo, npk, pnavlon=zdumlon, pnavlat=zdumlat, pdep=gdep ) tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ! reading the surface masks ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif ik=1 IF ( lndep_in ) ik = npk ! some model are numbered from the bottom zmask(1,:,:) = getvar(cn_fmsk, cv_msk, ik, npiglo, npjglo) IF ( cf_basins /= 'none' ) THEN zmask(2,:,:) = getvar(cf_basins, 'tmaskatl', ik, npiglo, npjglo ) zmask(4,:,:) = getvar(cf_basins, 'tmaskind', ik, npiglo, npjglo ) zmask(5,:,:) = getvar(cf_basins, 'tmaskpac', ik, npiglo, npjglo ) zmask(3,:,:) = zmask(5,:,:) + zmask(4,:,:) ! ensure that there are no overlapping on the masks WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1 ENDIF ! main computing loop ivar = 0 DO jvar = 1, nvar ijvar = id_varin(jvar) DO jt = 1,npt IF (MOD(jt,100)==0) PRINT *, jt,'/',npt DO jk = 1, ipki(ijvar) IF (ldebug) PRINT *,TRIM(cv_namesi(ijvar)), ' level ',jk ! Get variables and mask at level jk zv(:,:) = getvar(cf_in, cv_namesi(ijvar),jk ,npiglo, npjglo, ktime=jt) zmaskvar(:,:) = getvar(cn_fmsk, cv_msk , jk ,npiglo, npjglo ) ! For all basins DO jbasin = 1, npbasins dzomean(:,:) = 0.d0 darea(:,:) = 0.d0 ! integrates 'zonally' (along i-coordinate) DO ji=1,npiglo DO jj=1,npjglo dzomean(jj,jk) = dzomean(jj,jk) + 1.d0*e1(ji,jj)*e2(ji,jj)* zmask(jbasin,ji,jj)*zmaskvar(ji,jj)*zv(ji,jj) darea(jj,jk) = darea(jj,jk) + 1.d0*e1(ji,jj)*e2(ji,jj)* zmask(jbasin,ji,jj)*zmaskvar(ji,jj) END DO END DO ! compute the mean value if the darea is not 0, else assign spval WHERE (darea /= 0 ) dzomean=dzomean/darea ELSEWHERE dzomean=zspval ENDWHERE ivar = (jvar-1)*npbasins + jbasin ierr = putvar (ncout, id_varout(ivar), REAL(dzomean(:,jk)), jk, 1, npjglo, ktime=jt) END DO !next basin END DO ! next k END DO ! next time END DO ! next variable ierr = closeout(ncout) END PROGRAM cdfzonalmean cdftools-3.0/cdfets.f900000644000175000017500000002726612241227304016125 0ustar amckinstryamckinstryPROGRAM cdfets !!====================================================================== !! *** PROGRAM cdfets *** !!===================================================================== !! ** Purpose : Compute Eddy Time Scale 3D field from gridT file !! and the Rosby Radius of deformation. !! Store the results on a 'similar' cdf file. !! !! ** Method : (1) Compute the BruntVaissala frequency (N2) using eosbn2 !! (2) Compute the Rossby Radius as the vertical integral of N, !! scaled by |f|*pi !! (3) Computes the buoyancy =-g x rho/rho0 and is horizontal !! derivative db/dx and db/dy !! (4) Computes M2 = SQRT ( (db/dx)^2 + (db/dy)^2 ) !! (5) Computes eddy length scale = ets = N/M2 !! (6) Output on netcdf file ets.nc : !! ets = voets ; rosby_radius = sorosrad !! !! ** Remarks : A special care has been taken with respect to land value !! which have been set to spval (-1000.) and not 0 as usual. !! This is because a value of 0.00 has a physical meaning for N. !! On the other hand, ets is N/M2. If M2 is 0, (which is likely !! not very usual), ets is set to the arbitrary value of -10., !! to flag these points. !! !! History : 2.0 : 12/2004 : J.M. Molines, J. Le Sommer : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: iup = 1, idown = 2, itmp ! INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(2) :: ipk, id_varout ! REAL(KIND=4) :: rau0 = 1000. ! density of water REAL(KIND=4) :: grav = 9.81 ! Gravity REAL(KIND=4) :: spval = -1000. ! special value REAL(KIND=4) :: zpi REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: ztemp, zsal, zwk ! Array to read 2 layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zn2 ! Brunt Vaissala Frequency (N2) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask, ff ! mask coriolis. REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1u, e2v, e3w ! metrics REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of w level REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dbuoy, dbu, dbv ! Double precision REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dlda, dM2, dets ! Double precision CHARACTER(LEN=256) :: cf_tfil ! out file names CHARACTER(LEN=256) :: cf_out = 'ets.nc' ! in file names TYPE (variable), DIMENSION(2) :: stypvar ! structure for attribute LOGICAL :: lchk ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfets T-file ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the eddy time scale, and a proxy for rossby radius.' PRINT *,' The Rossby radius is computed as the vertical integral of N2' PRINT *,' (Brunt Vaissala frequency), scaled by |f|*pi' PRINT *,' The Eddy Time Scale is the ratio N/|grad B| where N is the square' PRINT *,' root of N2 and |grad B| is the module of the horizontal buoyancy' PRINT *,' gradient. B is the buoyancy computed as B=-g rho/rho0.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf input file for temperature and salinity (gridT).' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),', ',TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : voets (days) and sorosrad (m)' STOP ENDIF CALL getarg (1, cf_tfil) lchk = ( chkfile (cf_tfil) .OR. chkfile( cn_fhgr ) .OR. chkfile( cn_fzgr) ) IF ( lchk ) STOP ! missing file npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) ! define new variables for output stypvar(1)%cname = 'voets' stypvar(1)%cunits = 'days' stypvar(1)%rmissing_value = -1000. stypvar(1)%valid_min = 0 stypvar(1)%valid_max = 50000. stypvar(1)%clong_name = 'Eddy_Time_Scale' stypvar(1)%cshort_name = 'voets' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' stypvar(2)%cname = 'sorosrad' stypvar(2)%cunits = 'm' stypvar(2)%rmissing_value = -1000. stypvar(2)%valid_min = 0. stypvar(2)%valid_max = 50000. stypvar(2)%clong_name = 'Rossby_Radius' stypvar(2)%cshort_name = 'sorosrad' stypvar(2)%conline_operation = 'N/A' stypvar(2)%caxis = 'TYX' ipk(1) = npk ! 3D ipk(2) = 1 ! 2D PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! Allocate arrays ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2), zwk(npiglo,npjglo,2) ,zmask(npiglo,npjglo)) ALLOCATE (zn2(npiglo,npjglo), e1u(npiglo,npjglo), e2v(npiglo,npjglo) ,e3w(npiglo,npjglo)) ALLOCATE (dbu(npiglo,npjglo), dbv(npiglo,npjglo),dlda(npiglo,npjglo) ) ALLOCATE (dbuoy(npiglo,npjglo), dM2(npiglo,npjglo),dets(npiglo,npjglo) ,ff(npiglo,npjglo) ) ALLOCATE (gdepw(npk), tim(npt) ) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar , 2, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) zpi=ACOS(-1.) e1u(:,:) = getvar (cn_fhgr, cn_ve1u, 1, npiglo, npjglo) e2v(:,:) = getvar (cn_fhgr, cn_ve2v, 1, npiglo, npjglo) ff(:,:) = getvar (cn_fhgr, cn_vff, 1, npiglo, npjglo) gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk ) ! eliminates zeros (which corresponds to land points where no procs were used) WHERE ( e1u == 0 ) ff = 1.e-6 e1u = 1 e2v = 1 END WHERE ff(:,:) = ABS(ff(:,:))* zpi ! need ff at T points, zwp(:,:,iup) is used as work array here. DO ji = 2, npiglo DO jj =2, npjglo zwk(ji,jj,iup) = 0.25 * ( ff(ji,jj) + ff(ji,jj-1) + ff(ji-1,jj) + ff(ji-1,jj-1) ) END DO END DO ff(:,:) = zwk(:,:,iup) ff(:,1) = ff(:,2) ff(1,:) = ff(2,:) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jt = 1, npt ! at level 1 and npk, dets is not defined dets(:,:) = spval ierr = putvar(ncout, id_varout(1) ,SNGL(dets), npk, npiglo, npjglo, ktime = jt) ! 2 levels of T and S are required : iup,idown (with respect to W level) ! Compute from bottom to top (for vertical integration) ztemp(:,:,idown) = getvar(cf_tfil, cn_votemper, npk-1 ,npiglo,npjglo, ktime=jt ) zsal (:,:,idown) = getvar(cf_tfil, cn_vosaline, npk-1 ,npiglo,npjglo, ktime=jt ) zwk (:,:,idown) = spval ! Set to 0 dlda dlda(:,:) = 0.d0 DO jk = npk-1, 2, -1 ! from bottom to top PRINT *,'level ',jk ! Get temperature and salinity at jk -1 (up ) ztemp(:,:,iup) = getvar(cf_tfil, cn_votemper, jk-1 ,npiglo,npjglo, ktime = jt) zsal (:,:,iup) = getvar(cf_tfil, cn_vosaline, jk-1 ,npiglo,npjglo, ktime = jt) ! build tmask at level jk zmask(:,:)=1. WHERE(ztemp(:,:,idown) == 0 ) zmask = 0 ! get depthw and e3w at level jk e3w(:,:) = getvar(cn_fzgr, 'e3w_ps', jk,npiglo,npjglo,ldiom=.TRUE.) WHERE(e3w == 0. ) e3w = 0.1 ! avoid 0's in e3w (land points anyway) ! zwk will hold N2 at W level zwk(:,:,iup) = eosbn2 ( ztemp,zsal,gdepw(jk),e3w,npiglo,npjglo, iup, idown ) ! not masked WHERE( zwk(:,:,iup) < 0 ) zwk(:,:,iup) = 0. ! when < 0 set N2 = 0 WHERE( zmask == 0 ) zwk(:,:,iup) = spval ! set to spval on land ! now put zn2 at T level (k ) WHERE ( zwk(:,:,idown) == spval ) zn2(:,:) = zwk(:,:,iup) ELSEWHERE zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) END WHERE ! Only the square root is used in this program (work for ocean points only) WHERE (zmask == 1 ) zn2=SQRT(zn2) ELSEWHERE zn2=spval END WHERE ! integrates vertically (ff is already ABS(ff) * pi dlda(:,:) = dlda(:,:) + e3w(:,:)/ff(:,:) * zn2(:,:)* zmask(:,:) ! Compute buoyancy at level Tk ( idown) dbuoy(:,:) = - grav * (sigma0 ( ztemp(:,:,idown), zsal(:,:,idown),npiglo, npjglo) ) * zmask(:,:) / rau0 ! Compute dB/dx (U point) and dB/dy (V point) DO jj =1 , npjglo -1 DO ji= 1, npiglo -1 dbu(ji,jj) = 1./e1u(ji,jj) *( dbuoy(ji+1,jj) - dbuoy(ji,jj) ) dbv(ji,jj) = 1./e2v(ji,jj) *( dbuoy(ji,jj+1) - dbuoy(ji,jj) ) END DO END DO ! dM2 at T point ( (dB/dx)^2 + (dB/dy)^2 ) ^1/2 DO jj=2,npjglo -1 DO ji=2,npiglo -1 dM2(ji,jj) = 0.25*(dbu(ji,jj) + dbu(ji-1,jj)) * (dbu(ji,jj) + dbu(ji-1,jj)) & + 0.25*(dbv(ji,jj) + dbv(ji,jj-1)) * (dbv(ji,jj) + dbv(ji,jj-1)) END DO END DO dM2(:,:) = SQRT( dM2(:,:) ) ! Eddy Time Scale = N / dM2 dets(:,:) = spval WHERE (dM2 /= 0 ) dets = zn2/dM2/86400. ! in seconds ELSEWHERE dets = -10.d0 ! flag ocean points with dM2 = 0 (very few ?) END WHERE WHERE (zmask == 0 ) dets = spval ! write dets at level jk on the output file ierr = putvar(ncout, id_varout(1) ,SNGL(dets), jk, npiglo, npjglo, ktime=jt) ! swap up and down, next will be read in up itmp = idown ; idown = iup ; iup = itmp END DO ! loop to next level ! repeat dets at the surface and level 2 (the last computed) ierr = putvar(ncout, id_varout(1) ,SNGL(dets), 1,npiglo, npjglo, ktime=jt) ! apply land mask (level 2) on dlda (level 1 and 2 have same mask, as there are always at least 3 levels) WHERE (zmask == 0 ) dlda=spval ierr = putvar(ncout, id_varout(2) ,SNGL(dlda), 1,npiglo, npjglo, ktime=jt) END DO ! time loop ierr = closeout(ncout) END PROGRAM cdfets cdftools-3.0/cdfrhoproj.f900000644000175000017500000003550312241227304017006 0ustar amckinstryamckinstryPROGRAM cdfrhoproj !!====================================================================== !! *** PROGRAM cdfrhoproj *** !!===================================================================== !! ** Purpose : This program is used to project any scalar on the A grid !! onto given isopycnic surfaces. !! !! ** Method : Linear interpolation is used on the vertical to define !! the depth of the given isopycn and linear interpolation !! is also performed on the scalar to determine its value at !! this depth. !! !! History : : 1996 : J.M. Molines for SPEM in Dynamo !! : 1999 : J.O. Beismann for OPA !! : 2000 : J.M. Molines for normalization !! 2.1 : 11/2005 : J.M. Molines : netcdf !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji,jj,jk,jsig,jfich, jvar INTEGER(KIND=4) :: npiglo, npjglo INTEGER(KIND=4) :: npk, npsig, npt INTEGER(KIND=4) :: nvars, nvout=2 INTEGER(KIND=4) :: narg, iargc INTEGER(KIND=4) :: ijarg, ireq INTEGER(KIND=4) :: ik0, ijk INTEGER(KIND=4) :: istartarg = 1 INTEGER(KIND=4) :: nfilin INTEGER(KIND=4) :: numlev=10 INTEGER(KIND=4) :: ncout, ierr INTEGER(KIND=4), DIMENSION(2) :: ipk, id_varout ! for output variables ! REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: zsig, alpha REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2dint, zint, v2d REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zi, tim, h1d REAL(KIND=4) :: P1, P2 REAL(KIND=4) :: zalpha REAL(KIND=4) :: zspvalo=999999. REAL(KIND=4) :: zspvali=0. CHARACTER(LEN=256) :: cf_rholev='rho_lev' CHARACTER(LEN=256) :: cf_dta CHARACTER(LEN=256) :: cf_rhofil CHARACTER(LEN=256) :: cf_out CHARACTER(LEN=256) :: cv_in CHARACTER(LEN=256) :: cv_sig CHARACTER(LEN=256) :: ctype='T' CHARACTER(LEN=256) :: cldum CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! temporary arry for variable name in file TYPE(variable), DIMENSION(2) :: stypvar ! structure for attributes TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypzvar ! structure for attributes ! LOGICAL :: lsingle =.FALSE. LOGICAL :: lchk =.FALSE. LOGICAL :: lisodep =.FALSE. !!---------------------------------------------------------------------- CALL ReadCdfNames() cv_sig = cn_vosigma0 narg=iargc() IF ( narg < 3 ) THEN PRINT *,' usage : cdfrhoproj IN-var RHO-file List_of_IN-files [VAR-type] ... ' PRINT *,' ... [-s0 sig0 ] [-sig sigma_name] [-isodep ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Project IN-var on isopycnal surfaces defined either by sig0 given' PRINT *,' as argument or on all sigma surfaces defined in ',TRIM(cf_rholev),' ascii file.' PRINT *,' IN-var will be interpolated on the T point of the C-grid, previous' PRINT *,' to projection on isopycnal.' PRINT *,' This cdftool is one of the few using 3D arrays. Further development is ' PRINT *,' required to work with vertical slabs instead.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-var : name of the input variable to be projected' PRINT *,' RHO-file : netcdf file with potential density field. If not a sigma0' PRINT *,' file, use -sig option to indicate the name of the density' PRINT *,' variable.' PRINT *,' List_of_IN-file : netcdf files with IN-var ' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-s0 sigma ] : define a single sigma surface on the command line' PRINT *,' instead of reading rho_lev ascii file.' PRINT *,' [VAR-type] : position of IN-var on the C-grid ( either T U V F W )' PRINT *,' default is ''T''.' PRINT *,' [-sig sigma_name] : name of the density variable in RHO_file.' PRINT *,' default is ', TRIM(cv_sig) PRINT *,' [-isodep ] : only compute the isopycnal depth. then stop. In this case' PRINT *,' you must still specify a IN-var variable (in fact a dummy' PRINT *,' name).' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' no metrics, information is taken from depth variable in input files.' PRINT *,' ', TRIM(cf_rholev),' if not using -s0 option.' PRINT *,' ', TRIM(cf_rholev),' is an ascii file, first line giving the number of isopycnal' PRINT *,' following lines with isopycnal value, 1 per line.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' There are as many output files as input files.' PRINT *,' netcdf file : IN-file.interp' PRINT *,' variables : VAR-in (unit is the same as input var)' PRINT *,' ', TRIM(cn_vodepiso),' (m) : depth of isopycnal.' PRINT *,' ' PRINT *,' If option -isodep is used, only isopycnal depth is output :' PRINT *,' netcdf file : isopycdep.nc' PRINT *,' variables : ',TRIM(cn_vodepiso),' (m) ' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' replace cdfisopycdep when using -isodep option.' PRINT *,' ' STOP ENDIF ijarg = 1 ; ireq=0 ; nfilin=0 DO WHILE ( ijarg <= narg ) CALL getarg( ijarg, cldum) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE ('-s0') npsig = 1 ; lsingle=.TRUE. ; ALLOCATE (zi(npsig) ) CALL getarg( ijarg, cldum) ; ijarg=ijarg+1 ; READ(cldum,*) zi(1) CASE ( 'T','t','U','u','V','v','W','w','F','f' ) ctype=cldum CASE ('-sig') CALL getarg( ijarg, cv_sig) ; ijarg=ijarg+1 CASE ('-isodep') ; lisodep = .TRUE. ; nvout=1 ; cf_out='isopycdep.nc' CASE DEFAULT ireq=ireq+1 SELECT CASE (ireq ) CASE ( 1 ) ; cv_in = cldum CASE ( 2 ) ; cf_rhofil = cldum CASE DEFAULT ! count the input files nfilin=nfilin+1 IF ( nfilin == 1 ) istartarg=ijarg-1 END SELECT END SELECT END DO lchk = chkfile(cf_rhofil) IF ( .NOT. lsingle ) lchk = lchk .OR. chkfile(cf_rholev) IF ( lchk ) STOP ! missing file IF ( .NOT. lsingle ) THEN OPEN(numlev,FILE=cf_rholev) READ(numlev,*) npsig ALLOCATE ( zi(npsig) ) DO jsig=1,npsig READ(numlev,*) zi(jsig) PRINT *,zi(jsig) END DO CLOSE(numlev) ENDIF ! Read Rho file npiglo = getdim(cf_rhofil,cn_x) npjglo = getdim(cf_rhofil,cn_y) npk = getdim(cf_rhofil,cn_z) npt = getdim(cf_rhofil,cn_t) CALL getarg(istartarg, cf_dta) nvars=getnvar(cf_dta) ALLOCATE(cv_names(nvars), stypzvar(nvars)) cv_names(:)=getvarname(cf_dta, nvars, stypzvar) ALLOCATE( zsig(npiglo,npjglo,npk), alpha(npiglo, npjglo, npsig) ) ALLOCATE( v2dint(npiglo, npjglo), v2d(npiglo,npjglo), zint(npiglo,npjglo) ) ALLOCATE( tim(npt), h1d(npk) ) tim(:)=getvar1d(cf_rhofil, cn_vtimec, npt) h1d(:)=getvar1d(cf_rhofil, cn_vdeptht, npk) DO jk=1,npk zsig(:,:,jk) = getvar(cf_rhofil, cv_sig, jk, npiglo, npjglo) END DO !! ** Compute interpolation coefficients as well as the level used !! to interpolate between DO ji=1,npiglo DO jj = 1, npjglo ijk = 1 DO jsig=1,npsig ! Assume that rho (z) is increasing downward (no inversion) ! Caution with sigma0 at great depth ! DO WHILE (zi(jsig) >= zsig(ji,jj,ijk) .AND. ijk <= npk & & .AND. zsig(ji,jj,ijk) /= zspvali ) ijk=ijk+1 END DO ijk=ijk-1 ik0=ijk IF (ijk == 0) THEN ijk=1 alpha(ji,jj,jsig) = 0. ELSE IF (zsig(ji,jj,ijk+1) == zspvali ) THEN ik0=0 alpha(ji,jj,jsig) = 0. ELSE ! ... alpha is always in [0,1]. Adding ik0 ( >=1 ) for saving space for ik0 alpha(ji,jj,jsig)= & & (zi(jsig)-zsig(ji,jj,ijk))/(zsig(ji,jj,ijk+1)-zsig(ji,jj,ijk)) + ik0 ENDIF END DO END DO END DO IF ( lisodep ) THEN ipk(1) = npsig stypvar(1)%cname = cn_vodepiso stypvar(1)%cunits = 'm' stypvar(1)%rmissing_value = 999999. stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 7000. stypvar(1)%clong_name = 'Depth_of_Isopycnals' stypvar(1)%cshort_name = cn_vodepiso stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TRYX' ncout = create (cf_out, cf_rhofil, npiglo, npjglo, npsig ) ierr = createvar (ncout, stypvar, nvout, ipk, id_varout ) ierr = putheadervar(ncout , cf_rhofil, npiglo, npjglo, npsig, pdep=zi ) DO jsig=1,npsig DO ji=1,npiglo DO jj=1,npjglo ! ik0 is retrieved from alpha, taking the integer part. ! The remnant is alpha. ik0 = INT(alpha(ji,jj,jsig)) zalpha = alpha(ji,jj,jsig) - ik0 IF (ik0 /= 0) THEN P1 = zsig(ji,jj,ik0 ) P2 = zsig(ji,jj,ik0+1) IF (P1 /= zspvali .AND. P2 /= zspvali) THEN zint (ji,jj) = zalpha *h1d(ik0+1) & & +(1-zalpha)*h1d(ik0 ) ELSE zint (ji,jj)=zspvalo ENDIF ELSE zint (ji,jj)=zspvalo ENDIF END DO END DO ierr = putvar(ncout, id_varout(1), zint , jsig, npiglo, npjglo) END DO ierr = closeout(ncout ) STOP ' -isodep option in use: only compute depth of isopycnal surfaces.' ENDIF !! ** Loop on the scalar files to project on choosen isopycnics surfaces DO jfich= 1, nfilin ijarg = istartarg + jfich - 1 CALL getarg(ijarg, cf_dta) PRINT *,'working with ', TRIM(cf_dta) npt = getdim(cf_dta, cn_t) IF (npt /= 1 ) THEN PRINT *,' This program has to be modified for multiple' PRINT *,' time frames.' STOP ' Error : npt # 1' ENDIF tim(:)=getvar1d(cf_dta, cn_vtimec, 1) DO jk=1,npk v2d(:,:) = getvar(cf_dta,cv_in,jk,npiglo,npjglo) SELECT CASE ( ctype ) CASE ('T', 't' ) zsig(:,:,jk) = v2d(:,:) CASE ('U','u' ) DO ji=2,npiglo DO jj=1, npjglo zsig(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji-1,jj) ) ! put variable on T point END DO END DO CASE ('V','v' ) DO jj=2,npjglo DO ji=1, npiglo zsig(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji,jj-1) ) ! put variable on T point END DO END DO CASE('W','w' ) zint(:,:) = getvar(cf_dta, cv_in, jk+1, npiglo, npjglo) DO jj=1,npjglo DO ji=1, npiglo zsig(ji,jj,jk)=0.5*( v2d(ji,jj) + zint(ji,jj) ) ! put variable on T point END DO END DO CASE('F','f' ) DO jj=2,npjglo DO ji=2, npiglo zsig(ji,jj,jk)=0.25*( v2d(ji,jj) + v2d(ji,jj-1) + v2d(ji-1,jj) + v2d(ji-1,jj-1 )) ! put variable on T point END DO END DO END SELECT END DO ! ... open output file and write header ipk(:)=npsig DO jvar=1,nvars IF ( cv_in == stypzvar(jvar)%cname ) THEN stypvar(2)=stypzvar(jvar) EXIT ENDIF END DO stypvar(2)%clong_name = TRIM(stypvar(2)%clong_name)//' on iso sigma' stypvar(2)%rmissing_value = zspvalo stypvar(2)%caxis = 'TRYX' stypvar(1)%cname = cn_vodepiso stypvar(1)%cunits = 'm' stypvar(1)%rmissing_value = 999999. stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 7000. stypvar(1)%clong_name = 'Depth_of_Isopycnals' stypvar(1)%cshort_name = cn_vodepiso stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TRYX' cf_out=TRIM(cf_dta)//'.interp' ncout = create (cf_out, cf_rhofil, npiglo, npjglo, npsig ) ierr = createvar (ncout, stypvar, nvout, ipk, id_varout ) ierr = putheadervar(ncout , cf_rhofil, npiglo, npjglo, npsig, pdep=zi ) DO jsig=1,npsig DO ji=1,npiglo DO jj=1,npjglo ! ik0 is retrieved from alpha, taking the integer part. ! The remnant is alpha. ik0 = INT(alpha(ji,jj,jsig)) zalpha = alpha(ji,jj,jsig) - ik0 IF (ik0 /= 0) THEN P1 = zsig(ji,jj,ik0 ) P2 = zsig(ji,jj,ik0+1) IF (P1 /= zspvali .AND. P2 /= zspvali) THEN v2dint(ji,jj) = zalpha *P2 & & +(1-zalpha)*P1 zint (ji,jj) = zalpha *h1d(ik0+1) & & +(1-zalpha)*h1d(ik0 ) ELSE v2dint(ji,jj)=zspvalo zint (ji,jj)=zspvalo ENDIF ELSE v2dint(ji,jj)=zspvalo zint (ji,jj)=zspvalo ENDIF END DO END DO ierr = putvar(ncout, id_varout(1), zint , jsig, npiglo, npjglo) ierr = putvar(ncout, id_varout(2), v2dint, jsig, npiglo, npjglo) END DO ierr = putvar1d(ncout, tim, 1, 'T') ierr = closeout(ncout ) END DO ! loop on scalar files PRINT *,'Projection on isopycns completed successfully' END PROGRAM cdfrhoproj cdftools-3.0/cdfmxlsaltc.f900000644000175000017500000001727012241227304017153 0ustar amckinstryamckinstryPROGRAM cdfmxlsaltc !!====================================================================== !! *** PROGRAM cdfmxlsaltc *** !!===================================================================== !! ** Purpose : Compute the salt content in the mixed layer. Work for !! partial steps (default) or full step (-full option) !! !! ** Method : compute the sum ( rho S * e1 *e2 * e3 *mask ) !! for the mixed layer stored into gridT file !! !! History : 2.1 : 04/2006 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modutils USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain, INTEGER(KIND=4) :: ncout, ierr ! ncid and error status INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vars REAL(KIND=4), PARAMETER :: rprho0=1020. ! rho reference density REAL(KIND=4), PARAMETER :: rpcp=4000. ! calorific capacity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zs ! temperature in the MXL REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmxl ! depth of the MXL REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! vertical levels REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metric full REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth output REAL(KIND=8) :: dvol ! total volume REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmxlsaltc ! heat content CHARACTER(LEN=256) :: cf_tfil ! input file name CHARACTER(LEN=256) :: cf_out='mxlsaltc.nc'! output file CHARACTER(LEN=256) :: cv_out='somxlsaltc' ! input file name CHARACTER(LEN=256) :: cglobal ! global attribute CHARACTER(LEN=256) :: cldum ! dummy string TYPE(variable), DIMENSION(1) :: stypvar ! stucture for attributes (output) LOGICAL :: lfull=.false. ! full step flag LOGICAL :: lchk ! file existence flag (true if missing) !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmxlsaltc T-file [-full ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the salt content in the mixed layer.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with salinity and mixed layer deptht.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-full ] : indicate a full step configuration.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fzgr),' and ', TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_out),' (kg/m2 )' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfmxl, cdfmxlhcsc, cdfmxlheatc ' PRINT *,' ' STOP ENDIF ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum ) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-full' ) ; lfull = .true. CASE ( '-partial' ) ; lfull = .false. CASE DEFAULT ireq=ireq+1 SELECT CASE ( ireq ) CASE ( 1 ) ; cf_tfil=cldum CASE DEFAULT ; PRINT *,' Too many arguments' END SELECT END SELECT END DO lchk = chkfile (cn_fzgr) lchk = chkfile (cn_fmsk) .OR. lchk lchk = chkfile (cf_tfil ) .OR. lchk IF ( lchk ) STOP ! missing files CALL SetGlobalAtt( cglobal ) npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) rdep(1) = 0. ipk(:) = 1 stypvar(1)%cname = cv_out stypvar(1)%cunits = 'kg/m2' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0 stypvar(1)%valid_max = 1.e9 stypvar(1)%clong_name = 'Mixed_Layer_Salt_Content' stypvar(1)%cshort_name = cv_out stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! Allocate arrays ALLOCATE ( zmask(npiglo,npjglo), dmxlsaltc(npiglo, npjglo) ) ALLOCATE ( zs(npiglo,npjglo), zmxl(npiglo,npjglo) ) ALLOCATE ( e3(npiglo,npjglo) ) ALLOCATE ( gdepw(npk), tim(npt) ) IF ( lfull ) ALLOCATE ( e31d(npk) ) ! Initialize output file ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout, cdglobal=cglobal ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=rdep ) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk) IF ( lfull ) e31d( :) = getvare3(cn_fzgr, cn_ve3t, npk) dvol = 0.d0 dmxlsaltc(:,:) = 0.d0 DO jt=1,npt zmxl( :,:) = getvar(cf_tfil, cn_somxl010, 1, npiglo, npjglo, ktime=jt) DO jk = 1, npk zs( :,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) zmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo ) ! get e3 at level jk ( ps...) IF ( lfull ) THEN e3(:,:) = e31d(jk) ELSE e3(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF ! e3 is used as a flag for the mixed layer; It is 0 outside the mixed layer e3(:,:)=MAX ( 0., MIN(e3, zmxl-gdepw(jk) ) ) WHERE ( e3 == 0 ) zmask = 0. dvol = SUM( DBLE(e3 * zmask) ) dmxlsaltc = zs * e3 * zmask * 1.d0 + dmxlsaltc IF (dvol /= 0 )THEN ! go on ! ELSE ! no more layer below ! EXIT ! get out of the jk loop ENDIF END DO ! Output to netcdf file : Kg/m2 dmxlsaltc = rprho0*dmxlsaltc ierr = putvar(ncout, id_varout(1), REAL(dmxlsaltc), 1, npiglo, npjglo, ktime=jt) END DO ierr = closeout(ncout) END PROGRAM cdfmxlsaltc cdftools-3.0/cdfvtrp.f900000644000175000017500000002642112241227304016315 0ustar amckinstryamckinstryPROGRAM cdfvtrp !!====================================================================== !! *** PROGRAM cdfvtrp *** !!===================================================================== !! ** Purpose : Compute verticaly integrated transport. !! !! ** Method : Read the velocity components, and computed the verticaly !! averaged transport at each grid cell ( velocity location). !! !! History : 2.1 : 01/2005 : J.M. Molines : Original code !! : 01/2008 : P. Mathiot for -lbathy option !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic., merge !! with cdftrp_bathy !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr, ireq ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: nvarout = 2 ! number of output variables INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! for variable output REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1u, e1v ! horizontal metrics REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e2v ! " " REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3u, e3v ! vertical metrics REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: tmask, hdepw ! tmask and bathymetry REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdhdx, zdhdy ! bottom slope REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zalpha ! angle of rotation REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zu, zv ! velocity components REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! e3t metrics (full step) REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dwku , dwkv ! working arrays REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dtrpu, dtrpv ! barotropic transport TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for attribute CHARACTER(LEN=256) :: cf_ufil ! input U- file CHARACTER(LEN=256) :: cf_vfil ! input V- file CHARACTER(LEN=256) :: cf_out='trp.nc' ! output file CHARACTER(LEN=256) :: cv_soastrp='soastrp' ! Along Slope TRansPort CHARACTER(LEN=256) :: cv_socstrp='socstrp' ! Cross Slope TRansPort CHARACTER(LEN=256) :: cldum ! dummy character variable LOGICAL :: lfull = .FALSE. ! flag for full step LOGICAL :: lbathy = .FALSE. ! flag for slope current LOGICAL :: lchk = .FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfvtrp U-file V-file [ -full ] [ -bathy ]' PRINT *,' PURPOSE :' PRINT *,' Computes the vertically integrated transports at each grid cell.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' U-file : netcdf gridU file' PRINT *,' V-file : netcdf gridV file' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr) PRINT *,' ',TRIM(cn_fmsk),' is required only with -bathy option.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-full ] : To be used in case of full step configuration.' PRINT *,' Default is partial steps.' PRINT *,' [-bathy ] : When used, cdfvtrp also compute the along slope' PRINT *,' and cross slope transport components.' PRINT *,' Bathymetry is read from ',TRIM(cn_fzgr),' file.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ' PRINT *,' ', TRIM(cn_sozoutrp),' : zonal transport.' PRINT *,' ', TRIM(cn_somevtrp),' : meridional transport.' PRINT *,' If option -bathy is used :' PRINT *,' ', TRIM(cv_soastrp),' : along slope transport' PRINT *,' ', TRIM(cv_socstrp),' : cross slope transport' STOP ENDIF ! scan command line and set flags ijarg = 1 ; ireq=0 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE ('-full' ) ; lfull = .TRUE. CASE ('-bathy' ) ; lbathy = .TRUE. ; nvarout = 4 CASE DEFAULT ireq=ireq+1 ! required arguments SELECT CASE ( ireq ) CASE ( 1 ) ; cf_ufil = cldum CASE ( 2 ) ; cf_vfil = cldum END SELECT END SELECT ENDDO ! file existence check lchk = lchk .OR. chkfile ( cn_fzgr ) lchk = lchk .OR. chkfile ( cn_fhgr ) lchk = lchk .OR. chkfile ( cf_ufil ) lchk = lchk .OR. chkfile ( cf_vfil ) IF ( lbathy ) lchk = lchk .OR. chkfile ( cn_fmsk ) IF ( lchk ) STOP ! missing files ALLOCATE ( ipk(nvarout), id_varout(nvarout), stypvar(nvarout) ) npiglo = getdim (cf_ufil, cn_x) npjglo = getdim (cf_ufil, cn_y) npk = getdim (cf_ufil, cn_z) npt = getdim (cf_ufil, cn_t) ! define variables for output ipk(:) = 1 ! all 2D variables stypvar%rmissing_value = 0. stypvar%valid_min = -100. stypvar%valid_max = 100. stypvar%cunits = 'm3/s' stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' stypvar(1)%cname = cn_sozoutrp ; stypvar(2)%cname = cn_somevtrp stypvar(1)%clong_name = 'Zonal_barotropic_transport' ; stypvar(2)%clong_name = 'Meridional_barotropic_transport' stypvar(1)%cshort_name = cn_sozoutrp ; stypvar(2)%cshort_name = cn_somevtrp IF ( lbathy ) THEN stypvar(3)%cname = cv_soastrp ; stypvar(4)%cname = cv_socstrp stypvar(3)%clong_name = 'Along_Slope_Barotropic_Transp' ; stypvar(4)%clong_name = 'Cross_Slope_Barotropic_Transp' stypvar(3)%cshort_name = cv_soastrp ; stypvar(4)%cshort_name = cv_socstrp ENDIF PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! Allocate arrays ALLOCATE ( e1v(npiglo,npjglo), e3v(npiglo,npjglo) ) ALLOCATE ( e2u(npiglo,npjglo), e3u(npiglo,npjglo) ) ALLOCATE ( zu(npiglo,npjglo), zv(npiglo,npjglo) ) ALLOCATE ( dwku(npiglo,npjglo), dwkv(npiglo,npjglo) ) ALLOCATE ( dtrpu(npiglo,npjglo), dtrpv(npiglo,npjglo)) ALLOCATE ( e31d(npk), tim(npt) ) IF ( lbathy ) THEN ! allocate extra arrays ALLOCATE ( e1u(npiglo, npjglo), e2v(npiglo, npjglo)) ALLOCATE ( tmask(npiglo,npjglo), hdepw(npiglo, npjglo) ) ALLOCATE ( zdhdx(npiglo,npjglo), zdhdy(npiglo, npjglo) ) ALLOCATE ( zalpha(npiglo,npjglo) ) ENDIF ! create output fileset ncout = create (cf_out, cf_ufil, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, nvarout, ipk, id_varout ) ierr = putheadervar(ncout, cf_ufil, npiglo, npjglo, 1 ) tim = getvar1d(cf_ufil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo) e2u(:,:) = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo) IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk ) IF ( lbathy ) THEN ! read extra metrics e1u(:,:) = getvar(cn_fhgr, cn_ve1u, 1, npiglo, npjglo) e2v(:,:) = getvar(cn_fhgr, cn_ve2v, 1, npiglo, npjglo) tmask(:,:) = getvar(cn_fmsk, 'tmask', 1, npiglo, npjglo) hdepw(:,:) = getvar(cn_fzgr, cn_hdepw, 1, npiglo, npjglo) ENDIF DO jt = 1, npt dtrpu(:,:)= 0.d0 dtrpv(:,:)= 0.d0 DO jk = 1,npk PRINT *,'level ',jk ! Get velocities at jk zu(:,:)= getvar(cf_ufil, cn_vozocrtx, jk ,npiglo, npjglo, ktime=jt) zv(:,:)= getvar(cf_vfil, cn_vomecrty, jk ,npiglo, npjglo, ktime=jt) ! get e3v at level jk IF ( lfull ) THEN e3v(:,:) = e31d(jk) e3u(:,:) = e31d(jk) ELSE e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.) e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF dwku(:,:) = zu(:,:)*e2u(:,:)*e3u(:,:)*1.d0 dwkv(:,:) = zv(:,:)*e1v(:,:)*e3v(:,:)*1.d0 ! integrates vertically dtrpu(:,:) = dtrpu(:,:) + dwku(:,:) dtrpv(:,:) = dtrpv(:,:) + dwkv(:,:) END DO ! loop to next level ierr = putvar(ncout, id_varout(1) ,REAL(dtrpu(:,:)), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(2) ,REAL(dtrpv(:,:)), 1, npiglo, npjglo, ktime=jt) IF ( lbathy ) THEN ! compute transport component at T point dwku(:,:) = 0.d0 ! U direction DO jj=1, npjglo DO ji= 2,npiglo dwku(ji,jj) = 0.5 * ( dtrpu(ji,jj) + dtrpu(ji-1,jj) ) ENDDO ! E-W periodicity : dwku(1,jj) = dwku(npiglo-1, jj) ENDDO dwkv(:,:) = 0.d0 ! V direction DO jj=2, npjglo DO ji= 1,npiglo dwkv(ji,jj) = 0.5 * ( dtrpv(ji,jj) + dtrpv(ji,jj-1) ) ENDDO ENDDO ! compute bathymetric slope at T point (centered scheme) zdhdx = 0.e0 ! U direction DO jj=1,npjglo DO ji=2, npiglo-1 zdhdx(ji,jj) = ( hdepw(ji+1,jj) - hdepw(ji-1,jj)) / ( e1u(ji,jj) + e1u(ji-1,jj) ) * tmask(ji,jj) END DO END DO zdhdy = 0.e0 ! V direction DO jj=2,npjglo-1 DO ji=1, npiglo zdhdy(ji,jj) = ( hdepw(ji,jj+1) - hdepw(ji,jj-1)) / ( e2v(ji,jj) + e2v(ji,jj-1) ) * tmask(ji,jj) END DO END DO ! compute the angle between the bathymetric slope and model coordinates zalpha(:,:) = ATAN2( zdhdx, zdhdy ) * tmask(:,:) ! apply the rotation on the transport dtrpu(:,:) = ( dwku(:,:) * COS(zalpha) + dwkv(:,:)* SIN(zalpha) ) * tmask(:,:) dtrpv(:,:) = ( -dwku(:,:) * SIN(zalpha) + dwkv(:,:)* COS(zalpha) ) * tmask(:,:) ierr = putvar(ncout, id_varout(3) ,REAL(dtrpu(:,:)), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(4) ,REAL(dtrpv(:,:)), 1, npiglo, npjglo, ktime=jt) ENDIF END DO ierr = closeout (ncout) END PROGRAM cdfvtrp cdftools-3.0/cdfnorth_unfold.f900000644000175000017500000003322712241227304020025 0ustar amckinstryamckinstryPROGRAM cdfnorth_unfold !!====================================================================== !! *** PROGRAM cdfnorth_unfold *** !!===================================================================== !! ** Purpose : Unfold the arctic ocean in an ORCA like configuration !! for all the variables of the file given in the arguments !! !! ** Method : read the filename, the limit of the extracted zone, and !! the type of pivot to use and the C-grid point of variables !! !! History : 2.1 : 04/2010 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !! !! unfold unfold the north pole of orca grid !! chkisig function to determine if the variable changes sign !! when folded !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt, jvar, jv ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: npiglo, npjglo, npk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! Number of variables in a file INTEGER(KIND=4) :: ijatl, ijpacif ! j starting position in atl and pacif INTEGER(KIND=4) :: npiarctic, npjarctic ! size of the output arrays file INTEGER(KIND=4) :: isig ! change sign indicator INTEGER(KIND=4) :: nipivot ! i position of pivot INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's (input) INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! level and varid of output var REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tab ! output array REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tablon, tablat ! output longitude and latitude REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! Array to read a layer of data REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cf_out='unfold.nc' ! output file names CHARACTER(LEN=256) :: cv_dep ! depth name CHARACTER(LEN=256) :: cpivot ! pivot position CHARACTER(LEN=256) :: ctype ! variable position CHARACTER(LEN=256) :: cglobal ! variable position CHARACTER(LEN=256) :: cldum ! dummy string CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! output var attribute LOGICAL :: lchk=.false. ! flag for consistency check !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg /=5 ) THEN PRINT *,' usage : cdfnorth_unfold IN-file jatl jpacif pivot Cgrid_point' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Unfold the Artic Ocean in an ORCA configuration. Produce a netcdf' PRINT *,' file with the Artic ocean as a whole. The area can be adjusted on' PRINT *,' both Atlantic and Pacific sides.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : netcdf file to be unfolded.' PRINT *,' jatl : J index to start the unfold process in the Atlantic.' PRINT *,' jpacif : J index to start the unfold process in the Pacific.' PRINT *,' pivot : type of pivot for the north fold condition ( T or F )' PRINT *,' Cgrid_point : grid point where the variables in the input file are' PRINT *,' located. If all variables in a single file are not on' PRINT *,' the same C-grid location, there might be a problem ...' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : same name and units than in the input file.' STOP ENDIF CALL getarg (1, cf_in ) CALL getarg (2, cldum ) ; READ(cldum,*) ijatl CALL getarg (3, cldum ) ; READ(cldum,*) ijpacif CALL getarg (4, cpivot) CALL getarg (5, ctype ) IF ( chkfile(cf_in) ) STOP ! missing file WRITE(cglobal,9000) 'cdfnorth_unfold ',TRIM(cf_in), ijatl, ijpacif, TRIM(cpivot), TRIM(ctype) 9000 FORMAT(a,a,2i5,a,1x,a) npiglo = getdim (cf_in, cn_x ) npjglo = getdim (cf_in, cn_y ) npt = getdim (cf_in, cn_t ) npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'nav_lev',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF ENDIF ! to be improved npiarctic = npiglo/2 nipivot = npiglo/2 SELECT CASE ( cpivot ) CASE ( 'T','t') ; npjarctic=(npjglo-ijatl+1) + (npjglo -ijpacif +1) -3 CASE ( 'F','f') ; npjarctic=(npjglo-ijatl+1) + (npjglo -ijpacif +1) -2 END SELECT PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE( tab(npiarctic, npjarctic), v2d(npiglo,npjglo), tim(npt) ) ALLOCATE( tablon(npiarctic, npjarctic), tablat(npiarctic, npjarctic) ) nvars = getnvar(cf_in) PRINT *,' nvars = ', nvars ALLOCATE (cv_names(nvars) ) ALLOCATE (stypvar(nvars) ) ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars) ) ! get list of variable names and collect attributes in stypvar (optional) cv_names(:) = getvarname(cf_in, nvars, stypvar) id_var(:) = (/(jv, jv=1,nvars)/) ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk (cf_in, nvars, cdep=cv_dep) WHERE( ipk == 0 ) cv_names = 'none' stypvar(:)%cname = cv_names v2d=getvar(cf_in, cn_vlon2d, 1, npiglo, npjglo) CALL unfold(v2d ,tablon, ijatl, ijpacif, cpivot, ctype, 1) v2d=getvar(cf_in, cn_vlat2d, 1, npiglo, npjglo) CALL unfold(v2d ,tablat, ijatl, ijpacif, cpivot, ctype, 1) ! create output file taking the sizes in cf_in ncout = create (cf_out, cf_in, npiarctic, npjarctic, npk, cdep=cv_dep) ierr = createvar (ncout, stypvar, nvars, ipk, id_varout, cdglobal=TRIM(cglobal) ) ierr = putheadervar(ncout, cf_in, npiarctic, npjarctic, npk, pnavlon=tablon, pnavlat=tablat, cdep=cv_dep) tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ! default value isig = 1 DO jvar = 1,nvars PRINT *,' Working with ', TRIM(cv_names(jvar)), ipk(jvar) DO jk = 1, ipk(jvar) PRINT *,'level ',jk tab(:,:) = 0. DO jt=1,npt v2d(:,:) = getvar(cf_in, cv_names(jvar), jk, npiglo, npjglo, ktime=jt ) IF ( jk == 1 .AND. jt == 1) THEN ! look for correct isig isig=chkisig( cpivot, ctype, v2d, lchk) PRINT *,'ISIG=', isig ENDIF CALL unfold(v2d, tab, ijatl, ijpacif, cpivot, ctype, isig) ierr = putvar(ncout, id_varout(jvar), tab, jk, npiarctic, npjarctic) ENDDO END DO ! loop to next level END DO ! loop to next var in file ierr = closeout(ncout) CONTAINS INTEGER(KIND=4) FUNCTION chkisig (cdpivot, cdtype, ptab, ldchk) !!--------------------------------------------------------------------- !! *** FUNCTION chkisig *** !! !! ** Purpose : from the input data determine if the field is to be !! multiplied by -1 in the unfolding process or not. !! if ldchk is true, proceed to an extended check of the !! overlaping area (not written yet) !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdpivot, cdtype REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: ptab LOGICAL, INTENT(in) :: ldchk ! INTEGER(KIND=4) :: ii, ij REAL(KIND=4) :: zrat !!---------------------------------------------------------------------- IF ( ldchk ) THEN PRINT *,' Full check not written yet ' ; STOP ELSE SELECT CASE ( cdpivot) CASE ( 'T','t') SELECT CASE (cdtype ) CASE ( 'T','t') ii = 1 DO WHILE ( ptab(ii,npjglo-1) == 0 .AND. ii < npiglo ) ii = ii+1 ENDDO IF ( ii /= npiglo ) THEN ij = 2*nipivot - ii +2 zrat = ptab(ij,npjglo-1) / ptab(ii,npjglo-1) IF ( ABS(zrat) /= 1. ) THEN PRINT *, 'INCOHERENT value in T point ', TRIM(cv_names(jvar)), zrat ierr = closeout(ncout) STOP ELSE chkisig = zrat ENDIF ENDIF CASE ( 'U','u') ii = 1 DO WHILE ( ptab(ii,npjglo-1) == 0 .AND. ii < npiglo ) ii = ii+1 ENDDO ij = 2*nipivot - ii + 1 zrat = ptab(ij,npjglo-1) / ptab(ii,npjglo-1) IF ( ABS(zrat) /= 1. ) THEN PRINT *, 'INCOHERENT value in U point ', TRIM(cv_names(jvar)), zrat ierr = closeout(ncout) STOP ELSE chkisig=zrat ENDIF CASE ( 'V','v') ii = 1 DO WHILE ( ptab(ii,npjglo-1) == 0 .AND. ii < npiglo ) ii = ii+1 ENDDO ij = 2*nipivot - ii + 2 zrat = ptab(ij,npjglo-2) / ptab(ii,npjglo-1) IF ( ABS(zrat) /= 1. ) THEN PRINT *, 'INCOHERENT value in V point ', TRIM(cv_names(jvar)), zrat ierr = closeout(ncout) STOP ELSE chkisig=zrat ENDIF END SELECT CASE ( 'F','f') PRINT *, 'F pivot not done yet ' ; STOP END SELECT ENDIF END FUNCTION chkisig SUBROUTINE unfold( ptabin, ptabout, kjatl, kjpacif, cdpivot, cdtype, ksig) !!--------------------------------------------------------------------- !! *** ROUTINE unfold *** !! !! ** Purpose : unfold the north pole !! !! ----------------------------------------------------------------------- REAL(KIND=4), DIMENSION(npiglo,npjglo), INTENT(in ) :: ptabin REAL(KIND=4), DIMENSION(npiarctic,npjarctic), INTENT(out) :: ptabout INTEGER(KIND=4), INTENT(in ) :: kjatl INTEGER(KIND=4), INTENT(in ) :: kjpacif CHARACTER(LEN=*), INTENT(in ) :: cdpivot CHARACTER(LEN=*), INTENT(in ) :: cdtype INTEGER(KIND=4), INTENT(in ) :: ksig INTEGER(KIND=4) :: ji, jj INTEGER(KIND=4) :: ipivot INTEGER(KIND=4) :: ijn, ii, ij !! ----------------------------------------------------------------------- ! ipivot=npiglo/2 DO jj=kjatl, npjglo ij = jj-kjatl+1 ptabout(:,ij) = ptabin(ipivot:npiglo,jj) ENDDO ijn=ij SELECT CASE ( cdpivot ) CASE ('T','t') ! pivot SELECT CASE ( cdtype ) CASE ('T','t') DO jj=npjglo-3,kjpacif, -1 ij= ijn + ( npjglo - 3 - jj ) +1 ! 2 *npjglo - kjatl -1 -jj DO ji = 2, npiarctic ii = ipivot - ji + 3 ptabout(ji,ij) = ksig * ptabin(ii, jj) ENDDO ENDDO CASE ('V','v') DO jj=npjglo-4,kjpacif-1, -1 ij= ijn + ( npjglo - 4 - jj ) +1 ! 2 *npjglo - kjatl -1 -jj DO ji = 2, npiarctic ii = ipivot - ji + 3 ptabout(ji,ij) = ksig * ptabin(ii, jj) ENDDO ENDDO CASE ('U','u') DO jj=npjglo-3,kjpacif, -1 ij= ijn + ( npjglo - 3 - jj ) +1 ! 2 *npjglo - kjatl -1 -jj DO ji = 1, npiarctic ii = ipivot -ji + 2 ptabout(ji,ij) = ksig * ptabin(ii, jj) ENDDO ENDDO END SELECT CASE ('F','f') ! pivot PRINT * , ' Not yet done for F pivot ' ; STOP END SELECT END SUBROUTINE unfold END PROGRAM cdfnorth_unfold cdftools-3.0/cdfvsig.f900000644000175000017500000003750112241227304016273 0ustar amckinstryamckinstryPROGRAM cdfvsig !!====================================================================== !! *** PROGRAM cdfvsig *** !!===================================================================== !! ** Purpose : Compute the average values for the products !! U.sig, V.sig, W.sig where sig is the potential density. !! !! ** Method : pass the CONFIG name and a series of tags as arguments. !! Tracers are interpolated on velocity points. The product !! is evaluated at velocity points. !! !! History : 2.1 : 11/2004 : J.M. Molines : Original code !! 2.1 : 02/2010 : J.M. Molines : handle multiframes input files. !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames USE modutils !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt, jtt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ntframe ! Cumul of time frame INTEGER(KIND=4) :: ncoutu ! ncid of output file INTEGER(KIND=4) :: ncoutv ! ncid of output file INTEGER(KIND=4) :: ncoutw ! ncid of output file INTEGER(KIND=4), DIMENSION(3) :: ipku, id_varoutu ! level and varid's of output vars INTEGER(KIND=4), DIMENSION(3) :: ipkv, id_varoutv ! level and varid's of output vars INTEGER(KIND=4), DIMENSION(3) :: ipkw, id_varoutw ! level and varid's of output vars REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp, zsal ! Array to read a layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, zv, zw ! Velocity component REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztempu, zsalu ! Array to read a layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztempv, zsalv ! Array to read a layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztempw, zsalw ! Array to read a layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: umask, vmask, wmask ! masks REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter of individual files REAL(KIND=4), DIMENSION(1) :: timean ! mean time REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulus ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulvs ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulws ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulsu ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulsv ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulsw ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulu ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulv ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulw ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsigu ! Array for sigma0 at u point REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsigv ! Array for sigma0 at v point REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsigw ! Array for sigma0 at w point REAL(KIND=8) :: dtotal_time ! cumulated time CHARACTER(LEN=256) :: cf_tfil ! TS file name CHARACTER(LEN=256) :: cf_ufil ! zonal velocity file CHARACTER(LEN=256) :: cf_vfil ! meridional velocity file CHARACTER(LEN=256) :: cf_wfil ! vertical velocity file CHARACTER(LEN=256) :: cf_outu='usig.nc' ! output file CHARACTER(LEN=256) :: cf_outv='vsig.nc' ! output file CHARACTER(LEN=256) :: cf_outw='wsig.nc' ! output file CHARACTER(LEN=256) :: config ! configuration name CHARACTER(LEN=256) :: ctag ! current tag to work with TYPE (variable), DIMENSION(3) :: stypvaru ! structure for attributes TYPE (variable), DIMENSION(3) :: stypvarv ! structure for attributes TYPE (variable), DIMENSION(3) :: stypvarw ! structure for attributes LOGICAL :: lcaltmean ! flag for mean time computation !!---------------------------------------------------------------------- CALL ReadCdfNames() !! Read command line narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfvsig CONFIG ''list_of_tags'' ' PRINT *,' PURPOSE :' PRINT *,' Compute the time average values for second order products ' PRINT *,' U.sig, V.sig and W.sig. Also save mean sigma-0 interpolated at' PRINT *,' velocity points, as well as mean velocity component, for further use.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' CONFIG is the config name of a given experiment (eg ORCA025-G70)' PRINT *,' The program will look for gridT, gridU, gridV and gridW files for' PRINT *,' this config ( grid_T, grid_U, grid_V and grid_W are also accepted).' PRINT *,' list_of_tags : a list of time tags that will be used for time' PRINT *,' averaging. e.g. y2000m01d05 y2000m01d10 ...' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_outu),', ',TRIM(cf_outv),' and ', TRIM(cf_outw) PRINT *,' variables : vousig, vovsig, vowsig : mean product v x sigma-0 ' PRINT *,' at velocity point.' PRINT *,' vosigu, vosigv, vosigw : mean sigma-0 at velocity point.' PRINT *,' ',TRIM(cn_vozocrtx),', ',TRIM(cn_vomecrty),', ',TRIM(cn_vovecrtz),' : mean velocity components.' STOP ENDIF !! Initialisation from 1st file (all file are assume to have the same geometry) CALL getarg (1, config) CALL getarg (2, ctag ) cf_tfil = SetFileName ( config, ctag, 'T') cf_ufil = SetFileName ( config, ctag, 'U') cf_vfil = SetFileName ( config, ctag, 'V') cf_wfil = SetFileName ( config, ctag, 'W') npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) ipku(:)= npk ! all variables (input and output are 3D) ipkv(:)= npk ! " " ipkw(:)= npk ! " " ! define output variables U points stypvaru%rmissing_value = 0. stypvaru%valid_min = -100. stypvaru%valid_max = 100. stypvaru%conline_operation = 'N/A' stypvaru%caxis = 'TZYX' stypvaru(1)%cname = 'vousig' ; stypvaru(1)%cunits = 'kg.m-2.s-1' stypvaru(2)%cname = 'vosigu' ; stypvaru(2)%cunits = 'kg.m-3' stypvaru(3)%cname = cn_vozocrtx ; stypvaru(3)%cunits = 'm/s' stypvaru(1)%clong_name = 'Mean U x sigma0' ; stypvaru(1)%cshort_name = 'vousig' stypvaru(2)%clong_name = 'Mean sigma0 at U' ; stypvaru(2)%cshort_name = 'vosigu' stypvaru(3)%clong_name = 'Mean zonal vel' ; stypvaru(3)%cshort_name = cn_vozocrtx ! define output variables V points stypvarv%rmissing_value = 0. stypvarv%valid_min = -100. stypvarv%valid_max = 100. stypvarv%conline_operation = 'N/A' stypvarv%caxis = 'TZYX' stypvarv(1)%cname = 'vovsig' ; stypvarv(1)%cunits = 'kg.m-2.s-1' stypvarv(2)%cname = 'vosigv' ; stypvarv(2)%cunits = 'kg.m-3' stypvarv(3)%cname = cn_vomecrty ; stypvarv(3)%cunits = 'm/s' stypvarv(1)%clong_name = 'Mean V x sigma0' ; stypvarv(1)%cshort_name = 'vovsig' stypvarv(2)%clong_name = 'Mean sigma0 at V' ; stypvarv(2)%cshort_name = 'vosigv' stypvarv(3)%clong_name = 'Mean merid vel' ; stypvarv(3)%cshort_name = cn_vomecrty ! define output variables W points stypvarw%rmissing_value = 0. stypvarw%valid_min = -100. stypvarw%valid_max = 100. stypvarw%conline_operation = 'N/A' stypvarw%caxis = 'TZYX' stypvarw(1)%cname = 'vowsig' ; stypvarw(1)%cunits = 'kg.m-2.s-1' stypvarw(2)%cname = 'vosigw' ; stypvarw(2)%cunits = 'kg.m-3' stypvarw(3)%cname = cn_vovecrtz ; stypvarw(3)%cunits = 'm/s' stypvarw(1)%clong_name = 'Mean W x sigma0' ; stypvarw(1)%cshort_name = 'vowsig' stypvarw(2)%clong_name = 'Mean sigma0 at W' ; stypvarw(2)%cshort_name = 'vosigw' stypvarw(3)%clong_name = 'Mean vert. vel' ; stypvarw(3)%cshort_name = cn_vovecrtz PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk ALLOCATE( dcumulus(npiglo,npjglo), dcumulvs(npiglo,npjglo), dcumulws(npiglo,npjglo) ) ALLOCATE( dcumulsu(npiglo,npjglo), dcumulsv(npiglo,npjglo), dcumulsw(npiglo,npjglo) ) ALLOCATE( dcumulu(npiglo,npjglo), dcumulv(npiglo,npjglo), dcumulw(npiglo,npjglo) ) ALLOCATE( ztemp(npiglo,npjglo), zsal(npiglo,npjglo) ) ALLOCATE( zu(npiglo,npjglo), zv(npiglo,npjglo), zw(npiglo,npjglo) ) ALLOCATE( dsigu(npiglo,npjglo), dsigv(npiglo,npjglo), dsigw(npiglo,npjglo) ) ALLOCATE( umask(npiglo,npjglo), vmask(npiglo,npjglo), wmask(npiglo,npjglo) ) ! create output fileset ncoutu = create (cf_outu, cf_ufil, npiglo, npjglo, npk ) ierr = createvar (ncoutu, stypvaru, 3, ipku, id_varoutu ) ierr = putheadervar(ncoutu, cf_ufil, npiglo, npjglo, npk ) ncoutv = create (cf_outv, cf_vfil, npiglo, npjglo, npk ) ierr = createvar (ncoutv, stypvarv, 3, ipkv, id_varoutv ) ierr = putheadervar(ncoutv, cf_vfil, npiglo, npjglo, npk ) ncoutw = create (cf_outw, cf_wfil, npiglo, npjglo, npk ) ierr = createvar (ncoutw, stypvarw, 3, ipku, id_varoutw ) ierr = putheadervar(ncoutw, cf_wfil, npiglo, npjglo, npk ) lcaltmean=.TRUE. DO jk = 1, npk PRINT *,'level ',jk dcumulus(:,:) = 0.d0 ; dcumulvs(:,:) = 0.d0 ; dcumulws(:,:) = 0.d0 dcumulsu(:,:) = 0.d0 ; dcumulsv(:,:) = 0.d0 ; dcumulsw(:,:) = 0.d0 dcumulu(:,:) = 0.d0 ; dcumulv(:,:) = 0.d0 ; dcumulw(:,:) = 0.d0 dtotal_time = 0.d0 ; ntframe = 0 umask(:,:) = getvar(cn_fmsk, 'umask' , jk, npiglo, npjglo ) vmask(:,:) = getvar(cn_fmsk, 'vmask' , jk, npiglo, npjglo ) wmask(:,:) = getvar(cn_fmsk, 'tmask' , jk, npiglo, npjglo ) DO jt = 2, narg ! loop on tags CALL getarg (jt, ctag) cf_tfil = SetFileName ( config, ctag, 'T' ) cf_ufil = SetFileName ( config, ctag, 'U' ) cf_vfil = SetFileName ( config, ctag, 'V' ) cf_wfil = SetFileName ( config, ctag, 'W' ) npt = getdim (cf_tfil, cn_t) IF ( lcaltmean ) THEN ALLOCATE ( tim(npt) ) tim = getvar1d(cf_tfil, cn_vtimec, npt) dtotal_time = dtotal_time + SUM(tim(1:npt) ) DEALLOCATE( tim ) END IF DO jtt = 1, npt ! loop on time frame in a single file ntframe = ntframe+1 zu(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jtt ) zv(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jtt ) zw(:,:) = getvar(cf_wfil, cn_vovecrtz, jk, npiglo, npjglo, ktime=jtt ) ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jtt ) zsal(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jtt ) ! temperature at u point, v points dsigu(:,:) = 0.d0 ; dsigv(:,:) = 0.d0 DO ji=1, npiglo-1 DO jj = 1, npjglo -1 ztempu(ji,jj) = 0.5 * ( ztemp(ji,jj) + ztemp(ji+1,jj) ) ! temper at Upoint ztempv(ji,jj) = 0.5 * ( ztemp(ji,jj) + ztemp(ji,jj+1) ) ! temper at Vpoint zsalu(ji,jj) = 0.5 * ( zsal(ji,jj) + zsal(ji+1,jj) ) ! sal at U point zsalv(ji,jj) = 0.5 * ( zsal(ji,jj) + zsal(ji,jj+1) ) ! sal at v point END DO END DO dsigu(:,:) = sigma0(ztempu, zsalu, npiglo, npjglo) * umask(:,:) dsigv(:,:) = sigma0(ztempv, zsalv, npiglo, npjglo) * vmask(:,:) dcumulus(:,:) = dcumulus(:,:) + dsigu(:,:) * zu(:,:) * 1.d0 dcumulvs(:,:) = dcumulvs(:,:) + dsigv(:,:) * zv(:,:) * 1.d0 dcumulsu(:,:) = dcumulsu(:,:) + dsigu(:,:) * 1.d0 dcumulsv(:,:) = dcumulsv(:,:) + dsigv(:,:) * 1.d0 dcumulu(:,:) = dcumulu(:,:) + zu(:,:) * 1.d0 dcumulv(:,:) = dcumulv(:,:) + zv(:,:) * 1.d0 IF ( jk > 1 ) THEN ! now wsig ztempw(:,:) = 0.5 * ( ztemp(:,:) + getvar(cf_tfil, cn_votemper, jk-1, npiglo, npjglo, ktime=jtt )) zsalw(:,:) = 0.5 * ( zsal(:,:) + getvar(cf_tfil, cn_vosaline, jk-1, npiglo, npjglo, ktime=jtt )) dsigw(:,:) = sigma0(ztempw, zsalw, npiglo, npjglo) * wmask(:,:) dcumulws(:,:) = dcumulws(:,:) + dsigw(:,:) * zw(:,:) * 1.d0 dcumulsw(:,:) = dcumulsw(:,:) + dsigw(:,:) * 1.d0 dcumulw(:,:) = dcumulw(:,:) + zw(:,:) * 1.d0 ENDIF END DO !jtt END DO ! jt ! finish with level jk ; compute mean (assume spval is 0 ) ierr = putvar(ncoutu, id_varoutu(1), SNGL(dcumulus(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe ) ierr = putvar(ncoutu, id_varoutu(2), SNGL(dcumulsu(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe ) ierr = putvar(ncoutu, id_varoutu(3), SNGL(dcumulu(:,:) /ntframe), jk, npiglo, npjglo, kwght=ntframe ) ierr = putvar(ncoutv, id_varoutv(1), SNGL(dcumulvs(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe ) ierr = putvar(ncoutv, id_varoutv(2), SNGL(dcumulsv(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe ) ierr = putvar(ncoutv, id_varoutv(3), SNGL(dcumulv(:,:) /ntframe), jk, npiglo, npjglo, kwght=ntframe ) ierr = putvar(ncoutw, id_varoutw(1), SNGL(dcumulws(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe ) ierr = putvar(ncoutw, id_varoutw(2), SNGL(dcumulsw(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe ) ierr = putvar(ncoutw, id_varoutw(3), SNGL(dcumulw(:,:) /ntframe), jk, npiglo, npjglo, kwght=ntframe ) IF ( lcaltmean ) THEN timean(1) = dtotal_time/ntframe ierr = putvar1d(ncoutu, timean, 1, 'T') ierr = putvar1d(ncoutv, timean, 1, 'T') ierr = putvar1d(ncoutw, timean, 1, 'T') END IF lcaltmean = .FALSE. ! tmean already computed END DO ! loop to next level ierr = closeout(ncoutu) ierr = closeout(ncoutv) ierr = closeout(ncoutw) END PROGRAM cdfvsig cdftools-3.0/cdfconvert.f900000644000175000017500000006024712241227304017006 0ustar amckinstryamckinstryPROGRAM cdfconvert !!====================================================================== !! *** PROGRAM cdfconvert *** !!===================================================================== !! ** Purpose : Convert a set of dimgfile (Clipper like) !! to a set of CDF files (Drakkar like ) !! !! ** Method : Read tag then open the respective T S 2D U V files to create !! gridT, gridU and gridV files. !! Requires mesh_hgr.nc and mesh_zgr.nc files !! !! History : 2.1 : 01/2007 : J.M. Molines : Original code !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! isdirect : integer function which return the record length !! of the file in argument if a dimgfile, 0 else. !! !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index INTEGER(KIND=4) :: jt, jvar ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: nvar ! number of output variables INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: irecl, ii, ndim ! dimg stuff variables INTEGER(KIND=4) :: numu=10 ! logical id for input dimg file INTEGER(KIND=4) :: numv=11 ! " " INTEGER(KIND=4) :: numt=12 ! " " INTEGER(KIND=4) :: nums=14 ! " " INTEGER(KIND=4) :: num2d=15 ! " " INTEGER(KIND=4) :: numssh=16 ! " " INTEGER(KIND=4) :: numuu=17 ! " " INTEGER(KIND=4) :: numvv=18 ! " " INTEGER(KIND=4) :: ncout ! ncid of output netcdf file INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! outpur variables levels and id's REAL(KIND=4) :: x1, y1 ! dimg header ( SW corner) REAL(KIND=4) :: dx, dy ! dimg header ( x,y step) REAL(KIND=4) :: zspval ! dimg header ( special value) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, glam, gphi ! working arrays REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zdep ! depth REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter CHARACTER(LEN=256) :: cf_ufil ! output gridU file CHARACTER(LEN=256) :: cf_vfil ! output gridV file CHARACTER(LEN=256) :: cf_tfil ! output gridT file CHARACTER(LEN=256) :: cf_bsfil ! output BSF file CHARACTER(LEN=256) :: cf_dimgu ! input dimg U file CHARACTER(LEN=256) :: cf_dimgv ! input dimg V file CHARACTER(LEN=256) :: cf_dimgt ! input dimg T file CHARACTER(LEN=256) :: cf_dimgs ! input dimg S file CHARACTER(LEN=256) :: cf_dimg2d ! input dimg 2D file CHARACTER(LEN=256) :: cf_dimguu ! input dimg U2 file CHARACTER(LEN=256) :: cf_dimgvv ! input dimg V2 file CHARACTER(LEN=256) :: cf_dimgssh ! input dimg SSH file CHARACTER(LEN=256) :: ctag ! time tag CHARACTER(LEN=256) :: confcase ! config-case CHARACTER(LEN=80 ) :: cheader ! comment in header of dimg file CHARACTER(LEN=4 ) :: cver ! dimg version TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! output data structure LOGICAL :: lexist ! flag for existing file LOGICAL :: lchk = .FALSE. ! flag for missing files !!---------------------------------------------------------------------- !! Read command line narg= iargc() IF ( narg /= 2 ) THEN PRINT *,' usage : cdfconvert CLIPPER_tag CLIPPER_Confcase' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Convert dimg files (CLIPPER like) to netcdf (DRAKKAR like).' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' CLIPPER_tag : a string such as y2000m01d15 for time identification.' PRINT *,' CLIPPER_confcase : CONFIG-CASE of the files to be converted (eg ATL6-V6)' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),' and ', TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : gridT, gridU, gridV files' PRINT *,' variables : same as in standard NEMO output' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfflxconv, cdfsstconv, cdfstrconv' PRINT *,' ' STOP ENDIF !! CALL getarg (1, ctag) CALL getarg (2, confcase) lchk = lchk .OR. chkfile( cn_fhgr ) lchk = lchk .OR. chkfile (cn_fzgr ) !! Build dimg file names cf_dimgu = TRIM(confcase)//'_U_' //TRIM(ctag)//'.dimg' ; lchk = lchk .OR. chkfile(cf_dimgu ) cf_dimgv = TRIM(confcase)//'_V_' //TRIM(ctag)//'.dimg' ; lchk = lchk .OR. chkfile(cf_dimgv ) cf_dimgt = TRIM(confcase)//'_T_' //TRIM(ctag)//'.dimg' ; lchk = lchk .OR. chkfile(cf_dimgt ) cf_dimgs = TRIM(confcase)//'_S_' //TRIM(ctag)//'.dimg' ; lchk = lchk .OR. chkfile(cf_dimgs ) cf_dimg2d = TRIM(confcase)//'_2D_' //TRIM(ctag)//'.dimg' ; lchk = lchk .OR. chkfile(cf_dimg2d) IF ( lchk ) STOP ! missing file cf_dimgssh = TRIM(confcase)//'_SSH_'//TRIM(ctag)//'.dimg' cf_dimguu = TRIM(confcase)//'_UU_' //TRIM(ctag)//'.dimg' cf_dimgvv = TRIM(confcase)//'_VV_' //TRIM(ctag)//'.dimg' cf_ufil = TRIM(confcase)//'_' //TRIM(ctag)//'_gridU.nc' cf_vfil = TRIM(confcase)//'_' //TRIM(ctag)//'_gridV.nc' cf_tfil = TRIM(confcase)//'_' //TRIM(ctag)//'_gridT.nc' cf_bsfil = TRIM(confcase)//'_' //TRIM(ctag)//'_PSI.nc' ! open (and check ?? if they exists ) irecl=isdirect(cf_dimgu ) ; OPEN( numu, FILE=cf_dimgu, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) irecl=isdirect(cf_dimgv ) ; OPEN( numv, FILE=cf_dimgv, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) irecl=isdirect(cf_dimgt ) ; OPEN( numt, FILE=cf_dimgt, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) irecl=isdirect(cf_dimgs ) ; OPEN( nums, FILE=cf_dimgs, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) irecl=isdirect(cf_dimg2d) ; OPEN( num2d, FILE=cf_dimg2d, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numt,REC=1) cver, cheader, ii, npiglo, npjglo, npk, npt ALLOCATE (v2d(npiglo, npjglo), glam(npiglo,npjglo), gphi(npiglo,npjglo), zdep(npk), tim(npt) ) READ(numt,REC=1) cver, cheader, ii, npiglo, npjglo, npk, npt, ndim, & & x1,y1,dx,dy,zspval, & & ( zdep(jk),jk=1,npk), & ( tim(jt), jt=1,npt) ! transform Clipper days to drakkar seconds ... tim(:)=tim(:)*86400. !############### !# GRID T FILE # !############### ! Build gridT file with votemper, vosaline, sossheig, ... fluxes ... INQUIRE(FILE=cf_dimgssh, EXIST=lexist) IF ( lexist ) THEN irecl = isdirect(cf_dimgssh) OPEN( numssh,FILE=cf_dimgssh, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) nvar = 10 ELSE nvar = 9 ENDIF ALLOCATE ( stypvar(nvar), ipk(nvar), id_varout(nvar) ) jvar=1 ipk(jvar) = npk stypvar(jvar)%cname = cn_votemper stypvar(jvar)%cunits = 'C' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = -2. stypvar(jvar)%valid_max = 40. stypvar(jvar)%clong_name = 'Potential Temperature' stypvar(jvar)%cshort_name = cn_votemper stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TZYX' jvar=jvar+1 ipk(jvar) = npk stypvar(jvar)%cname = cn_vosaline stypvar(jvar)%cunits = 'PSU' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = 0. stypvar(jvar)%valid_max = 45. stypvar(jvar)%clong_name = 'Salinity' stypvar(jvar)%cshort_name = cn_vosaline stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TZYX' jvar=jvar+1 IF ( lexist ) THEN ipk(jvar) = 1 stypvar(jvar)%cname = cn_sossheig stypvar(jvar)%cunits = 'm' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = -10. stypvar(jvar)%valid_max = 10. stypvar(jvar)%clong_name = 'Sea_Surface_height' stypvar(jvar)%cshort_name = cn_sossheig stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TYX' jvar=jvar+1 ENDIF ipk(jvar) = 1 stypvar(jvar)%cname = cn_somxl010 ! rec 12 of dimg file 2D stypvar(jvar)%cunits = 'm' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = 0. stypvar(jvar)%valid_max = 7000. stypvar(jvar)%clong_name = 'Mixed_Layer_Depth_on_0.01_rho_crit' stypvar(jvar)%cshort_name = cn_somxl010 stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TYX' jvar=jvar+1 ipk(jvar) = 1 stypvar(jvar)%cname = 'sohefldo' ! rec 4 of dimg file 2D stypvar(jvar)%cunits = 'W/m2' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = -1000. stypvar(jvar)%valid_max = 1000. stypvar(jvar)%clong_name = 'Net_Downward_Heat_Flux' stypvar(jvar)%cshort_name = 'sohefldo' stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TYX' jvar=jvar+1 ipk(jvar) = 1 stypvar(jvar)%cname = cn_soshfldo ! rec 8 of dimg file 2D (qsr) stypvar(jvar)%cunits = 'W/m2' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = -1000. stypvar(jvar)%valid_max = 1000. stypvar(jvar)%clong_name = 'Short_Wave_Radiation' stypvar(jvar)%cshort_name = cn_soshfldo stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TYX' jvar=jvar+1 ipk(jvar) = 1 stypvar(jvar)%cname = cn_sowaflup ! rec 5 of dimg file 2D (emp) stypvar(jvar)%cunits = 'kg/m2/s' ! conversion required from CLIPPER /86400. stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = -1000. stypvar(jvar)%valid_max = 1000. stypvar(jvar)%clong_name = 'Net_Upward_Water_Flux' stypvar(jvar)%cshort_name = cn_sowaflup stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TYX' jvar=jvar+1 ipk(jvar) = 1 stypvar(jvar)%cname = 'sowafldp' ! rec 10 of dimg file 2D (erp) stypvar(jvar)%cunits = 'kg/m2/s' ! conversion required from CLIPPER /jvar. stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = -1000. stypvar(jvar)%valid_max = 1000. stypvar(jvar)%clong_name = 'Surface_Water_Flux:Damping' stypvar(jvar)%cshort_name = 'sowafldp' stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TYX' jvar=jvar+1 ipk(jvar) = 1 stypvar(jvar)%cname = cn_soicecov ! rec 13 of dimg file 2D (erp) stypvar(jvar)%cunits = '%' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = 0. stypvar(jvar)%valid_max = 1. stypvar(jvar)%clong_name = 'Ice Cover' stypvar(jvar)%cshort_name = cn_soicecov stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TYX' jvar=jvar+1 ipk(jvar) = 1 stypvar(jvar)%cname = 'sohefldp' ! rec 9 of dimg file 2D (erp) stypvar(jvar)%cunits = 'W/m2' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = -10. stypvar(jvar)%valid_max = 10. stypvar(jvar)%clong_name = 'Surface Heat Flux: Damping' stypvar(jvar)%cshort_name = 'sohefldp' stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TYX' glam = getvar (cn_fhgr, cn_glamt, 1, npiglo, npjglo) gphi = getvar (cn_fhgr, cn_gphit, 1, npiglo, npjglo) zdep = getvare3(cn_fzgr, cn_gdept, npk ) ncout = create (cf_tfil, 'none', npiglo, npjglo, npk, cdep=cn_vdeptht ) ierr = createvar (ncout, stypvar, nvar, ipk, id_varout ) ierr = putheadervar(ncout, 'none', npiglo, npjglo, npk, pnavlon=glam, pnavlat=gphi, pdep=zdep ) jvar=1 ! T DO jk=1, npk READ(numt,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, jk, npiglo, npjglo) END DO jvar = jvar+1 PRINT *, 'Done for T' ! S DO jk=1, npk READ(nums,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, jk, npiglo, npjglo) END DO jvar = jvar+1 PRINT *, 'Done for S' IF ( lexist ) THEN ! SSH READ(numssh,REC=2) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo) jvar = jvar+1 PRINT *, 'Done for SSH' ENDIF ! MXL READ(num2d,REC=12) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo) jvar = jvar+1 PRINT *, 'Done for MXL' ! QNET READ(num2d,REC=4 ) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo) jvar = jvar+1 PRINT *, 'Done for QNET' ! QSR READ(num2d,REC=8) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo) jvar = jvar+1 PRINT *, 'Done for QSR' ! EMP READ(num2d,REC=5) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) v2d = v2d/86400. ! to change units ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo) jvar = jvar+1 PRINT *, 'Done for EMP' ! ERP READ(num2d,REC=10) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) v2d = v2d/86400. ! to change units ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo) jvar = jvar+1 PRINT *, 'Done for ERP' ! FREEZE READ(num2d,REC=13) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo) jvar = jvar+1 PRINT *, 'Done for FREEZE' ! QRP READ(num2d,REC=9) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo) jvar = jvar+1 PRINT *, 'Done for QRP' ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) DEALLOCATE ( stypvar, ipk, id_varout ) !############### !# GRID U FILE # !############### ! Build gridU file with vozocrtx, sozotaux INQUIRE(FILE=cf_dimguu, EXIST=lexist) IF ( lexist ) THEN irecl = isdirect(cf_dimguu) OPEN( numuu, FILE=cf_dimguu, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) nvar=3 ELSE nvar=2 ENDIF ALLOCATE ( stypvar(nvar), ipk(nvar), id_varout(nvar) ) jvar = 1 ipk(jvar) = npk stypvar(jvar)%cname = cn_vozocrtx stypvar(jvar)%cunits = 'm/s' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = 0. stypvar(jvar)%valid_max = 20. stypvar(jvar)%clong_name = 'Zonal Velocity ' stypvar(jvar)%cshort_name = cn_vozocrtx stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TZYX' jvar = jvar+1 ipk(jvar) = 1 stypvar(jvar)%cname = 'sozotaux' stypvar(jvar)%cunits = 'N/m2' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = 0. stypvar(jvar)%valid_max = 20. stypvar(jvar)%clong_name = 'Zonal Wind Stress' stypvar(jvar)%cshort_name = 'sozotaux' stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TYX' jvar = jvar+1 IF ( lexist ) THEN ipk(jvar) = npk stypvar(jvar)%cname = TRIM(cn_vozocrtx)//'_sqd' stypvar(jvar)%cunits = 'm2/s2' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = 0. stypvar(jvar)%valid_max = 100. stypvar(jvar)%clong_name = 'MS_Zonal_Velocity' stypvar(jvar)%cshort_name = TRIM(cn_vozocrtx)//'_sqd' stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TZYX' ENDIF glam = getvar (cn_fhgr, cn_glamu, 1, npiglo, npjglo) gphi = getvar (cn_fhgr, cn_gphiu, 1, npiglo, npjglo) zdep = getvare3(cn_fzgr, cn_gdept, npk ) ncout = create (cf_ufil, 'none', npiglo, npjglo, npk, cdep=cn_vdepthu ) ierr = createvar (ncout, stypvar, nvar, ipk, id_varout ) ierr = putheadervar(ncout, 'none', npiglo, npjglo, npk, pnavlon=glam, pnavlat=gphi, pdep=zdep ) jvar=1 DO jk=1, npk READ(numu,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, jk, npiglo, npjglo) END DO jvar = jvar+1 PRINT *, 'Done for U' READ(num2d, REC=2 ) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo) jvar = jvar+1 PRINT *, 'Done for TAUX' IF ( lexist ) THEN DO jk=1, npk READ(numuu,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, jk, npiglo, npjglo) END DO PRINT *, 'Done for UU' ENDIF ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout ) DEALLOCATE ( stypvar, ipk, id_varout ) !############### !# GRID V FILE # !############### ! Build gridV file with vomecrty, sometauy INQUIRE(FILE=cf_dimgvv, EXIST=lexist) IF ( lexist ) THEN irecl = isdirect(cf_dimgvv) OPEN( numvv, FILE=cf_dimgvv, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) nvar=3 ELSE nvar=2 ENDIF ALLOCATE ( stypvar(nvar), ipk(nvar), id_varout(nvar) ) jvar=1 ipk(jvar) = npk stypvar(jvar)%cname = cn_vomecrty stypvar(jvar)%cunits = 'm/s' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = 0. stypvar(jvar)%valid_max = 20. stypvar(jvar)%clong_name = 'Meridinal Velocity ' stypvar(jvar)%cshort_name = cn_vomecrty stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TZYX' jvar = jvar+1 ipk(jvar) = 1 stypvar(jvar)%cname = 'sometauy' stypvar(jvar)%cunits = 'N/m2' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = 0. stypvar(jvar)%valid_max = 20. stypvar(jvar)%clong_name = 'Meridional Wind Stress' stypvar(jvar)%cshort_name = 'sometauy' stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TYX' jvar=jvar+1 IF ( lexist ) THEN ipk(jvar) = npk stypvar(jvar)%cname = TRIM(cn_vomecrty)//'_sqd' stypvar(jvar)%cunits = 'm2/s2' stypvar(jvar)%rmissing_value = 0. stypvar(jvar)%valid_min = 0. stypvar(jvar)%valid_max = 100. stypvar(jvar)%clong_name = 'MS_Meridional_Velocity' stypvar(jvar)%cshort_name = TRIM(cn_vomecrty)//'_sqd' stypvar(jvar)%conline_operation = 'N/A' stypvar(jvar)%caxis = 'TZYX' ENDIF glam = getvar (cn_fhgr, cn_glamv, 1, npiglo, npjglo) gphi = getvar (cn_fhgr, cn_gphiv, 1, npiglo, npjglo) zdep = getvare3(cn_fzgr, cn_gdept, npk ) ncout = create (cf_vfil, 'none', npiglo, npjglo, npk, cdep=cn_vdepthv ) ierr = createvar (ncout, stypvar, nvar, ipk, id_varout ) ierr = putheadervar(ncout, 'none', npiglo, npjglo, npk, pnavlon=glam, pnavlat=gphi, pdep=zdep ) jvar = 1 DO jk=1, npk READ(numv,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar (ncout, id_varout(jvar), v2d, jk, npiglo, npjglo) END DO jvar = jvar+1 PRINT *, 'Done for V' READ(num2d, REC=3) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo) jvar = jvar+1 PRINT *, 'Done for TAUY' IF ( lexist ) THEN DO jk=1, npk READ(numvv,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar), v2d, jk, npiglo, npjglo) END DO PRINT *, 'Done for VV' ENDIF ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout ) DEALLOCATE ( stypvar, ipk, id_varout ) !############### !# PSI FILE # !############### ! Build PSI file with sobarstf nvar=1 ALLOCATE ( stypvar(nvar), ipk(nvar), id_varout(nvar) ) ipk(1) = 1 stypvar(1)%cname = 'sobarstf' stypvar(1)%cunits = 'm3/s' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -3.e8 stypvar(1)%valid_max = 3.e8 stypvar(1)%clong_name = 'Barotropic_Stream_Function' stypvar(1)%cshort_name = 'sobarstf' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TYX' glam = getvar (cn_fhgr, cn_glamf, 1, npiglo, npjglo) gphi = getvar (cn_fhgr, cn_gphif, 1, npiglo, npjglo) zdep = getvare3(cn_fzgr, cn_gdept, 1 ) ncout = create (cf_bsfil, 'none', npiglo, npjglo, 1, cdep=cn_vdepthu ) ierr = createvar (ncout, stypvar, nvar, ipk, id_varout ) ierr = putheadervar(ncout, 'none', npiglo, npjglo, 1, pnavlon=glam, pnavlat=gphi, pdep=zdep ) jvar = 1 READ(num2d,REC=7) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo) ierr = putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo) PRINT *, 'Done for PSI' ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout ) DEALLOCATE ( stypvar, ipk, id_varout ) CONTAINS INTEGER(KIND=4) FUNCTION isdirect(cdname) !!--------------------------------------------------------------------- !! *** FUNCTION isdirect *** !! !! ** Purpose : This integer function returns the record length if cdname !! is a valid dimg file, it returns 0 either. !! !! ** Method : Open the file and look for the key characters (@!01) for !! identification. !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdname ! -- INTEGER(KIND=4) :: irecl INTEGER(KIND=4) :: inum = 100 CHARACTER(LEN=4) :: clver CHARACTER(LEN=80) :: clheader !!---------------------------------------------------------------------- ! OPEN(inum,FILE=cdname, FORM = 'UNFORMATTED', ACCESS = 'DIRECT', RECL = 88) READ(inum,REC=1) clver ,clheader, irecl CLOSE(inum) ! IF (clver == '@!01' ) THEN isdirect = irecl ELSE isdirect = 0 END IF ! END FUNCTION isdirect END PROGRAM cdfconvert cdftools-3.0/cdfcurl.f900000644000175000017500000002011712241227304016263 0ustar amckinstryamckinstryPROGRAM cdfcurl !!====================================================================== !! *** PROGRAM cdfcurl *** !!===================================================================== !! ** Purpose : Compute the curl on F-points for given gridU gridV !! files and variables !! !! ** Method : Use the same algorithm than NEMO !! !! History : 2.1 : 05/2005 : J.M. Molines : Original code !! : 2.1 : 06/2007 : P. Mathiot : for use with forcing fields !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jt ! dummy loop index INTEGER(KIND=4) :: ilev ! level to be processed INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: narg, iargc ! browse command line INTEGER(KIND=4) :: ncout, ierr ! browse command line INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! output variable properties REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2v, e1u, e1f, e2f ! horizontql metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn ! velocity field REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zun, zvn ! working arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rotn, fmask ! curl and fmask REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter CHARACTER(LEN=256) :: cf_ufil, cf_vfil ! file names CHARACTER(LEN=256) :: cf_out = 'curl.nc' ! output file name CHARACTER(LEN=256) :: cv_u, cv_v ! variable names CHARACTER(LEN=256) :: cldum ! dummy string TYPE (variable), DIMENSION(1) :: stypvar ! structure for attibutes LOGICAL :: lforcing = .FALSE. ! forcing flag LOGICAL :: lchk = .FALSE. ! flag for missing files LOGICAL :: lperio = .FALSE. ! flag for E-W periodicity !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg /= 5 ) THEN PRINT *,' usage : cdfcurl U-file V-file U-var V-var lev' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the curl of a vector field, at a specified level.' PRINT *,' If level is specified as 0, assume that the input files are' PRINT *,' forcing files, presumably on A-grid. In this latter case, the' PRINT *,' vector field is interpolated on the C-grid. In any case, the' PRINT *,' curl is computed on the F-point.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' U-file : zonal component of the vector field.' PRINT *,' V-file : meridional component of the vector field.' PRINT *,' U-var : zonal component variable name' PRINT *,' V-var : meridional component variable name.' PRINT *,' lev : level to be processed. If set to 0, assume forcing file ' PRINT *,' in input.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fhgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : socurl (s^-1)' STOP ENDIF CALL getarg(1, cf_ufil) CALL getarg(2, cf_vfil) CALL getarg(3, cv_u ) CALL getarg(4, cv_v ) CALL getarg(5, cldum ) ; READ(cldum,*) ilev lchk = chkfile(cn_fhgr ) .OR. lchk lchk = chkfile(cf_ufil ) .OR. lchk lchk = chkfile(cf_vfil ) .OR. lchk IF ( lchk ) STOP ! missing files ! define new variables for output stypvar(1)%cname = 'socurl' stypvar(1)%cunits = 's-1' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -1000. stypvar(1)%valid_max = 1000. stypvar(1)%clong_name = 'Relative_Vorticity (curl)' stypvar(1)%cshort_name = 'socurl' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TYX' ipk(1) = 1 ! 2D npiglo = getdim(cf_ufil,cn_x) npjglo = getdim(cf_ufil,cn_y) npk = getdim(cf_ufil,cn_z) npt = getdim(cf_ufil,cn_t) PRINT *, 'npiglo = ',npiglo PRINT *, 'npjglo = ',npjglo PRINT *, 'npk = ',npk PRINT *, 'npt = ',npt PRINT *, 'ilev = ',ilev !test if lev exists IF ( (npk==0) .AND. (ilev > 0) ) THEN PRINT *, 'Problem : npk = 0 and lev > 0 STOP' STOP END IF ! if forcing field IF ( ilev==0 .AND. npk==0 ) THEN lforcing=.true. npk = 1 ; ilev=1 PRINT *, 'npk =0, assume 1' END IF IF ( npt==0 ) THEN PRINT *, 'npt=0, assume 1' npt=1 END IF ! check files and determines if the curl will be 2D of 3D ! ???????????? ! Allocate the memory ALLOCATE ( e1u(npiglo,npjglo) , e1f(npiglo,npjglo) ) ALLOCATE ( e2v(npiglo,npjglo) , e2f(npiglo,npjglo) ) ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) ) ALLOCATE ( zun(npiglo,npjglo) , zvn(npiglo,npjglo) ) ALLOCATE ( rotn(npiglo,npjglo) , fmask(npiglo,npjglo) ) ALLOCATE ( tim(npt) ) e1u = getvar(cn_fhgr, cn_ve1u, 1, npiglo, npjglo) e1f = getvar(cn_fhgr, cn_ve1f, 1, npiglo, npjglo) e2v = getvar(cn_fhgr, cn_ve2v, 1, npiglo, npjglo) e2f = getvar(cn_fhgr, cn_ve2f, 1, npiglo, npjglo) ! use zun and zvn to store f latitude and longitude for output zun = getvar(cn_fhgr, cn_glamf, 1, npiglo, npjglo) zvn = getvar(cn_fhgr, cn_gphif, 1, npiglo, npjglo) ! look for E-W periodicity IF ( zun(1,1) == zun(npiglo-1,1) ) lperio = .TRUE. ! create output fileset ncout = create (cf_out, cf_ufil, npiglo, npjglo, 0 ) ierr = createvar (ncout , stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_ufil, npiglo, npjglo, 0, pnavlon=zun, pnavlat=zvn ) tim = getvar1d(cf_ufil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jt=1,npt IF (MOD(jt,100)==0 ) PRINT *, jt,'/',npt ! if files are forcing fields zun(:,:) = getvar(cf_ufil, cv_u, ilev ,npiglo,npjglo, ktime=jt) zvn(:,:) = getvar(cf_vfil, cv_v, ilev ,npiglo,npjglo, ktime=jt) IF ( lforcing ) THEN ! for forcing file u and v are on the A grid DO ji=1, npiglo-1 un(ji,:) = 0.5*(zun(ji,:) + zun(ji+1,:)) END DO ! DO jj=1, npjglo-1 vn(:,jj) = 0.5*(zvn(:,jj) + zvn(:,jj+1)) END DO ! end compute u and v on U and V point ELSE un(:,:) = zun(:,:) vn(:,:) = zvn(:,:) END IF ! compute the mask IF ( jt==1 ) THEN DO jj = 1, npjglo - 1 DO ji = 1, npiglo - 1 fmask(ji,jj)=0. fmask(ji,jj)= un(ji,jj)*un(ji,jj+1) * vn(ji,jj)*vn(ji+1,jj) IF (fmask(ji,jj) /= 0.) fmask(ji,jj)=1. ENDDO ENDDO END IF rotn(:,:) = 0. DO jj = 1, npjglo -1 DO ji = 1, npiglo -1 ! vector opt. rotn(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ) - e2v(ji,jj) * vn(ji,jj) & & - e1u(ji ,jj+1) * un(ji ,jj+1) + e1u(ji,jj) * un(ji,jj) ) & & * fmask(ji,jj) / ( e1f(ji,jj) * e2f(ji,jj) ) END DO END DO IF ( lperio ) rotn(npiglo,:) = rotn(2, :) ! write rotn on file at level k and at time jt ierr = putvar(ncout, id_varout(1), rotn, 1, npiglo, npjglo, ktime=jt) END DO ierr = closeout(ncout) END PROGRAM cdfcurl cdftools-3.0/cdfpendep.f900000644000175000017500000001412112241227304016567 0ustar amckinstryamckinstryPROGRAM cdfpendep !!====================================================================== !! *** PROGRAM cdfpendep *** !!===================================================================== !! ** Purpose : Computes penetration depth for passive tracer output. !! This is the ratio between inventory and surface !! concentration. !! !! ** Method : takes TRC files as input !! !! History : 2.1 : 02/2008 : J.M. Molines : Original code !! : 2.1 : 09/2010 : C. Dufour : Adapation to TOP evolution !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jt ! dummy loop index INTEGER(KIND=4) :: narg, iargc, ijarg ! browse command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vats REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: trcinv, trcsurf ! inventory, surface concentration REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rpendep ! penetration depth REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter CHARACTER(LEN=256) :: cf_trcfil ! tracer file name CHARACTER(LEN=256) :: cf_inv ! inventory file name CHARACTER(LEN=256) :: cf_out='pendep.nc' ! output file CHARACTER(LEN=256) :: cv_inv ! inventory variable name CHARACTER(LEN=256) :: cv_trc ! tracer variable name CHARACTER(LEN=256) :: cglobal ! global attribute CHARACTER(LEN=256) :: cldum ! dummy string TYPE(variable), DIMENSION(1) :: typvar ! structure for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() cv_inv = cn_invcfc cv_trc = cn_cfc11 narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfpendep TRC-file INV-file ... ' PRINT *,' ... [-inv inventory_name -trc trc_name ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the penetration depth for passive tracers. It is the' PRINT *,' ratio between the inventory and the surface concentration of' PRINT *,' the tracer.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' TRC-file : netcdf file with tracer concentration.' PRINT *,' INV-file : netcdf file with inventory of the tracer.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-inv inventory_name ] : specify netcdf variable name for inventory.' PRINT *,' Default is ', TRIM(cv_inv) PRINT *,' [-trc tracer_name ] : specify netcdf variable name for tracer.' PRINT *,' Default is ', TRIM(cv_trc) PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : pendep (m)' STOP ENDIF ijarg = 1 CALL getarg (ijarg, cf_trcfil) ; ijarg = ijarg + 1 CALL getarg (ijarg, cf_inv ) ; ijarg = ijarg + 1 IF ( chkfile(cf_trcfil) .OR. chkfile(cf_inv) ) STOP ! missing file DO WHILE ( ijarg <= narg) CALL getarg(ijarg, cldum ) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ('-inv') ; CALL getarg(ijarg, cv_inv) ; ijarg=ijarg+1 CASE ('-trc') ; CALL getarg(ijarg, cv_trc) ; ijarg=ijarg+1 CASE DEFAULT ; PRINT *, 'option ', TRIM(cldum),' not understood' ; STOP END SELECT END DO npiglo = getdim (cf_trcfil,cn_x) npjglo = getdim (cf_trcfil,cn_y) npk = getdim (cf_trcfil,cn_z) npt = getdim (cf_trcfil,cn_t) ipk(1) = 1 typvar(1)%cname = cn_pendep typvar(1)%cunits = 'm' typvar(1)%rmissing_value = 0. typvar(1)%valid_min = 0. typvar(1)%valid_max = 10000. typvar(1)%clong_name = 'Penetration depth' typvar(1)%cshort_name = cn_pendep typvar(1)%conline_operation = 'N/A' typvar(1)%caxis = 'TYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE( trcinv(npiglo,npjglo), trcsurf(npiglo,npjglo), rpendep(npiglo,npjglo) ) ALLOCATE( tim(npt) ) WRITE(cglobal,9000) TRIM(cf_trcfil), TRIM(cf_inv), TRIM(cv_inv), TRIM(cv_trc) 9000 FORMAT('cdfpendep ',a,' ',a,' -inv ',a,' -trc ',a ) ncout = create (cf_out, cf_trcfil, npiglo, npjglo, 1) ierr = createvar (ncout, typvar, 1, ipk, id_varout, cdglobal=cglobal ) ierr = putheadervar(ncout, cf_trcfil, npiglo, npjglo, 1) DO jt = 1,npt rpendep(:,:) = 0. trcinv( :,:) = getvar(cf_inv, cv_inv, 1, npiglo, npjglo, ktime=jt) trcsurf(:,:) = getvar(cf_trcfil, cv_trc, 1, npiglo, npjglo, ktime=jt) WHERE( trcsurf /= 0 ) rpendep = trcinv/trcsurf ierr=putvar(ncout, id_varout(1), rpendep, 1, npiglo, npjglo, ktime=jt) END DO tim = getvar1d(cf_trcfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdfpendep cdftools-3.0/cdfmaxmoc.f900000644000175000017500000002330312241227304016602 0ustar amckinstryamckinstryPROGRAM cdfmaxmoc !!====================================================================== !! *** PROGRAM cdfmaxmoc *** !!===================================================================== !! ** Purpose : Compute the maximum of the overturning fonction from !! a file calculated by cdfmoc !! !! ** Method : A spatial window, limited by latmin latmax depmin depmax !! given on the command line, is used to determnine the !! maximum and minimum of the MOC as well as their !! respective depth and latitude. !! !! History : 2.1 : 07/2005 : J.M. Molines : Original code !! : 11/2009 : R. Dussin : Netcdf output !! 3.0 : 03/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE ! INTEGER(KIND=4) :: jj, jk ! dummy loop index INTEGER(KIND=4) :: npjglo, npk ! size of the overturning INTEGER(KIND=4) :: narg, iargc ! line command stuff INTEGER(KIND=4) :: iarg ! line command stuff INTEGER(KIND=4) :: ijmin, ijmax ! latitude window where to look at extrema INTEGER(KIND=4) :: ikmin, ikmax ! depth window where to look at extrema INTEGER(KIND=4) :: ilatmin, ilatmax ! index of found extrema (latitude) INTEGER(KIND=4) :: idepmin, idepmax ! index of found extrema (depth ) INTEGER(KIND=4) :: nx=1, ny=1, nz=1 ! dims of netcdf output file INTEGER(KIND=4) :: nvarout=6 ! number of values to write in cdf output INTEGER(KIND=4) :: ncout, ierr ! for netcdf output INTEGER(KIND=4), DIMENSION(3) :: iminloc, imaxloc ! work arrays for minloc and maxloc INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! netcdf output ! REAL(KIND=4) :: ovtmax, ovtmin ! max/ min of MOC ( Sv) REAL(KIND=4) :: rlatmin, rlatmax ! latitude limits for searching REAL(KIND=4) :: rdepmin, rdepmax ! depth limits for searching REAL(KIND=4), DIMENSION(1) :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth read in the header REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon, rdumlat ! dummy array for output REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rlat ! latitude (1, npjglo) REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: rmoc ! MOC (1, npjglo, jpk) ! TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output ! CHARACTER(LEN=256) :: cf_moc ! input file CHARACTER(LEN=256) :: cf_ncout='maxmoc.nc' ! output file CHARACTER(LEN=256) :: cldum ! dummy string for I/O CHARACTER(LEN=256) :: cbasin, cv_in ! basin name and cdf variable name !!---------------------------------------------------------------------- CALL ReadCdfNames() narg=iargc() IF ( narg /= 6 ) THEN PRINT *,' usage : cdfmaxmoc OVT-file basin_name latmin latmax depmin depmax' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the maximum and minimum of the overturning, from file OVT-file,' PRINT *,' for oceanic basin specified by cbasin, and in the geographical frame ' PRINT *,' defined by latmin latmax, depmin, depmax.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' OVT-file : overturning file from cdfmoc, with or w/o sub basins.' PRINT *,' basin_name : name of oceanic subbasin as defined in ',TRIM(cn_fbasins) PRINT *,' usually it can be one of atl, glo, inp, ind or pac' PRINT *,' glo means no subbasins.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_ncout) PRINT *,' 6 variables : ' PRINT *,' maxmoc, minmoc ( sv ) : max and min of overturning' PRINT *,' latmaxmoc latminmoc ( deg) : latitudes of max and min.' PRINT *,' depmaxmoc depminmoc ( m) : depth of max amd min .' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfmoc ' PRINT *,' ' STOP ENDIF CALL getarg(1, cf_moc) ! input moc file CALL getarg(2, cbasin) ! basin name CALL getarg(3, cldum ) ; READ(cldum,*) rlatmin ! searching window : latmin CALL getarg(4, cldum ) ; READ(cldum,*) rlatmax ! searching window : latmax CALL getarg(5, cldum ) ; READ(cldum,*) rdepmin ! searching window : depth min CALL getarg(6, cldum ) ; READ(cldum,*) rdepmax ! searching window : depth max IF ( chkfile(cf_moc) ) STOP ! missing file npjglo = getdim(cf_moc, cn_y) npk = getdim(cf_moc, cn_z) ALLOCATE ( rmoc(1,npjglo,npk), gdepw(npk), rlat(1,npjglo)) gdepw(:) = -getvar1d(cf_moc, cn_vdepthw, npk ) rlat(:,:) = getvar (cf_moc, cn_vlat2d, 1, 1, npjglo) SELECT CASE (cbasin) CASE ('atl') ; cv_in=cn_zomsfatl CASE ('glo') ; cv_in=cn_zomsfglo CASE ('pac') ; cv_in=cn_zomsfpac CASE ('inp') ; cv_in=cn_zomsfinp CASE ('ind') ; cv_in=cn_zomsfind CASE DEFAULT ; STOP 'basin not found' END SELECT ALLOCATE ( stypvar(nvarout), ipk(nvarout), id_varout(nvarout) ) ALLOCATE ( rdumlon(1,1) , rdumlat(1,1) ) rdumlon(:,:)=0. rdumlat(:,:)=0. DO jj=1,nvarout ipk(jj)=1 ENDDO ! define new variables for output ! all variables : stypvar%rmissing_value = 99999. stypvar%scale_factor = 1. stypvar%add_offset = 0. stypvar%savelog10 = 0. stypvar%conline_operation = 'N/A' stypvar%caxis = 'T' ! each pair of variables stypvar(1)%cname = 'maxmoc' ; stypvar(2)%cname = 'minmoc' stypvar(1)%clong_name = 'Maximum_Overturing' ; stypvar(2)%clong_name = 'Minimum_Overtuning' stypvar(1)%cshort_name = 'maxmoc' ; stypvar(2)%cshort_name = 'minmoc' stypvar(1:2)%cunits = 'Sverdrup' stypvar(1:2)%valid_min = -1000. stypvar(1:2)%valid_max = 1000. stypvar(3)%cname = 'latmaxmoc' ; stypvar(4)%cname = 'latminmoc' stypvar(3)%clong_name = 'Latitude_of_Maximum_Overturing' ; stypvar(4)%clong_name = 'Latitude_of_Minimum_Overtuning' stypvar(3)%cshort_name = 'latmaxmoc' ; stypvar(4)%cshort_name = 'latminmoc' stypvar(3:4)%cunits = 'Degrees' stypvar(3:4)%valid_min = -90. stypvar(3:4)%valid_max = 90. stypvar(5)%cname = 'depthmaxmoc' ; stypvar(6)%cname = 'depthminmoc' stypvar(5)%clong_name = 'Depth_of_Maximum_Overturing' ; stypvar(6)%clong_name = 'Depth_of_Minimum_Overtuning' stypvar(5)%cshort_name = 'depthmaxmoc' ; stypvar(6)%cshort_name = 'depthminmoc' stypvar(5:6)%cunits = 'Meters' stypvar(5:6)%valid_min = -10000. stypvar(5:6)%valid_max = 0. DO jk=1,npk rmoc(:,:,jk) = getvar(cf_moc, cv_in, jk, 1, npjglo) END DO ! define window in index limit ! look for ijmin-ijmax : DO jj=1, npjglo IF ( rlat(1,jj) <= rlatmin ) ijmin = jj IF ( rlat(1,jj) <= rlatmax ) ijmax = jj END DO ! look for ikmin ikmax DO jk=1,npk IF ( gdepw(jk) <= rdepmin ) ikmin = jk IF ( gdepw(jk) <= rdepmax ) ikmax = jk END DO ! look for max/min overturning ovtmax = MAXVAL(rmoc(1,ijmin:ijmax,ikmin:ikmax)) ovtmin = MINVAL(rmoc(1,ijmin:ijmax,ikmin:ikmax)) ! find location of min/max iminloc =MINLOC(rmoc(:,ijmin:ijmax,ikmin:ikmax)) imaxloc =MAXLOC(rmoc(:,ijmin:ijmax,ikmin:ikmax)) ! results from minloc/maxloc is relative to the sub -array given as arguments ilatmin = iminloc(2) + ijmin -1 ; ilatmax = imaxloc(2) + ijmin -1 idepmin = iminloc(3) + ikmin -1 ; idepmax = imaxloc(3) + ikmin -1 PRINT *,' Maximum ', ovtmax ,' Sv latitude ', rlat(1,ilatmax),' depth = ', gdepw(idepmax) PRINT *,' Minimum ', ovtmin ,' Sv latitude ', rlat(1,ilatmin),' depth = ', gdepw(idepmin) ! create output fileset ncout = create (cf_ncout, 'none', nx, ny, nz, cdep=cn_vdepthw ) ierr = createvar (ncout, stypvar, nvarout, ipk, id_varout ) ierr = putheadervar(ncout, cf_moc, nx, ny, nz, & pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdepw ) tim = getvar1d(cf_moc,cn_vtimec, 1 ) ierr = putvar1d(ncout, tim, 1, 'T') ! netcdf output ierr = putvar0d(ncout,id_varout(1), REAL(ovtmax) ) ierr = putvar0d(ncout,id_varout(2), REAL(ovtmin) ) ierr = putvar0d(ncout,id_varout(3), REAL(rlat(1,ilatmax)) ) ierr = putvar0d(ncout,id_varout(4), REAL(rlat(1,ilatmin)) ) ierr = putvar0d(ncout,id_varout(5), REAL(gdepw(idepmax)) ) ierr = putvar0d(ncout,id_varout(6), REAL(gdepw(idepmin)) ) ierr = closeout(ncout) END PROGRAM cdfmaxmoc cdftools-3.0/cdfsigintegr.f900000644000175000017500000004314212241227304017314 0ustar amckinstryamckinstryPROGRAM cdfsigintegr !!====================================================================== !! *** PROGRAM cdfsigintegr *** !!===================================================================== !! ** Purpose : This program is used to integrate quantities between !! isopycnals !! !! ** Method : Linear interpolation is used on the vertical to define !! the depth of the given isopycn. !! Then, the integral is performed from the top of the ocean !! down to the given isopycnal. Finaly, by making the !! difference between 2 isopycnals we obtain the required !! quantity. !! !! History : 2.1 : 12/2007 : J.M. Molines : Original code !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames USE modutils !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: jiso, jfich ! dummy loop index INTEGER(KIND=4) :: jvar ! dummy loop index INTEGER(KIND=4) :: npiglo, npjglo ! domain size INTEGER(KIND=4) :: npk, npt ! domain size INTEGER(KIND=4) :: npiso, nvars ! number of isopycnals, variables INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: nfiles ! number of input files INTEGER(KIND=4) :: istrt_arg ! argument number of first input file INTEGER(KIND=4) :: ik0 ! layer index INTEGER(KIND=4) :: ijk ! layer index INTEGER(KIND=4) :: numin=10 ! logical unit for ascii input file INTEGER(KIND=4) :: ncout, ierr ! ncid and status variable INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout ! levels and id's of output variables ! REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d ! 3D working array (npk) REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: zint ! pseudo 3D working array (2) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! 2D working array REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! vertical metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! mask of t points from rho REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zdum ! dummy array for I/O REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: rho_lev ! value of isopycnals REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: h1d ! depth of rho points REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of W points REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics in full step REAL(KIND=4) :: zspval=999999. ! output missing value REAL(KIND=4) :: zspvalz ! missing value from rho file REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dv2dint ! interpolated value REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dalpha ! 3D coefficient (npiso) CHARACTER(LEN=256) :: cf_rholev = 'rho_lev' ! input file for rho surfaces CHARACTER(LEN=256) :: cf_in ! input file for data CHARACTER(LEN=256) :: cf_rho ! input file for density CHARACTER(LEN=256) :: cf_out ! output file CHARACTER(LEN=256) :: cv_in ! name of input variable CHARACTER(LEN=256) :: cldum ! dummy string variable CHARACTER(LEN=256) :: cluni ! dummy string variable for variable units CHARACTER(LEN=256) :: cglobal ! global attribute CHARACTER(LEN=256) :: ctype='T' ! position of variable on C grid CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! temporary arry for variable name in file TYPE(variable), DIMENSION(4) :: stypvar ! structure for attributes TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypzvar ! structure for attributes LOGICAL :: lfull = .FALSE. ! flag for full step LOGICAL :: lchk = .FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg=iargc() IF ( narg < 3 ) THEN PRINT *,' usage : cdfsigintegr IN-var RHO-file list_of_files [ VAR-type ] ...' PRINT *,' ... [ -sig sigma_name] [ -full ] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Take a list of input files with specific IN-var variable, associated' PRINT *,' with a reference density file. A set of isopycnal surfaces is defined' PRINT *,' in an ASCII file (rho_lev by default), using same depth reference than' PRINT *,' the input reference density file. This program computes the integral of' PRINT *,' IN-var between the isopycnals defined in rho_lev. It also gives the ' PRINT *,' isopycnal depth and thickness of density layers.' PRINT *,' ' PRINT *,' Rho_lev file first line indicates the number of following isopycnals.' PRINT *,' Then a list of the densities is given, one per line.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-var : input variable to be integrated' PRINT *,' RHO-file : netcdf file with already computed density' PRINT *,' list_of_files : a list of model netcdf files containing IN-var.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ VAR-type ] : one of T U V F W which defined the position on' PRINT *,' IN-var in the model C-grid. Default is ', TRIM(ctype) PRINT *,' [ -sig sigma_name ] : give the name of sigma variable in RHO-file.' PRINT *,' Default is ',TRIM(cn_vosigma0) PRINT *,' [ -full ] : indicate a full step configuration.' PRINT *,' [ -rholev file] : indicates name of file defining the limits for ' PRINT *,' integration. Default is ', TRIM(cf_rholev) PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fzgr),' and ',TRIM(cf_rholev) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : IN-file.integr' PRINT *,' variables : inv_IN-var : inventory of IN-var from input file.' PRINT *,' ', TRIM(cn_vodepiso),' (m) : depth of isopycnal.' PRINT *,' ', TRIM(cn_isothick),' (m) : thickness of isopycnal layer.' PRINT *,' mean_IN-var (same unit as IN-var) : mean IN-var in the isopycnal' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfrhoproj, cdfsigtrp, cdfisopycdep' PRINT *,' ' STOP ENDIF ijarg = 1 ; ireq = 0 ; nfiles = 0 DO WHILE ( ijarg <= narg ) CALL getarg( ijarg, cldum ) ; ijarg = ijarg+1 SELECT CASE ( cldum ) CASE ( 'T','t','U','u','V','v','F','f','W','w' ) ctype=cldum CASE ( '-sig ' ) CALL getarg( ijarg, cn_vosigma0) ; ijarg = ijarg+1 CASE ( '-rholev ') CALL getarg( ijarg, cf_rholev ) ; ijarg = ijarg+1 CASE ( '-full ' ) lfull = .TRUE. CASE DEFAULT ireq=ireq+1 SELECT CASE ( ireq ) CASE ( 1 ) ; cv_in = cldum CASE ( 2 ) ; cf_rho = cldum CASE DEFAULT nfiles=nfiles+1 IF ( nfiles == 1 ) istrt_arg = ijarg - 1 END SELECT END SELECT END DO CALL SetGlobalAtt( cglobal ) ! check for files lchk = lchk .OR. chkfile (cn_fzgr ) lchk = lchk .OR. chkfile (cf_rholev ) lchk = lchk .OR. chkfile (cf_rho ) IF ( lchk ) STOP ! missing file ! Read rho level between which the integral is being performed OPEN(numin,file=cf_rholev) READ(numin,*) npiso ALLOCATE (rho_lev(npiso) ) PRINT *,' Density limits read in ',TRIM(cf_rholev) DO jiso=1,npiso READ(numin,*) rho_lev(jiso) PRINT *,rho_lev(jiso) END DO CLOSE(numin) npiglo = getdim(cf_rho, cn_x) npjglo = getdim(cf_rho, cn_y) npk = getdim(cf_rho, cn_z) zspvalz=getspval(cf_rho, cn_vosigma0) CALL getarg(istrt_arg, cf_in) IF ( chkfile ( cf_in ) ) STOP ! missing file nvars=getnvar(cf_in) ALLOCATE(cv_names(nvars), stypzvar(nvars)) cv_names(:)=getvarname(cf_in,nvars,stypzvar) ALLOCATE( v3d(npiglo,npjglo,npk), dalpha(npiglo,npjglo,npiso), e3(npiglo,npjglo) ) ALLOCATE( dv2dint(npiglo,npjglo,2), v2d(npiglo,npjglo), zint(npiglo,npjglo,2) ) ALLOCATE( h1d(npk) ,gdepw(npk) ,tmask(npiglo,npjglo), zdum(npiglo,npjglo) ) IF ( lfull ) ALLOCATE ( e31d(npk) ) gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk) IF (lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk) h1d(:) = getvar1d(cf_rho, cn_vdeptht, npk) ! Note, if working with vertical slabs, one may avoid 3D array, but may be slow ... tmask=1. DO jk=1,npk v3d(:,:,jk) = getvar(cf_rho, cn_vosigma0, jk, npiglo, npjglo) IF ( jk == 1 ) THEN WHERE (v3d(:,:,jk) == zspvalz ) tmask=0. ENDIF END DO !! ** Compute interpolation coefficients as well as the level used !! to interpolate between DO ji=1,npiglo DO jj = 1, npjglo ijk = 1 DO jiso=1,npiso ! Assume that rho (z) is increasing downward (no inversion) ! Caution with sigma0 at great depth ! DO WHILE (rho_lev(jiso) >= v3d(ji,jj,ijk) .AND. ijk <= npk & & .AND. v3d(ji,jj,ijk) /= zspvalz ) ijk = ijk+1 END DO ijk = ijk-1 ik0 = ijk IF (ijk == 0) THEN ijk = 1 dalpha(ji,jj,jiso) = 0.d0 ELSE IF (v3d(ji,jj,ijk+1) == zspvalz ) THEN ik0 = 0 dalpha(ji,jj,jiso) = 0.d0 ELSE ! ... dalpha is always in [0,1]. Adding ik0 ( >=1 ) for saving space for ik0 dalpha(ji,jj,jiso)= (rho_lev(jiso)-v3d(ji,jj,ijk))/(v3d(ji,jj,ijk+1)-v3d(ji,jj,ijk)) + ik0 ENDIF END DO END DO END DO ! define header of all files ipk(1)=npiso-1 ; ipk(2)=npiso-1 ; ipk(3)=npiso ; ipk(4)=npiso-1 DO jvar=1,nvars IF ( cv_in == stypzvar(jvar)%cname ) THEN stypvar(1)=stypzvar(jvar) EXIT ENDIF END DO ! save original long name for further process cldum = TRIM(stypvar(1)%clong_name) cluni = TRIM(stypvar(1)%cunits) stypvar(1)%cname = 'inv'//TRIM(cv_in) stypvar(1)%clong_name = TRIM(cldum)//' integrated on sigma bin' stypvar(1)%cshort_name = stypvar(1)%cname stypvar(1)%cunits = TRIM(cluni)//'.m' stypvar(1)%rmissing_value = zspval stypvar(1)%caxis = 'TRYX' stypvar(2)%cname = TRIM(cn_isothick) stypvar(2)%cunits = 'm' stypvar(2)%rmissing_value = zspval stypvar(2)%valid_min = 0. stypvar(2)%valid_max = 7000. stypvar(2)%clong_name = 'Thickness_of_Isopycnals' stypvar(2)%cshort_name = TRIM(cn_isothick) stypvar(2)%conline_operation = 'N/A' stypvar(2)%caxis = 'TRYX' stypvar(3)%cname = TRIM(cn_vodepiso) stypvar(3)%cunits = 'm' stypvar(3)%rmissing_value = zspval stypvar(3)%valid_min = 0. stypvar(3)%valid_max = 7000. stypvar(3)%clong_name = 'Depth_of_Isopycnals' stypvar(3)%cshort_name = TRIM(cn_vodepiso) stypvar(3)%conline_operation = 'N/A' stypvar(3)%caxis = 'TRYX' stypvar(4)%cname = 'mean'//TRIM(cv_in) stypvar(4)%cunits = TRIM(cluni) stypvar(4)%rmissing_value = zspval stypvar(4)%valid_min = stypvar(1)%valid_min stypvar(4)%valid_max = stypvar(1)%valid_min stypvar(4)%clong_name = TRIM(cldum)//' mean value in sigma layer' stypvar(4)%cshort_name = stypvar(4)%cname stypvar(4)%conline_operation = 'N/A' stypvar(4)%caxis = 'TRYX' !! ** Loop on the scalar files to project on choosen isopycnics surfaces DO jfich=1, nfiles CALL getarg(jfich+istrt_arg-1, cf_in) IF ( chkfile (cf_in) ) STOP ! missing file PRINT *,'working with ', TRIM(cf_in) ! create output file cf_out=TRIM(cf_in)//'.integr' ncout = create (cf_out, cf_rho, npiglo, npjglo, npiso ) ierr = createvar (ncout, stypvar, 4, ipk, id_varout, cdglobal=cglobal ) ierr = putheadervar(ncout, cf_rho, npiglo, npjglo, npiso, pdep=rho_lev ) ! copy time arrays in output file npt = getdim ( cf_in, cn_t) ALLOCATE ( tim(npt) ) tim(:) = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DEALLOCATE ( tim ) DO jt =1, npt DO jk=1,npk v2d(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime = jt ) SELECT CASE ( ctype ) CASE ('T', 't' ) v3d(:,:,jk) = v2d(:,:) CASE ('U','u' ) DO jj=1,npjglo DO ji=2, npiglo v3d(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji-1,jj) ) ! put variable on T point END DO END DO CASE ('V','v' ) DO jj=2,npjglo DO ji=1, npiglo v3d(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji,jj-1) ) ! put variable on T point END DO END DO CASE('W','w' ) v3d(:,:,jk) = v2d(:,:) v2d(:,:) = getvar(cf_in, cv_in, jk+1, npiglo, npjglo, ktime = jt ) v3d(:,:,jk) = 0.5 * ( v3d(:,:,jk) + v2d(:,:) ) CASE('F','f' ) DO jj = 2, npjglo DO ji = 2, npiglo v3d(:,:,jk) = 0.25*( v2d(ji,jj) + v2d( ji, jj-1) + v2d (ji-1,jj-1) + v2d(ji-1, jj) ) END DO END DO END SELECT END DO ! Compute integral from surface to isopycnal DO jiso=1,npiso ! determine isopycnal surface DO ji=1,npiglo DO jj=1,npjglo ! ik0 is retrieved from dalpha, taking the integer part. ik0=INT(dalpha(ji,jj,jiso)) ; dalpha(ji,jj,jiso) = dalpha(ji,jj,jiso) - ik0 IF (ik0 /= 0) THEN zint (ji,jj,1)=dalpha(ji,jj,jiso)*h1d(ik0+1) + (1.d0-dalpha(ji,jj,jiso))*h1d(ik0) ELSE zint (ji,jj,1)=0. !zspval ENDIF END DO END DO ! integrate from jk=1 to zint dv2dint(:,:,1) = 0.d0 DO jk=1,npk-1 ! get metrixs at level jk IF ( lfull ) THEN e3(:,:) = e31d(jk) ELSE e3(:,:)=getvar(cn_fzgr,'e3t_ps',jk,npiglo,npjglo,ldiom=.TRUE.) ENDIF DO ji=1,npiglo DO jj=1,npjglo IF ( gdepw(jk)+e3(ji,jj) < zint(ji,jj,1) ) THEN ! full cell dv2dint(ji,jj,1)=dv2dint(ji,jj,1) + e3(ji,jj)* v3d(ji,jj,jk) ELSE IF (( zint(ji,jj,1) <= gdepw(jk)+e3(ji,jj) ) .AND. (zint(ji,jj,1) > gdepw(jk)) ) THEN dv2dint(ji,jj,1)=dv2dint(ji,jj,1)+ (zint(ji,jj,1) - gdepw(jk) )* v3d(ji,jj,jk) ELSE ! below the isopycnal ! do nothing for this i j point ENDIF END DO END DO END DO ! end on vertical integral for isopynal jiso zdum=zint(:,:,1) WHERE (tmask == 0. ) zdum=zspval ierr = putvar(ncout,id_varout(3), zdum, jiso, npiglo, npjglo, ktime=jt ) IF (jiso > 1 ) THEN ! compute the difference ie the inventory in the layer between 2 isopycnals zdum=dv2dint(:,:,1) - dv2dint(:,:,2) ; WHERE ((tmask == 0.) .OR. (zdum < 0 ) ) zdum = zspval ierr = putvar(ncout, id_varout(1), zdum, jiso-1, npiglo, npjglo, ktime=jt) zdum=zint (:,:,1) - zint (:,:,2) ; WHERE ((tmask == 0.) .OR. (zdum < 0 ) ) zdum = zspval ierr = putvar(ncout, id_varout(2), zdum, jiso-1, npiglo, npjglo, ktime=jt) WHERE ( zdum /= zspval .AND. zdum /= 0.) zdum=(dv2dint(:,:,1) - dv2dint(:,:,2))/ zdum ELSEWHERE zdum=zspval ENDWHERE ierr = putvar(ncout, id_varout(4), zdum, jiso-1, npiglo, npjglo, ktime=jt) ENDIF dv2dint(:,:,2) = dv2dint(:,:,1) zint (:,:,2) = zint (:,:,1) END DO END DO ierr = closeout(ncout) END DO ! loop on scalar files PRINT *,' integral between isopycnals completed successfully' END PROGRAM cdfsigintegr cdftools-3.0/cdfwflx.f900000644000175000017500000001530112241227304016275 0ustar amckinstryamckinstryPROGRAM cdfwflx !!====================================================================== !! *** PROGRAM cdfwflx *** !!===================================================================== !! ** Purpose : Produce a file with the water flux separated into !! 4 components: E (soevap), P (soprecip), R (sorunoff), !! dmp (sowafldp). !! The total water flux is E -P -R + dmp. Units in this !! program are mm/days. !! !! ** Method : Evap is computed from the latent heat flux : evap=-qla/Lv !! Runoff is read from the climatological input file !! dmp is read from the file (sowafldp) !! Precip is then computed as the difference between the !! total water flux (sowaflup) and the E-R+dmp. In the high !! latitudes this precip includes the effect of snow !! (storage/melting). Therefore it may differ slightly from !! the input precip file. !! !! History : 2.1 : 01/2008 : J.M. Molines : Original code !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4), PARAMETER :: jpvarout = 5 ! number of output variables INTEGER(KIND=4) :: jj, jk, ji ! dummy loop index INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ncout, ierr ! netcdf i/o INTEGER(KIND=4), DIMENSION(jpvarout) :: ipk, id_varout ! levels and varid of output vars REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, zwk ! work array REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: evap, precip ! water flux components REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: runoff, wdmp ! water flux components REAL(KIND=4), DIMENSION(1) :: tim, dep ! time_counter and dummy depth REAL(KIND=4) :: Lv=2.5e6 ! latent HF <--> evap conversion CHARACTER(LEN=256) :: cf_tfil ! input gridT file name CHARACTER(LEN=256) :: cf_rnf ! input runoff file name CHARACTER(LEN=256) :: cf_out='wflx.nc' ! output file TYPE(variable), DIMENSION(jpvarout) :: stypvar ! structure for attributes LOGICAL :: lchk ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfwflx T-file Runoff' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Computes the water fluxes components. Suitable for ' PRINT *,' annual means files. All output variables are in mm/days.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : model output file with water fluxes (gridT) ' PRINT *,' Runoff : file with the climatological runoff on the' PRINT *,' model grid.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : soevap, soprecip, sorunoff, sowadmp, sowaflux' STOP ENDIF CALL getarg (1, cf_tfil) CALL getarg (2, cf_rnf ) lchk = lchk .OR. chkfile ( cf_tfil) lchk = lchk .OR. chkfile ( cf_rnf ) IF ( lchk ) STOP ! missing file npiglo= getdim (cf_tfil, cn_x) npjglo= getdim (cf_tfil, cn_y) ! prepare output variables dep(1) = 0. ipk(:) = 1 ! all variables ( output are 2D) stypvar%rmissing_value = 0. stypvar%valid_min = -100. stypvar%valid_max = 100. stypvar%cunits = 'mm/day' stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' stypvar(1)%cname = 'soevap' ; stypvar(1)%clong_name = 'Evaporation' ; stypvar(1)%cshort_name = 'soevap' stypvar(2)%cname = 'soprecip' ; stypvar(2)%clong_name = 'Precipitation' ; stypvar(2)%cshort_name = 'soprecip' stypvar(3)%cname = 'sorunoff' ; stypvar(3)%clong_name = 'Runoff' ; stypvar(3)%cshort_name = 'sorunoff' stypvar(4)%cname = 'sowadmp' ; stypvar(4)%clong_name = 'SSS damping' ; stypvar(4)%cshort_name = 'sowadmp' stypvar(5)%cname = 'sowaflux' ; stypvar(5)%clong_name = 'Total water flux' ; stypvar(5)%cshort_name = 'sowaflux' PRINT *, 'npiglo=', npiglo PRINT *, 'npjglo=', npjglo ALLOCATE ( zmask(npiglo,npjglo), zwk(npiglo,npjglo)) ALLOCATE ( evap(npiglo,npjglo), precip(npiglo,npjglo), runoff(npiglo,npjglo), wdmp(npiglo,npjglo) ) ! read vosaline for masking purpose zwk(:,:) = getvar(cf_tfil, cn_vosaline, 1 ,npiglo,npjglo) zmask = 1. ; WHERE ( zwk == 0 ) zmask = 0. ! Evap : evap(:,:) = -1.* getvar(cf_tfil, cn_solhflup, 1 ,npiglo, npjglo)/Lv*86400. *zmask(:,:) ! mm/days print *,'Evap done' ! Wdmp wdmp(:,:) = getvar(cf_tfil, cn_sowafldp, 1 ,npiglo, npjglo) * 86400. * zmask(:,:) ! mm/days print *,'Damping done' ! Runoff runoff(:,:) = getvar(cf_rnf, 'sorunoff', 1 ,npiglo, npjglo) * 86400. * zmask(:,:) ! mm/days print *,'Runoff done' ! total water flux zwk(:,:) = getvar(cf_tfil, cn_sowaflup, 1 ,npiglo, npjglo) * 86400. *zmask(:,:) ! mm/days print *,'Total water flux done' ! Precip: precip(:,:)= evap(:,:) - runoff(:,:) + wdmp(:,:) - zwk(:,:) ! mm/day print *,'Precip done' ! Write output file ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, jpvarout, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=dep) ierr = putvar(ncout, id_varout(1), evap, 1, npiglo, npjglo) ierr = putvar(ncout, id_varout(2), precip, 1, npiglo, npjglo) ierr = putvar(ncout, id_varout(3), runoff, 1, npiglo, npjglo) ierr = putvar(ncout, id_varout(4), wdmp, 1, npiglo, npjglo) ierr = putvar(ncout, id_varout(5), zwk, 1, npiglo, npjglo) tim = getvar1d(cf_tfil, cn_vtimec, 1 ) ierr = putvar1d(ncout, tim, 1, 'T') ierr=closeout(ncout) END PROGRAM cdfwflx cdftools-3.0/eos.f900000644000175000017500000005024012241227304015427 0ustar amckinstryamckinstryMODULE eos !!====================================================================== !! *** MODULE eos *** !! All routines dealing with the Equation Of State of sea water !!===================================================================== !! History : 2.1 ! 2004 : J.M. Molines : Original code ported !! from NEMO !! 3.0 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! sigma0 : compute sigma-0 !! eosbn2 : compute Brunt Vaissala Frequency !! sigmai : compute sigma-i ( refered to a depth given in argument !! albet : Compute the ratio alpha/beta ( Thermal/haline exapnsion) !! beta : compute beta (haline expension) !!---------------------------------------------------------------------- IMPLICIT NONE PRIVATE PUBLIC :: sigma0 PUBLIC :: eosbn2 PUBLIC :: sigmai PUBLIC :: albet PUBLIC :: beta INTERFACE sigmai MODULE PROCEDURE sigmai_dep, sigmai_dep2d END INTERFACE !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- CONTAINS FUNCTION sigma0 ( ptem, psal, kpi, kpj) !!--------------------------------------------------------------------- !! *** FUNCTION sigma0 *** !! !! ** Purpose : Compute the in situ density (ratio rho/rau0) and the !! potential volumic mass (Kg/m3) from potential temperature !! and salinity fields using an equation of state defined !! through the namelist parameter neos. !! !! ** Method : Jackett and McDougall (1994) equation of state. !! The in situ density is computed directly as a function of !! potential temperature relative to the surface (the opa t !! variable), salt and pressure (assuming no pressure variation !! along geopotential surfaces, i.e. the pressure p in decibars !! is approximated by the depth in meters. !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 !! rhop(t,s) = rho(t,s,0) !! with pressure p decibars !! potential temperature t deg celsius !! salinity s psu !! reference volumic mass rau0 kg/m**3 !! in situ volumic mass rho kg/m**3 !! in situ density anomalie prd no units !! !!---------------------------------------------------------------------- REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal ! temperature and salinity INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of 2D arrays REAL(KIND=8), DIMENSION(kpi,kpj) :: sigma0 ! returned value INTEGER(KIND=4) :: ji, jj REAL(KIND=8), DIMENSION (kpi,kpj) :: zws REAL(KIND=8) :: zt, zs, zsr, zrau0=1000. REAL(KIND=8) :: zr1, zr2, zr3, zr4 !!---------------------------------------------------------------------- zws = 0.d0 sigma0 = 0.d0 DO jj = 1, kpj DO ji = 1, kpi zws(ji,jj) = SQRT( ABS( psal(ji,jj) ) ) END DO END DO DO jj = 1, kpj ! DO ji = 1, kpi zt = ptem (ji,jj) ! interpolated T zs = psal (ji,jj) ! interpolated S zsr = zws (ji,jj) ! square root of interpolated S ! compute volumic mass pure water at atm pressure zr1 = ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt & -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594 ! seawater volumic mass atm pressure zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 )*zt+7.6438e-5 ) *zt & -4.0899e-3 ) *zt+0.824493 zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3 zr4= 4.8314e-4 ! potential volumic mass (reference to the surface) sigma0(ji,jj) = ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 - zrau0 END DO END DO END FUNCTION sigma0 FUNCTION sigmai_dep ( ptem, psal, pref, kpi,kpj) !! -------------------------------------------------------------------- !! ** Purpose : Compute the density referenced to pref (ratio rho/rau0) !! from potential temperature and !! salinity fields using an equation of state defined through the !! namelist parameter neos. !! !! ** Method : !! Jackett and McDougall (1994) equation of state. !! the in situ density is computed directly as a function of !! potential temperature relative to the surface (the opa t !! variable), salt and pressure (assuming no pressure variation !! along geopotential surfaces, i.e. the pressure p in decibars !! is approximated by the depth in meters. !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 !! rhop(t,s) = rho(t,s,0) !! with pressure p decibars !! potential temperature t deg celsius !! salinity s psu !! reference volumic mass rau0 kg/m**3 !! in situ volumic mass rho kg/m**3 !! in situ density anomalie prd no units !! -------------------------------------------------------------------- REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal ! temperature salinity INTEGER(KIND=4), INTENT(in) :: kpi,kpj ! dimension of 2D arrays REAL(KIND=4), INTENT(in) :: pref ! reference pressure (meters or db) REAL(KIND=8), DIMENSION(kpi,kpj) :: sigmai_dep ! return value REAL(kind=8), PARAMETER :: dpr4=4.8314d-4, dpd=-2.042967d-2 , dprau0 = 1000.d0 INTEGER(KIND=4) :: ji, jj REAL(KIND=8), DIMENSION (kpi,kpj) :: dlrs REAL(KIND=8) :: dlt, dls REAL(KIND=8) :: dla, dla1, dlaw, dlb, dlb1, dlbw, dlc, dle, dlk0, dlkw REAL(kind=8) :: dlrhop, dlr1, dlr2, dlr3, dlref dlref = pref sigmai_dep = 0.d0 DO jj = 1, kpj DO ji = 1, kpi dlrs(ji,jj) = SQRT( ABS( psal(ji,jj) ) ) END DO END DO DO jj=1,kpj DO ji=1,kpi ! Convert T and S to double precision. dlt = DBLE(ptem(ji,jj)) dls = DBLE(psal(ji,jj)) ! Compute the volumic mass of pure water at atmospheric pressure. dlr1=((((6.536332d-9*dlt-1.120083d-6)& *dlt+1.001685d-4)& *dlt-9.095290d-3)& *dlt+6.793952d-2)& *dlt+999.842594d0 ! Compute the seawater volumic mass at atmospheric pressure. dlr2=(((5.3875d-9*dlt-8.2467d-7)& *dlt+7.6438d-5)& *dlt-4.0899d-3)& *dlt+0.824493d0 dlr3=(-1.6546d-6*dlt+1.0227d-4)& *dlt-5.72466d-3 ! Compute the potential volumic mass (referenced to the surface). dlrhop=(dpr4*dls+dlr3*dlrs(ji,jj)+dlr2)*dls+dlr1 ! Compute the compression terms. dle=(-3.508914d-8*dlt-1.248266d-8)& *dlt-2.595994d-6 dlbw=(1.296821d-6*dlt-5.782165d-9)& *dlt+1.045941d-4 dlb=dlbw+dle*dls dlc=(-7.267926d-5*dlt+2.598241d-3 )& *dlt+0.1571896d0 dlaw=((5.939910d-6*dlt+2.512549d-3)& *dlt-0.1028859d0)& *dlt-4.721788d0 dla=(dpd*dlrs(ji,jj)+dlc)*dls+dlaw dlb1=(-0.1909078d0*dlt+7.390729d0)& *dlt-55.87545d0 dla1=((2.326469d-3*dlt+1.553190d0)& *dlt-65.00517d0)& *dlt+1044.077d0 dlkw=(((-1.361629d-4*dlt-1.852732d-2)& *dlt-30.41638d0)& *dlt+2098.925d0)& *dlt+190925.6d0 dlk0=(dlb1*dlrs(ji,jj)+dla1)*dls+dlkw ! Compute the potential density anomaly. sigmai_dep(ji,jj)=dlrhop/(1.0d0-dlref/(dlk0-dlref*(dla-dlref*dlb)))& -dprau0 ENDDO ENDDO END FUNCTION sigmai_dep FUNCTION sigmai_dep2d ( ptem, psal, pref, kpi,kpj) !! -------------------------------------------------------------------- !! ** Purpose : Compute the density referenced to pref (ratio rho/rau0) !! from potential temperature and !! salinity fields using an equation of state defined through the !! namelist parameter neos. !! !! ** Method : !! Jackett and McDougall (1994) equation of state. !! the in situ density is computed directly as a function of !! potential temperature relative to the surface (the opa t !! variable), salt and pressure (assuming no pressure variation !! along geopotential surfaces, i.e. the pressure p in decibars !! is approximated by the depth in meters. !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 !! rhop(t,s) = rho(t,s,0) !! with pressure p decibars !! potential temperature t deg celsius !! salinity s psu !! reference volumic mass rau0 kg/m**3 !! in situ volumic mass rho kg/m**3 !! in situ density anomalie prd no units !! -------------------------------------------------------------------- REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal ! temperature salinity INTEGER(KIND=4), INTENT(in) :: kpi,kpj ! dimension of 2D arrays REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: pref ! reference pressure (meters or db) (2d Array) REAL(KIND=8), DIMENSION(kpi,kpj) :: sigmai_dep2d ! return value REAL(kind=8), PARAMETER :: dpr4=4.8314d-4, dpd=-2.042967d-2 , dprau0 = 1000.d0 INTEGER(KIND=4) :: ji, jj REAL(KIND=8), DIMENSION (kpi,kpj) :: dlrs REAL(KIND=8) :: dlt, dls REAL(KIND=8) :: dla, dla1, dlaw, dlb, dlb1, dlbw, dlc, dle, dlk0, dlkw REAL(kind=8) :: dlrhop, dlr1, dlr2, dlr3, dlref sigmai_dep2d = 0.d0 DO jj = 1, kpj DO ji = 1, kpi dlrs(ji,jj) = SQRT( ABS( psal(ji,jj) ) ) END DO END DO DO jj=1,kpj DO ji=1,kpi ! Convert T and S to double precision. dlt = DBLE(ptem(ji,jj)) dls = DBLE(psal(ji,jj)) dlref = DBLE(pref(ji,jj)) ! Compute the volumic mass of pure water at atmospheric pressure. dlr1=((((6.536332d-9*dlt-1.120083d-6)& *dlt+1.001685d-4)& *dlt-9.095290d-3)& *dlt+6.793952d-2)& *dlt+999.842594d0 ! Compute the seawater volumic mass at atmospheric pressure. dlr2=(((5.3875d-9*dlt-8.2467d-7)& *dlt+7.6438d-5)& *dlt-4.0899d-3)& *dlt+0.824493d0 dlr3=(-1.6546d-6*dlt+1.0227d-4)& *dlt-5.72466d-3 ! Compute the potential volumic mass (referenced to the surface). dlrhop=(dpr4*dls+dlr3*dlrs(ji,jj)+dlr2)*dls+dlr1 ! Compute the compression terms. dle=(-3.508914d-8*dlt-1.248266d-8)& *dlt-2.595994d-6 dlbw=(1.296821d-6*dlt-5.782165d-9)& *dlt+1.045941d-4 dlb=dlbw+dle*dls dlc=(-7.267926d-5*dlt+2.598241d-3 )& *dlt+0.1571896d0 dlaw=((5.939910d-6*dlt+2.512549d-3)& *dlt-0.1028859d0)& *dlt-4.721788d0 dla=(dpd*dlrs(ji,jj)+dlc)*dls+dlaw dlb1=(-0.1909078d0*dlt+7.390729d0)& *dlt-55.87545d0 dla1=((2.326469d-3*dlt+1.553190d0)& *dlt-65.00517d0)& *dlt+1044.077d0 dlkw=(((-1.361629d-4*dlt-1.852732d-2)& *dlt-30.41638d0)& *dlt+2098.925d0)& *dlt+190925.6d0 dlk0=(dlb1*dlrs(ji,jj)+dla1)*dls+dlkw ! Compute the potential density anomaly. sigmai_dep2d(ji,jj)=dlrhop/(1.0d0-dlref/(dlk0-dlref*(dla-dlref*dlb)))& -dprau0 ENDDO ENDDO END FUNCTION sigmai_dep2d FUNCTION eosbn2 ( ptem, psal, pdep, pe3w, kpi, kpj, kup, kdown) !!--------------------------------------------------------------------- !! *** FUNCTION eosbn2 *** !! !! ** Purpose : Compute the local Brunt-Vaisala frequency at the time- !! step of the input arguments !! !! ** Method : UNESCO sea water properties !! The brunt-vaisala frequency is computed using the !! polynomial expression of McDougall (1987): !! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w !!---------------------------------------------------------------------- REAL(KIND=4), DIMENSION(kpi,kpj,2), INTENT(in) :: ptem, psal ! temperaature salinity REAL(KIND=4) :: pdep ! reference depth REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: pe3w ! e3w of the current layer INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! size of the array INTEGER(KIND=4), INTENT(in) :: kup, kdown ! index of levels up and down REAL(KIND=4), DIMENSION(kpi,kpj) :: eosbn2 ! returned values INTEGER(KIND=4) :: ji, jj ! dummy loop indices REAL(KIND=8) :: zgde3w, zt, zs, zh REAL(KIND=8) :: zalbet, zbeta REAL(KIND=8) :: zgrav=9.81 !!---------------------------------------------------------------------- zh = pdep DO jj = 1, kpj DO ji = 1, kpi zgde3w = zgrav / pe3w(ji,jj) zt = 0.5 * ( ptem(ji,jj,kup) + ptem(ji,jj,kdown) ) ! potential temperature at w-point zs = 0.5 * ( psal(ji,jj,kup) + psal(ji,jj,kdown) ) - 35.0 ! salinity anomaly (s-35) at w-point zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt & ! ratio alpha/beta & - 0.203814e-03 ) * zt & & + 0.170907e-01 ) * zt & & + 0.665157e-01 & & + ( - 0.678662e-05 * zs & & - 0.846960e-04 * zt + 0.378110e-02 ) * zs & & + ( ( - 0.302285e-13 * zh & & - 0.251520e-11 * zs & & + 0.512857e-12 * zt * zt ) * zh & & - 0.164759e-06 * zs & & +( 0.791325e-08 * zt - 0.933746e-06 ) * zt & & + 0.380374e-04 ) * zh zbeta = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt & ! beta & - 0.301985e-05 ) * zt & & + 0.785567e-03 & & + ( 0.515032e-08 * zs & & + 0.788212e-08 * zt - 0.356603e-06 ) * zs & & +( ( 0.121551e-17 * zh & & - 0.602281e-15 * zs & & - 0.175379e-14 * zt + 0.176621e-12 ) * zh & & + 0.408195e-10 * zs & & + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt & & - 0.121555e-07 ) * zh eosbn2(ji,jj) = zgde3w * zbeta & ! N^2 & * ( zalbet * ( ptem(ji,jj,kup) - ptem(ji,jj,kdown) ) & & - ( psal(ji,jj,kup) - psal(ji,jj,kdown) ) ) END DO END DO END FUNCTION eosbn2 FUNCTION albet( ptem, psal, pdep, kpi, kpj) !!--------------------------------------------------------------------- !! *** FUNCTION albet *** !! !! ** Purpose : Compute the ratio alpha/beta !! !! ** Method : Follow Mc Dougal et al as in other functions !! !!---------------------------------------------------------------------- REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal ! temperature salinity REAL(KIND=4), INTENT(in) :: pdep ! refererence depth INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! size of the arrays REAL(KIND=8), DIMENSION(kpi,kpj) :: albet ! returned value INTEGER(KIND=4) :: ji, jj ! dummy loop index REAL(KIND=8) :: zt, zs, zh ! working local variables !!---------------------------------------------------------------------- zh = pdep DO ji=1,kpi DO jj=1,kpj zt = ptem(ji,jj) ! potential temperature zs = psal(ji,jj)- 35.0 ! salinity anomaly (s-35) albet(ji,jj) = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt & ! ratio alpha/beta & - 0.203814e-03 ) * zt & & + 0.170907e-01 ) * zt & & + 0.665157e-01 & & + ( - 0.678662e-05 * zs & & - 0.846960e-04 * zt + 0.378110e-02 ) * zs & & + ( ( - 0.302285e-13 * zh & & - 0.251520e-11 * zs & & + 0.512857e-12 * zt * zt ) * zh & & - 0.164759e-06 * zs & & +( 0.791325e-08 * zt - 0.933746e-06 ) * zt & & + 0.380374e-04 ) * zh END DO END DO END FUNCTION albet FUNCTION beta ( ptem, psal, pdep, kpi, kpj) !!--------------------------------------------------------------------- !! *** FUNCTION beta *** !! !! ** Purpose : Compute the beta !! !! ** Method : Follow Mc Dougal et al as in other functions !! !!---------------------------------------------------------------------- REAL(KIND=4), DIMENSION(kpi,kpj),INTENT(in) :: ptem, psal ! temperature salinity REAL(KIND=4), INTENT(in) :: pdep ! reference depth INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! size of the array REAL(KIND=8), DIMENSION(kpi,kpj) :: beta ! returned values INTEGER(KIND=4) :: ji, jj ! dummy loop index REAL(KIND=8) :: zt, zs, zh ! working variables !!---------------------------------------------------------------------- zh = pdep DO ji=1,kpi DO jj=1,kpj zt = ptem(ji,jj) ! potential temperature zs = psal(ji,jj)- 35.0 ! salinity anomaly (s-35) beta(ji,jj) = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt & ! beta & - 0.301985e-05 ) * zt & & + 0.785567e-03 & & + ( 0.515032e-08 * zs & & + 0.788212e-08 * zt - 0.356603e-06 ) * zs & & +( ( 0.121551e-17 * zh & & - 0.602281e-15 * zs & & - 0.175379e-14 * zt + 0.176621e-12 ) * zh & & + 0.408195e-10 * zs & & + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt & & - 0.121555e-07 ) * zh END DO END DO END FUNCTION beta END MODULE eos cdftools-3.0/cdftransport.f900000644000175000017500000017130412241227304017357 0ustar amckinstryamckinstryPROGRAM cdftransport !!====================================================================== !! *** PROGRAM cdftransport *** !!===================================================================== !! ** Purpose : Compute Transports across a section. !! By default, mass (Sv) and heat(PW)/salt(kT/s) transports !! are computed unless -noheat option is used (mass !! transport only). !! !! ** Method : The begining and end point of the section are given in !! term of F-points index. A broken line joining successive !! F-points is defined between the begining and end point !! of the section. Therefore each segment between F-points !! is either a zonal or meridional segment corresponding to !! V or U velocity component. Doing so, the volume conservation !! is ensured as velocities are not interpolated, and stay !! on the native model grid. !! The section name and the begin/end point of a section are !! read from standard input, till 'EOF' is given as section !! name. This make possible to give a bunch of sections in !! an ASCII files and use the < redirection. !! SIGN CONVENTION : The transport is positive when the flow cross !! the section to the right, negative otherwise. This depends !! on the sense the section is described. With this convention !! The algebric sum of transports accross sections forming a !! closed area is 0. !! OPTIONS : !! -full : full step case !! -noheat : only mass transport is computed. !! -time : specify the time frame to be used !! -zlimit : transports can be computed in different depth layers !! defined by their depth limit !! REQUIREMENT : !! mesh-mask file are required in the current directory. !! !! !! History : 2.1 : 01/2005 : J.M. Molines : Original code !! 2.1 : 07/2009 : R. Dussin : add cdf output !! 2.1 : 01/2010 : M.A. Balmaseda : Change integration signs !! so that the transport across a segment is !! independent of the chosen trajectory. !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! interm_pt : choose intermediate points on a broken line. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames USE modutils ! for global attribute !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jclass, jseg ! dummy loop index INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: imeter ! limit beetween depth level, in m (nclass -1) INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ilev0, ilev1 ! limit in levels (nclass) INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! Netcdf output INTEGER(KIND=4) :: ipos ! working integer (position of ' ' in strings) INTEGER(KIND=4) :: ncout, ierr ! for netcdf output INTEGER(KIND=4) :: nvarout=12 ! number of values to write in cdf output INTEGER(KIND=4) :: ivtrp ! var index of volume transport (barotrope) INTEGER(KIND=4) :: iptrp ! var index of volume transport (barotrope) INTEGER(KIND=4) :: imtrp ! var index of volume transport (barotrope) INTEGER(KIND=4) :: ihtrp ! var index of heat transport (barotrope) INTEGER(KIND=4) :: istrp ! var index of sal transport (barotrope) INTEGER(KIND=4) :: ivtrpcl ! var index of volume transport (p. class) INTEGER(KIND=4) :: iptrpcl ! var index of volume transport (p. class) INTEGER(KIND=4) :: imtrpcl ! var index of volume transport (p. class) INTEGER(KIND=4) :: ihtrpcl ! var index of heat transport (p. class) INTEGER(KIND=4) :: istrpcl ! var index of sal transport (p. class) INTEGER(KIND=4) :: ilonmin ! var index of starting section longitude INTEGER(KIND=4) :: ilonmax ! var index of ending section longitude INTEGER(KIND=4) :: ilatmin ! var index of starting section latitude INTEGER(KIND=4) :: ilatmax ! var index of ending section latitude INTEGER(KIND=4) :: itop ! var index of top depth class INTEGER(KIND=4) :: ibot ! var index of bottom depth class INTEGER(KIND=4) :: ikx=1, iky=1 ! dims of netcdf output file INTEGER(KIND=4) :: numout = 10 ! logical unit for output file (overall) INTEGER(KIND=4) :: numvtrp = 11 ! logical unit for volume transport file INTEGER(KIND=4) :: numhtrp = 12 ! logical unit for heat transport file INTEGER(KIND=4) :: numstrp = 14 ! logical unit for salt trp file INTEGER(KIND=4) :: nclass ! number of depth class INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, nxtarg ! " " INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: iimin, iimax ! i-limit of the section INTEGER(KIND=4) :: ijmin, ijmax ! j-limit of the section INTEGER(KIND=4) :: ivar, itime ! working integer INTEGER(KIND=4) :: ii, ij, ik ! working integer INTEGER(KIND=4), PARAMETER :: jpseg=10000 ! used for broken line algorithm INTEGER(KIND=4) :: ii0, ij0 ! " " " INTEGER(KIND=4) :: ii1, ij1 ! " " " INTEGER(KIND=4) :: iitmp, ijtmp ! " " " INTEGER(KIND=4) :: np, nn ! segment counters, INTEGER(KIND=4) :: iist, ijst ! local point offset for velocity INTEGER(KIND=4) :: norm_u, norm_v ! normalization factor (sign of normal transport) INTEGER(KIND=4) :: idirx, idiry ! sense of description of the section REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e2u ! horizontal metric REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3u, e3v ! vertical metric REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamf ! longitudes of F points REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: gphif ! latitudes of F points REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, zut, zus ! Zonal velocities and uT uS REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zv, zvt, zvs ! Meridional velocities and uT uS REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdum ! dummy (1x1) array for ncdf output REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zuobc, zvobc ! arrays for OBC files (vertical slice) REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth at layer interface REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metric in case of full step REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: rclass ! vertical metric in case of full step REAL(KIND=4), DIMENSION(2) :: gla, gphi ! lon/lat of the begining/end of section (f point) REAL(KIND=4), DIMENSION(jpseg) :: rxx, ryy ! working variables REAL(KIND=4) :: rxi0, ryj0 ! working variables REAL(KIND=4) :: rxi1, ryj1 ! working variables REAL(KIND=4) :: ai, bi ! equation of line (y=ai.x +bi) REAL(KIND=4) :: aj, bj ! equation of line (x=aj.y +bj REAL(KIND=4) :: rd, rd1, rd2 ! distance between point, between vertical layers REAL(KIND=4) :: udum, vdum ! dummy velocity components for tests REAL(KIND=4) :: rau0=1000 ! density of pure water (kg/m3) REAL(KIND=4) :: rcp=4000. ! heat capacity (J/kg/K) ! at every model point REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwku, dwkv ! volume transport at each cell boundary REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwkut, dwkvt ! heat transport at each cell boundary REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwkus, dwkvs ! salt transport at each cell boundary REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwkup, dwkvp ! volume transport in the positive direction REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwkum, dwkvm ! volume transport in the negatibe direction REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dtrpu, dtrpv ! volume transport integrated in depth class REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dtrput, dtrpvt ! heat transport integrated in depth class REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dtrpus, dtrpvs ! salt transport integrated in depth class REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dtrpup, dtrpvp ! volume transport integrated in depth class (positive) REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dtrpum, dtrpvm ! volume transport integrated in depth class (negative) ! for a given section REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvoltrpsum ! volume transport by depth class across section REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvoltrpsump ! volume transport by depth class across section REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvoltrpsumm ! volume transport by depth class across section REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dheatrpsum ! heat transport by depth class across section REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dsaltrpsum ! salt transport by depth class across section REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvolallegcl ! over all leg volume transport by depth class REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvolallegclp ! over all leg volume transport by depth class + REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvolallegclm ! over all leg volume transport by depth class - REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dheatallegcl ! over all leg heat transport by depth class REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dsaltallegcl ! over all leg salt transport by depth class REAL(KIND=8), DIMENSION(jpseg) :: dvoltrp ! volume transport across each segment of a section REAL(KIND=8), DIMENSION(jpseg) :: dvoltrpp ! volume transport across each segment of a section REAL(KIND=8), DIMENSION(jpseg) :: dvoltrpm ! volume transport across each segment of a section REAL(KIND=8), DIMENSION(jpseg) :: dheatrp ! heat transport across each segment of a section REAL(KIND=8), DIMENSION(jpseg) :: dsaltrp ! salt transport across each segment of a section REAL(KIND=8) :: dvoltrpbrtp ! volume transport integrated over the whole depth REAL(KIND=8) :: dvoltrpbrtpp ! volume transport integrated over the whole depth REAL(KIND=8) :: dvoltrpbrtpm ! volume transport integrated over the whole depth REAL(KIND=8) :: dheatrpbrtp ! heat transport integrated over the whole depth REAL(KIND=8) :: dsaltrpbrtp ! salt transport integrated over the whole depth REAL(KIND=8) :: dvolalleg ! over all leg sum of volume transport REAL(KIND=8) :: dvolallegp ! over all leg sum of volume transport + REAL(KIND=8) :: dvolallegm ! over all leg sum of volume transport - REAL(KIND=8) :: dheatalleg ! over all leg sum of heat transport REAL(KIND=8) :: dsaltalleg ! over all leg sum of salt transport COMPLEX, DIMENSION(jpseg) :: yypt ! array of points coordinates in a section COMPLEX :: yypti ! working point TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output CHARACTER(LEN=256) :: cf_tfil ! VT file (in) CHARACTER(LEN=256) :: cf_ufil ! U file (in) CHARACTER(LEN=256) :: cf_vfil ! V file (in) CHARACTER(LEN=256) :: cf_out='section_trp.dat' ! output file name (ASCII) CHARACTER(LEN=256) :: cf_outnc ! output netcdf file CHARACTER(LEN=256) :: cf_vtrp='vtrp.txt' ! output volume transport file CHARACTER(LEN=256) :: cf_htrp='htrp.txt' ! output heat transport file CHARACTER(LEN=256) :: cf_strp='strp.txt' ! output salt transport file CHARACTER(LEN=256) :: csection ! section names CHARACTER(LEN=256) :: cvarname ! variable names (root) CHARACTER(LEN=256) :: clongname ! variable longname (root) CHARACTER(LEN=512) :: cglobal ! global attribute CHARACTER(LEN=256) :: cldum ! dummy char variable CHARACTER(LEN=256) :: cline ! dummy char variable CHARACTER(LEN=256), DIMENSION(3) :: cldumt ! dummy char variable LOGICAL :: ltest = .FALSE. ! flag for test case LOGICAL :: lfull = .FALSE. ! flag for full step case LOGICAL :: lheat = .TRUE. ! flag for skipping heat/salt transport computation LOGICAL :: lchk = .FALSE. ! flag for missing files LOGICAL :: lpm = .FALSE. ! flag for plus/minus transport LOGICAL :: lobc = .FALSE. ! flag for obc input files LOGICAL :: l_merid = .FALSE. ! flag for meridional obc LOGICAL :: l_zonal = .FALSE. ! flag for zonal obc !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() ! Print usage if no argument IF ( narg == 0 ) THEN PRINT *,' usage : cdftransport [-test u v ] [-noheat ] [-plus_minus ] [-obc]...' PRINT *,' ... [VT-file] U-file V-file [-full] |-time jt] ...' PRINT *,' ... [-time jt ] [-zlimit limits of level]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the transports accross a section.' PRINT *,' The name of the section and the imin, imax, jmin, jmax for the section ' PRINT *,' is read from the standard input. To finish the program use the key name' PRINT *,' ''EOF'' for the section name.' PRINT *,' OBC U,V files can be used if -obc option is specified.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' [VT-file ] : netcdf file with mean values of vt, vs, ut, us for heat and' PRINT *,' salt transport. If options -noheat or -plus_minus are used' PRINT *,' this file name must be omitted.' PRINT *,' [U-file ] : netcdf file with the zonal velocity component.' PRINT *,' [V-file ] : netcdf file with the meridional velocity component.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-test u v ]: use constant the u and v velocity components for sign ' PRINT *,' test purpose.' PRINT *,' [-noheat ] : use when heat and salt transport are not requested.' PRINT *,' This option must come before the file names, and if used' PRINT *,' VT file must not be given.' PRINT *,' [ -plus_minus or -pm ] : separate positive and negative contribution to' PRINT *,' the volume transport. This option implicitly set -noheat,' PRINT *,' and must be used before the file names.' PRINT *,' [-obc ] : indicates that input files are obc files (vertical slices)' PRINT *,' Take care that for this case, mesh files must be adapted.' PRINT *,' This option implicitly set -noheat, and must be used before' PRINT *,' the file names.' PRINT *,' [-full ] : use for full step configurations.' PRINT *,' [-time jt ]: compute transports for time index jt. Default is 1.' PRINT *,' [-zlimit list of depth] : Specify depths limits defining layers where the' PRINT *,' transports will be computed. If not used, the transports ' PRINT *,' are computed for the whole water column. If used, this ' PRINT *,' option must be the last on the command line.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' Files ',TRIM(cn_fhgr),', ',TRIM(cn_fzgr),' must be in the current directory.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' - Standard output ' PRINT *,' - ASCII file reflecting the standard output: section_trp.dat' PRINT *,' - ASCII files for volume, heat and salt transport: vtrp.txt, htrp.txt ' PRINT *,' and strp.txt.' PRINT *,' - Netcdf files for each section. name of the file is buildt' PRINT *,' from section name.' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfsigtrp' PRINT *,' ' STOP ENDIF itime = 1 nclass = 1 ijarg = 1 CALL SetGlobalAtt(cglobal) ! Browse command line for arguments and/or options DO WHILE (ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ('-test ') CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) udum CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) vdum ltest = .TRUE. CASE ('-full' ) lfull = .TRUE. CASE ('-noheat' ) ! it must be called before the list of files lheat = .FALSE. CASE ('-time' ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itime CASE ('-plus_minus', '-pm' ) lpm = .TRUE. lheat = .FALSE. CASE ('-obc' ) lobc = .TRUE. lheat = .FALSE. CASE ('-zlimit' ) ! this should be the last option on the line nxtarg = ijarg - 1 nclass = narg - nxtarg + 1 ALLOCATE ( imeter(nclass -1) ) ! if no zlimit option, this array is never used DO jclass =1, nclass -1 CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) imeter(jclass) END DO CASE DEFAULT ijarg = ijarg -1 ! re-read argument in this case IF ( lheat) THEN CALL getarg (ijarg, cf_tfil) ; ijarg = ijarg + 1 ENDIF CALL getarg (ijarg, cf_ufil) ; ijarg = ijarg + 1 CALL getarg (ijarg, cf_vfil) ; ijarg = ijarg + 1 END SELECT END DO ! checking if all required files are available lchk = lchk .OR. chkfile(cn_fzgr) lchk = lchk .OR. chkfile(cn_fhgr) IF ( ltest ) THEN ! OK ELSE lchk = lchk .OR. chkfile(cf_ufil) lchk = lchk .OR. chkfile(cf_vfil) IF (lheat) THEN lchk = lchk .OR. chkfile(cf_tfil) ENDIF ENDIF IF ( lchk ) STOP ! missing files ! adjust the number of output variables according to options IF ( nclass > 1 ) THEN IF ( lheat ) THEN nvarout = 12 ELSE nvarout = 8 ENDIF IF ( lpm ) nvarout=nvarout+4 ELSE IF ( lheat ) THEN nvarout = 9 ELSE nvarout = 7 ENDIF IF ( lpm ) nvarout=nvarout+2 ENDIF ALLOCATE ( ilev0(nclass), ilev1(nclass), rclass(nclass) ) rclass=(/(jclass, jclass=1,nclass)/) npiglo = getdim (cf_ufil,cn_x) npjglo = getdim (cf_ufil,cn_y) npk = getdim (cf_ufil,cn_z) npt = getdim (cf_ufil,cn_t) PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt IF ( lobc ) THEN ! if lobc false, l_merid and l_zonal are false (default) IF ( npiglo == 1 ) THEN l_merid=.TRUE. ALLOCATE (zuobc(npjglo,npk), zvobc(npjglo,npk) ) PRINT *,' Meridional OBC' ENDIF IF ( npjglo == 1 ) THEN l_zonal=.TRUE. ALLOCATE (zuobc(npiglo,npk), zvobc(npiglo,npk) ) PRINT *,' Zonal OBC' ENDIF ENDIF ALLOCATE ( e31d(npk) ) ! define new variables for output ALLOCATE ( stypvar(nvarout), ipk(nvarout), id_varout(nvarout) ) ALLOCATE ( rdum(1,1) ) rdum(:,:)=0.e0 ! Allocate arrays ALLOCATE ( zu(npiglo,npjglo), zv(npiglo,npjglo) ) ALLOCATE ( dwku(npiglo,npjglo), dwkv(npiglo,npjglo) ) ALLOCATE ( dtrpu(npiglo,npjglo,nclass), dtrpv(npiglo,npjglo,nclass)) ALLOCATE ( dvoltrpsum(nclass), dvolallegcl(nclass) ) IF ( lpm ) THEN ALLOCATE ( dwkup(npiglo,npjglo), dwkvp(npiglo,npjglo) ) ALLOCATE ( dwkum(npiglo,npjglo), dwkvm(npiglo,npjglo) ) ALLOCATE ( dtrpup(npiglo,npjglo,nclass), dtrpvp(npiglo,npjglo,nclass)) ALLOCATE ( dtrpum(npiglo,npjglo,nclass), dtrpvm(npiglo,npjglo,nclass)) ALLOCATE ( dvoltrpsump(nclass), dvoltrpsumm(nclass) ) ALLOCATE ( dvolallegclp(nclass), dvolallegclm(nclass) ) ENDIF IF ( lheat ) THEN ALLOCATE ( zut(npiglo,npjglo), zus(npiglo,npjglo) ) ALLOCATE ( zvt(npiglo,npjglo), zvs(npiglo,npjglo) ) ALLOCATE ( dwkut(npiglo,npjglo), dwkus(npiglo,npjglo) ) ALLOCATE ( dwkvt(npiglo,npjglo), dwkvs(npiglo,npjglo) ) ALLOCATE ( dtrput(npiglo,npjglo,nclass), dtrpvt(npiglo,npjglo,nclass)) ALLOCATE ( dtrpus(npiglo,npjglo,nclass), dtrpvs(npiglo,npjglo,nclass)) ALLOCATE ( dheatrpsum(nclass), dsaltrpsum(nclass) ) ALLOCATE ( dheatallegcl(nclass), dsaltallegcl(nclass) ) ENDIF ! ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo) ) ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo) ) ! ALLOCATE ( gphif(npiglo,npjglo) ) ALLOCATE ( glamf(npiglo,npjglo) ) ALLOCATE ( gdepw(npk) , tim(npt) ) ! ! read metrics and grid position e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo) e2u(:,:) = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo) glamf(:,:) = getvar(cn_fhgr, cn_glamf, 1,npiglo, npjglo) gphif(:,:) = getvar(cn_fhgr, cn_gphif, 1,npiglo, npjglo) gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk) ! used only for full step ! look for nearest level to imeter and setup ilev0 and ilev1 (t-index of class limit) ik = 1 ilev0(1) = 1 ; ilev1(nclass) = npk-1 ! default value if nclass=1 IF ( lobc ) THEN ! read u, v on OBC IF ( l_zonal ) THEN ! (jpiglo,jpk) zuobc(:,:)= getvarxz(cf_ufil, cn_vozocrtx, 1, npiglo, npk) zvobc(:,:)= getvarxz(cf_vfil, cn_vomecrty, 1, npiglo, npk) ENDIF IF ( l_merid ) THEN ! (jpjglo,jpk) zuobc(:,:)= getvaryz(cf_ufil, cn_vozocrtx, 1, npjglo, npk) zvobc(:,:)= getvaryz(cf_vfil, cn_vomecrty, 1, npjglo, npk) ENDIF ENDIF DO jclass = 1, nclass -1 DO WHILE ( gdepw(ik) < imeter(jclass) ) ik = ik +1 END DO rd1 = ABS(gdepw(ik-1) - imeter(jclass) ) rd2 = ABS(gdepw(ik ) - imeter(jclass) ) IF ( rd2 < rd1 ) THEN ilev1(jclass ) = ik - 1 ! t-levels index ilev0(jclass+1) = ik ELSE ilev1(jclass ) = ik - 2 ! t-levels index ilev0(jclass+1) = ik - 1 END IF END DO PRINT *, 'Limits : ' DO jclass = 1, nclass PRINT *, ilev0(jclass),ilev1(jclass), gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1) END DO ! compute the transports at each grid cell dtrpu (:,:,:)= 0.d0 ; dtrpv (:,:,:)= 0.d0 ! initialization to 0 IF ( lpm ) THEN dtrpup(:,:,:)= 0.d0 ; dtrpvp(:,:,:)= 0.d0 dtrpum(:,:,:)= 0.d0 ; dtrpvm(:,:,:)= 0.d0 ENDIF IF ( lheat ) THEN dtrput(:,:,:)= 0.d0 ; dtrpvt(:,:,:)= 0.d0 dtrpus(:,:,:)= 0.d0 ; dtrpvs(:,:,:)= 0.d0 ENDIF DO jclass = 1, nclass DO jk = ilev0(jclass),ilev1(jclass) PRINT *,'level ',jk ! Get velocities, temperature and salinity fluxes at jk IF ( ltest ) THEN zu (:,:) = udum ; zv (:,:) = vdum IF (lheat) THEN zut(:,:) = udum ; zvt(:,:) = vdum zus(:,:) = udum ; zvs(:,:) = vdum ENDIF ELSEIF ( lobc ) THEN IF ( l_zonal ) THEN ; zu(:,1)=zuobc(:,jk) ; zv(:,1)=zvobc(:,jk) ELSE IF ( l_merid ) THEN ; zu(1,:)=zuobc(:,jk) ; zv(1,:)=zvobc(:,jk) ; ENDIF ELSE zu (:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=itime) zv (:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=itime) IF (lheat) THEN zut(:,:) = getvar(cf_tfil, cn_vozout, jk, npiglo, npjglo, ktime=itime) zvt(:,:) = getvar(cf_tfil, cn_vomevt, jk, npiglo, npjglo, ktime=itime) zus(:,:) = getvar(cf_tfil, cn_vozous, jk, npiglo, npjglo, ktime=itime) zvs(:,:) = getvar(cf_tfil, cn_vomevs, jk, npiglo, npjglo, ktime=itime) ENDIF ENDIF ! get e3u, e3v at level jk IF ( lfull ) THEN e3v(:,:) = e31d(jk) e3u(:,:) = e31d(jk) ELSE e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.) e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF dwku (:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)*1.d0 dwkv (:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)*1.d0 IF ( lpm ) THEN dwkup = 0.d0 ; dwkum = 0.d0 WHERE ( zu >= 0. ) dwkup(:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)*1.d0 ELSEWHERE dwkum(:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)*1.d0 END WHERE dwkvp = 0.d0 ; dwkvm = 0.d0 WHERE ( zv >= 0. ) dwkvp(:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)*1.d0 ELSEWHERE dwkvm(:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)*1.d0 END WHERE ENDIF IF ( lheat ) THEN dwkut(:,:) = zut(:,:)*e2u(:,:)*e3u(:,:)*1.d0 dwkvt(:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)*1.d0 dwkus(:,:) = zus(:,:)*e2u(:,:)*e3u(:,:)*1.d0 dwkvs(:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)*1.d0 ENDIF ! integrates vertically dtrpu (:,:,jclass) = dtrpu (:,:,jclass) + dwku (:,:) dtrpv (:,:,jclass) = dtrpv (:,:,jclass) + dwkv (:,:) IF ( lpm ) THEN dtrpup(:,:,jclass) = dtrpup(:,:,jclass) + dwkup(:,:) dtrpvp(:,:,jclass) = dtrpvp(:,:,jclass) + dwkvp(:,:) dtrpum(:,:,jclass) = dtrpum(:,:,jclass) + dwkum(:,:) dtrpvm(:,:,jclass) = dtrpvm(:,:,jclass) + dwkvm(:,:) ENDIF IF ( lheat ) THEN dtrput(:,:,jclass) = dtrput(:,:,jclass) + dwkut(:,:) * rau0*rcp dtrpvt(:,:,jclass) = dtrpvt(:,:,jclass) + dwkvt(:,:) * rau0*rcp dtrpus(:,:,jclass) = dtrpus(:,:,jclass) + dwkus(:,:) dtrpvs(:,:,jclass) = dtrpvs(:,:,jclass) + dwkvs(:,:) ENDIF END DO ! loop to next level END DO ! next class OPEN(numout,FILE=cf_out) ! also dump the results on txt files without any comments, some users like it ! OPEN(numvtrp,FILE=cf_vtrp) IF ( lheat ) THEN OPEN(numhtrp,FILE=cf_htrp) ; OPEN(numstrp,FILE=cf_strp) ENDIF !################################################################################ ! enter interactive part !################################################################################ ! initialize all legs arrays and variable to 0 dvolalleg = 0.d0 ; dvolallegcl(:) = 0.d0 IF ( lpm ) THEN dvolallegp = 0.d0 ; dvolallegclp(:) = 0.d0 dvolallegm = 0.d0 ; dvolallegclm(:) = 0.d0 ENDIF IF ( lheat ) THEN dheatalleg = 0.d0 ; dheatallegcl(:) = 0.d0 dsaltalleg = 0.d0 ; dsaltallegcl(:) = 0.d0 ENDIF DO PRINT *, ' Give name of section (EOF to finish)' READ(*,'(a)') cline ii = 0 cldumt(:) = 'none' ipos = index(cline,' ') DO WHILE ( ipos > 1 ) ii = ii + 1 cldumt(ii) = cline(1:ipos - 1 ) cline = TRIM ( cline(ipos+1:) ) ipos = index( cline,' ' ) IF ( ii >= 3 ) EXIT END DO csection = TRIM(cldumt(1) ) cvarname = TRIM(cldumt(2) ) clongname = TRIM(cldumt(3) ) IF (TRIM(csection) == 'EOF' ) THEN CLOSE(numout) ; CLOSE(numvtrp) IF ( lheat ) THEN CLOSE(numhtrp) ; CLOSE(numstrp) ENDIF EXIT ! infinite DO loop ENDIF ! create output fileset CALL set_typvar( stypvar, csection, cvarname, clongname ) cf_outnc = TRIM(csection)//'_transports.nc' ncout = create (cf_outnc, 'none', ikx, iky, nclass, cdep='depth_class') ierr = createvar (ncout, stypvar, nvarout, ipk, id_varout, cdglobal=TRIM(cglobal) ) ierr = putheadervar(ncout, cf_ufil, ikx, iky, nclass, pnavlon=rdum, pnavlat=rdum, pdep=rclass ) tim = getvar1d (cf_ufil, cn_vtimec, npt ) ierr = putvar1d (ncout, tim, npt, 'T') PRINT *, ' Give iimin, iimax, ijmin, ijmax ' READ(*,*) iimin, iimax, ijmin, ijmax !! Find the broken line between P1 (iimin,ijmin) and P2 (iimax, ijmax) ! ... Initialization ii0 = iimin ; ij0 = ijmin ; ii1 = iimax ; ij1 = ijmax rxi0 = ii0 ; ryj0 = ij0 ; rxi1 = ii1 ; ryj1 = ij1 ! compute direction of integrations and signs !The transport across the section is the dot product of !integral(line){(Mx,My)*dS} !Mx=integral(u*dz) My=integral(v*dz)) and dS=(dy,-dx)} !By defining the direction of the integration as idirx = SIGN(1,ii1-ii0) !positive to the east or if ii1=ii0 idiry = SIGN(1,ij1-ij0) !positive to the north or if ij1=ij0 !Then dS=(e2u*idiry,-e1v*idirx) !This will produce the following sign convention: ! West-to-est line (dx>0, dy=0)=> -My*dx (-ve for a northward flow) ! South-to-north (dy>0, dx=0)=> Mx*dy (+ve for an eastward flow) norm_u = idiry norm_v = -idirx ! .. Compute equation: ryj = aj rxi + bj [valid in the (i,j) plane] IF ( (rxi1 -rxi0) /= 0 ) THEN aj = (ryj1 - ryj0 ) / (rxi1 -rxi0) bj = ryj0 - aj * rxi0 ELSE aj = 10000. ! flag value bj = 0. END IF ! .. Compute equation: rxi = ai ryj + bi [valid in the (i,j) plane] IF ( (ryj1 -ryj0) /= 0 ) THEN ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 ) bi = rxi0 - ai * ryj0 ELSE ai = 10000. ! flag value bi = 0. END IF ! .. Compute the integer pathway: a succession of F points np=0 ! .. Chose the strait line with the smallest slope IF (ABS(aj) <= 1 ) THEN ! ... Here, the best line is y(x) ! ... If ii1 < ii0 swap points [ always describe section from left to right ] IF (ii1 < ii0 ) THEN iitmp = ii0 ; ijtmp = ij0 ii0 = ii1 ; ij0 = ij1 ii1 = iitmp ; ij1 = ijtmp END IF ! iist,ijst is the grid offset to pass from F point to either U/V point IF ( ij1 >= ij0 ) THEN ! line heading NE iist = 1 ; ijst = 1 ELSE ! line heading SE iist = 1 ; ijst = 0 END IF ! ... compute the nearest ji point on the line crossing at ji DO ji=ii0, ii1 np=np+1 IF (np > jpseg) STOP 'np > jpseg !' ij=NINT(aj*ji + bj ) yypt(np) = CMPLX(ji,ij) END DO ELSE ! ... Here, the best line is x(y) ! ... If ij1 < ij0 swap points [ always describe section from bottom to top ] IF (ij1 < ij0 ) THEN iitmp = ii0 ; ijtmp = ij0 ii0 = ii1 ; ij0 = ij1 ii1 = iitmp ; ij1 = ijtmp END IF ! iist,ijst is the grid offset to pass from F point to either U/V point IF ( ii1 >= ii0 ) THEN iist = 1 ; ijst = 1 ELSE iist = 0 ; ijst = 1 END IF ! ... compute the nearest ji point on the line crossing at jj DO jj=ij0,ij1 np=np+1 IF (np > jpseg) STOP 'np > jpseg !' ii=NINT(ai*jj + bi) yypt(np) = CMPLX(ii,jj) END DO END IF !! !! Look for intermediate points to be added. ! .. The final positions are saved in rxx,ryy rxx(1) = REAL(yypt(1)) ryy(1) = IMAG(yypt(1)) nn = 1 DO jk=2,np ! .. distance between 2 neighbour points rd=ABS(yypt(jk)-yypt(jk-1)) ! .. intermediate points required if rd > 1 IF ( rd > 1 ) THEN CALL interm_pt(yypt, jk, ai, bi, aj, bj, yypti) nn=nn+1 IF (nn > jpseg) STOP 'nn>jpseg !' rxx(nn) = REAL(yypti) ryy(nn) = IMAG(yypti) END IF nn=nn+1 IF (nn > jpseg) STOP 'nn>jpseg !' rxx(nn) = REAL(yypt(jk)) ryy(nn) = IMAG(yypt(jk)) END DO ! record longitude and latitude of initial en endind point of the section gla (1) = glamf( INT(rxx(1)), INT(ryy(1)) ) gphi(1) = gphif( INT(rxx(1)), INT(ryy(1)) ) gla (2) = glamf( INT(rxx(nn)), INT(ryy(nn)) ) gphi(2) = gphif( INT(rxx(nn)), INT(ryy(nn)) ) ! Now extract the transport through a section ! ... Check whether we need a u velocity or a v velocity ! Think that the points are f-points and delimit either a U segment ! or a V segment (iist and ijst are set in order to look for the correct ! velocity point on the C-grid PRINT *, TRIM(csection) PRINT *, 'IMIN IMAX JMIN JMAX', iimin, iimax, ijmin, ijmax WRITE(numout,*) '% Transport along a section by levels' ,TRIM(csection) WRITE(numout,*) '% ---- IMIN IMAX JMIN JMAX' dvoltrpbrtp = 0.d0 dvoltrpbrtpp = 0.d0 dvoltrpbrtpm = 0.d0 dheatrpbrtp = 0.d0 dsaltrpbrtp = 0.d0 DO jclass=1,nclass dvoltrpsum(jclass) = 0.d0 IF ( lpm ) THEN dvoltrpsump(jclass) = 0.d0 dvoltrpsumm(jclass) = 0.d0 ENDIF IF ( lheat ) THEN dheatrpsum(jclass) = 0.d0 dsaltrpsum(jclass) = 0.d0 ENDIF ! segment jseg is a line between (rxx(jseg),ryy(jseg)) and (rxx(jseg+1),ryy(jseg+1)) DO jseg = 1, nn-1 ii0=rxx(jseg) ij0=ryy(jseg) IF ( rxx(jseg) == rxx(jseg+1) ) THEN ! meridional segment, use U velocity dvoltrp(jseg)= dtrpu (ii0,ij0+ijst,jclass)*norm_u IF ( lpm ) THEN dvoltrpp(jseg)= dtrpup(ii0,ij0+ijst,jclass)*norm_u dvoltrpm(jseg)= dtrpum(ii0,ij0+ijst,jclass)*norm_u ENDIF IF ( lheat ) THEN dheatrp(jseg)= dtrput(ii0,ij0+ijst,jclass)*norm_u dsaltrp(jseg)= dtrpus(ii0,ij0+ijst,jclass)*norm_u ENDIF ELSE IF ( ryy(jseg) == ryy(jseg+1) ) THEN ! zonal segment, use V velocity dvoltrp(jseg)=dtrpv (ii0+iist,ij0,jclass)*norm_v IF ( lpm ) THEN dvoltrpp(jseg)=dtrpvp(ii0+iist,ij0,jclass)*norm_v dvoltrpm(jseg)=dtrpvm(ii0+iist,ij0,jclass)*norm_v ENDIF IF ( lheat ) THEN dheatrp(jseg)=dtrpvt(ii0+iist,ij0,jclass)*norm_v dsaltrp(jseg)=dtrpvs(ii0+iist,ij0,jclass)*norm_v ENDIF ELSE PRINT *,' ERROR :', rxx(jseg),ryy(jseg),rxx(jseg+1),ryy(jseg+1) ! likely to never happen ! END IF dvoltrpsum(jclass) = dvoltrpsum(jclass) + dvoltrp(jseg) IF ( lpm ) THEN dvoltrpsump(jclass) = dvoltrpsump(jclass) + dvoltrpp(jseg) dvoltrpsumm(jclass) = dvoltrpsumm(jclass) + dvoltrpm(jseg) ENDIF IF ( lheat ) THEN dheatrpsum(jclass) = dheatrpsum(jclass) + dheatrp(jseg) dsaltrpsum(jclass) = dsaltrpsum(jclass) + dsaltrp(jseg) ENDIF END DO ! next segment ! Ascii outputs : IF (jclass == 1 ) THEN ! print header when it is the first class PRINT '(a,2f8.2,a,2f8.2)', 'FROM (LON LAT): ', gla(1),gphi(1),' TO (LON LAT) ', gla(2), gphi(2) WRITE(numout,*) '% ---- LONmin LATmin LONmax LATmax' WRITE(numout,*) '% Top(m) Bottom(m) MassTrans(Sv) HeatTrans(PW) SaltTrans(kt/s)' WRITE(numout,*) 0 ,iimin, iimax, ijmin, ijmax WRITE(numout,9003) 0. ,gla(1),gphi(1), gla(2), gphi(2) ENDIF PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1) PRINT *, ' Mass transport : ', dvoltrpsum(jclass)/1.e6,' SV' WRITE(numvtrp,'(e12.6)') dvoltrpsum(jclass) IF ( lpm ) THEN PRINT *, ' Positive Mass transport : ', dvoltrpsump(jclass)/1.e6,' SV' PRINT *, ' Negative Mass transport : ', dvoltrpsumm(jclass)/1.e6,' SV' WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), & & dvoltrpsum(jclass)/1.e6, dvoltrpsump(jclass)/1.e6, dvoltrpsumm(jclass)/1.e6 WRITE(numvtrp,'(e12.6)') dvoltrpsump(jclass) WRITE(numvtrp,'(e12.6)') dvoltrpsumm(jclass) ENDIF IF ( lheat ) THEN PRINT *, ' Heat transport : ', dheatrpsum(jclass)/1.e15,' PW' PRINT *, ' Salt transport : ', dsaltrpsum(jclass)/1.e6,' kT/s' WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), & & dvoltrpsum(jclass)/1.e6, dheatrpsum(jclass)/1.e15, dsaltrpsum(jclass)/1.e6 WRITE(numhtrp,'(e12.6)') dheatrpsum(jclass) WRITE(numstrp,'(e12.6)') dsaltrpsum(jclass) ELSE IF ( .NOT. lpm ) WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), dvoltrpsum(jclass)/1.e6 ENDIF ! netcdf output IF ( nclass > 1 ) THEN rdum(1,1) = REAL(dvoltrpsum(jclass)/1.e6) ierr = putvar(ncout,id_varout(ivtrpcl), rdum, jclass, 1, 1, ktime=itime ) IF ( lpm ) THEN rdum(1,1) = REAL(dvoltrpsump(jclass)/1.e6) ierr = putvar(ncout,id_varout(iptrpcl), rdum, jclass, 1, 1, ktime=itime ) rdum(1,1) = REAL(dvoltrpsumm(jclass)/1.e6) ierr = putvar(ncout,id_varout(imtrpcl), rdum, jclass, 1, 1, ktime=itime ) ENDIF IF ( lheat ) THEN rdum(1,1) = REAL(dheatrpsum(jclass)/1.e15) ierr = putvar(ncout,id_varout(ihtrpcl), rdum, jclass, 1, 1, ktime=itime ) rdum(1,1) = REAL(dsaltrpsum(jclass)/1.e6) ierr = putvar(ncout,id_varout(istrpcl), rdum, jclass, 1, 1, ktime=itime ) ENDIF ENDIF rdum(1,1) = REAL(gdepw(ilev0(jclass))) ierr = putvar(ncout,id_varout(itop), rdum, jclass, 1, 1, ktime=itime ) rdum(1,1) = REAL(gdepw(ilev1(jclass)+1)) ierr = putvar(ncout,id_varout(ibot), rdum, jclass, 1, 1, ktime=itime ) dvoltrpbrtp = dvoltrpbrtp + dvoltrpsum(jclass) IF ( lpm ) THEN dvoltrpbrtpp = dvoltrpbrtpp + dvoltrpsump(jclass) dvoltrpbrtpm = dvoltrpbrtpm + dvoltrpsumm(jclass) ENDIF IF ( lheat) THEN dheatrpbrtp = dheatrpbrtp + dheatrpsum(jclass) dsaltrpbrtp = dsaltrpbrtp + dsaltrpsum(jclass) ENDIF ! save sum over legs dvolallegcl(jclass) = dvolallegcl(jclass) + dvoltrpsum(jclass) IF ( lpm ) THEN dvolallegclp(jclass) = dvolallegclp(jclass) + dvoltrpsump(jclass) dvolallegclm(jclass) = dvolallegclm(jclass) + dvoltrpsumm(jclass) ENDIF IF ( lheat ) THEN dheatallegcl(jclass) = dheatallegcl(jclass) + dheatrpsum(jclass) dsaltallegcl(jclass) = dsaltallegcl(jclass) + dsaltrpsum(jclass) ENDIF END DO ! next class ! save sum over legs dvolalleg = dvolalleg + dvoltrpbrtp IF ( lpm ) THEN dvolallegp = dvolallegp + dvoltrpbrtpp dvolallegm = dvolallegm + dvoltrpbrtpm ENDIF IF ( lheat ) THEN dheatalleg = dheatalleg + dheatrpbrtp dsaltalleg = dsaltalleg + dsaltrpbrtp ENDIF IF ( nclass > 1 ) THEN PRINT *, ' =====================================================' PRINT *, ' total Mass transport : ', dvoltrpbrtp/1.e6,' SV' IF ( lpm ) THEN PRINT *, ' total positive transport : ', dvoltrpbrtpp/1.e6,' SV' PRINT *, ' total negative transport : ', dvoltrpbrtpm/1.e6,' SV' ENDIF IF ( lheat ) THEN PRINT *, ' total Heat transport : ', dheatrpbrtp/1.e15,' PW' PRINT *, ' total Salt transport : ', dsaltrpbrtp/1.e6,' kT/s' ENDIF ENDIF ierr = putvar0d(ncout,id_varout(ivtrp), REAL(dvoltrpbrtp/1.e6) ) IF ( lpm ) THEN ierr = putvar0d(ncout,id_varout(iptrp), REAL(dvoltrpbrtpp/1.e6) ) ierr = putvar0d(ncout,id_varout(imtrp), REAL(dvoltrpbrtpm/1.e6) ) ENDIF IF ( lheat ) THEN ierr = putvar0d(ncout,id_varout(ihtrp), REAL(dheatrpbrtp/1.e15) ) ierr = putvar0d(ncout,id_varout(istrp), REAL(dsaltrpbrtp/1.e6 ) ) ENDIF ierr = putvar0d(ncout,id_varout(ilonmin), REAL(gla(1)) ) ierr = putvar0d(ncout,id_varout(ilonmax), REAL(gla(2)) ) ierr = putvar0d(ncout,id_varout(ilatmin), REAL(gphi(1)) ) ierr = putvar0d(ncout,id_varout(ilatmax), REAL(gphi(2)) ) ierr = closeout(ncout) END DO ! infinite loop : gets out when input is EOF PRINT *,' ' PRINT *,' Overall transports (sum of all legs done so far)' DO jclass = 1, nclass PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1) PRINT *, ' Mass transport : ', dvolallegcl(jclass)/1.e6,' SV' IF ( lpm ) THEN PRINT *, ' Positive Mass transport : ', dvolallegclp(jclass)/1.e6,' SV' PRINT *, ' Negative Mass transport : ', dvolallegclm(jclass)/1.e6,' SV' ENDIF IF ( lheat ) THEN PRINT *, ' Heat transport : ', dheatallegcl(jclass)/1.e15,' PW' PRINT *, ' Salt transport : ', dsaltallegcl(jclass)/1.e6,' kT/s' ENDIF ENDDO IF ( nclass > 1 ) THEN PRINT *, ' =====================================================' PRINT *, ' Mass transport : ', dvolalleg/1.e6,' SV' IF ( lpm ) THEN PRINT *, ' positive transport : ', dvolallegp/1.e6,' SV' PRINT *, ' negative transport : ', dvolallegm/1.e6,' SV' ENDIF IF ( lheat ) THEN PRINT *, ' heat transport : ', dheatalleg/1.e15,' PW' PRINT *, ' salt transport : ', dsaltalleg/1.e6,' kT/s' ENDIF ENDIF 9000 FORMAT(I4,6(f9.3,f8.4)) 9001 FORMAT(I4,6(f9.2,f9.3)) 9002 FORMAT(f9.0,f9.0,f9.2,f9.2,f9.2) 9003 FORMAT(f9.2,f9.2,f9.2,f9.2,f9.2) CONTAINS SUBROUTINE set_typvar ( sd_typvar, cdsection, cdvarname, cdlongname ) !!--------------------------------------------------------------------- !! *** ROUTINE set_typvar *** !! !! ** Purpose : Initialize typvar structure for netcdfoutput at a given section !! !! ** Method : use varname longname to suffix variable name and attributes !! If varname and/or logname are not given (ie 'none') take !! standard default names !! Netcdf id for variables are passed as global variables !!---------------------------------------------------------------------- TYPE(variable), DIMENSION(:), INTENT(out) :: sd_typvar ! structure of output CHARACTER(LEN=*), INTENT(in ) :: cdsection CHARACTER(LEN=*), INTENT(in ) :: cdvarname CHARACTER(LEN=*), INTENT(in ) :: cdlongname !! INTEGER(KIND=4) :: ivar CHARACTER(LEN=255) :: csuffixvarnam CHARACTER(LEN=255) :: cprefixlongnam !!---------------------------------------------------------------------- ! set suffixes according to variable/longname IF ( cdvarname /= 'none' ) THEN csuffixvarnam = '_'//TRIM(cdvarname) ELSE csuffixvarnam = '' ENDIF IF ( cdlongname /= 'none' ) THEN cprefixlongnam = TRIM(cdlongname)//'_' ELSE cprefixlongnam = '' ENDIF ! set common values sd_typvar%rmissing_value=99999. sd_typvar%scale_factor= 1. sd_typvar%add_offset= 0. sd_typvar%savelog10= 0. sd_typvar%conline_operation='N/A' sd_typvar%caxis='T' ! set particular values for individual variables ivar = 1 ; ivtrp = ivar ipk(ivar) = 1 sd_typvar(ivar)%cname = 'vtrp'//TRIM(csuffixvarnam) sd_typvar(ivar)%cunits = 'Sverdrup' sd_typvar(ivar)%valid_min = -500. sd_typvar(ivar)%valid_max = 500. sd_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'Volume_Transport' sd_typvar(ivar)%cshort_name = 'vtrp' IF ( lpm ) THEN ivar = ivar + 1 ; iptrp = ivar ; imtrp = ivar+1 ipk(ivar) = 1 ; ipk(ivar+1) = 1 sd_typvar(ivar)%cname = 'ptrp'//TRIM(csuffixvarnam) ; sd_typvar(ivar+1)%cname = 'mtrp'//TRIM(csuffixvarnam) sd_typvar(ivar)%cunits = 'Sverdrup' ; sd_typvar(ivar+1)%cunits = 'Sverdrup' sd_typvar(ivar)%valid_min = -500. ; sd_typvar(ivar+1)%valid_min = -500. sd_typvar(ivar)%valid_max = 500. ; sd_typvar(ivar+1)%valid_max = 500. sd_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'Positive_volume_transport' ; sd_typvar(ivar+1)%clong_name = TRIM(cprefixlongnam)//'Negative_volume_transport' sd_typvar(ivar)%cshort_name = 'ptrp' ; sd_typvar(ivar+1)%cshort_name = 'mtrp' ivar = ivar + 1 ENDIF IF ( lheat ) THEN ivar = ivar + 1 ; ihtrp = ivar ; istrp = ivar+1 ipk(ivar) = 1 ; ipk(ivar+1) = 1 sd_typvar(ivar)%cname = 'htrp'//TRIM(csuffixvarnam) ; sd_typvar(ivar+1)%cname = 'strp'//TRIM(csuffixvarnam) sd_typvar(ivar)%cunits = 'PW' ; sd_typvar(ivar+1)%cunits = 'kt/s' sd_typvar(ivar)%valid_min = -1000. ; sd_typvar(ivar+1)%valid_min = -1000. sd_typvar(ivar)%valid_max = 1000. ; sd_typvar(ivar+1)%valid_max = 1000. sd_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'Heat_Transport' ; sd_typvar(ivar+1)%clong_name = TRIM(cprefixlongnam)//'Salt_Transport' sd_typvar(ivar)%cshort_name = 'htrp' ; sd_typvar(ivar+1)%cshort_name = 'strp' ivar = ivar + 1 ENDIF ivar = ivar + 1 ; ilonmin = ivar ; ilonmax = ivar+1 ipk(ivar) = 1 ; ipk(ivar+1) = 1 sd_typvar(ivar)%cname = 'lonmin'//TRIM(csuffixvarnam) ; sd_typvar(ivar+1)%cname = 'lonmax'//TRIM(csuffixvarnam) sd_typvar(ivar)%cunits = 'deg' ; sd_typvar(ivar+1)%cunits = 'deg' sd_typvar(ivar)%valid_min = -180. ; sd_typvar(ivar+1)%valid_min = -180. sd_typvar(ivar)%valid_max = 180. ; sd_typvar(ivar+1)%valid_max = 180. sd_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'begin_longitude' ; sd_typvar(ivar+1)%clong_name = TRIM(cprefixlongnam)//'end_longitude' sd_typvar(ivar)%cshort_name = 'lonmin' ; sd_typvar(ivar+1)%cshort_name = 'lonmax' ivar = ivar + 1 ivar = ivar + 1 ; ilatmin = ivar ; ilatmax = ivar+1 ipk(ivar) = 1 ; ipk(ivar+1) = 1 sd_typvar(ivar)%cname = 'latmin'//TRIM(csuffixvarnam) ; sd_typvar(ivar+1)%cname = 'latmax'//TRIM(csuffixvarnam) sd_typvar(ivar)%cunits = 'deg' ; sd_typvar(ivar+1)%cunits = 'deg' sd_typvar(ivar)%valid_min = -90. ; sd_typvar(ivar+1)%valid_min = -90. sd_typvar(ivar)%valid_max = 90. ; sd_typvar(ivar+1)%valid_max = 90. sd_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'begin_latitude' ; sd_typvar(ivar+1)%clong_name = TRIM(cprefixlongnam)//'end_latitude' sd_typvar(ivar)%cshort_name = 'latmin' ; sd_typvar(ivar+1)%cshort_name = 'latmax' ivar = ivar + 1 ivar = ivar + 1 ; itop = ivar ; ibot = ivar+1 ipk(ivar) = nclass ; ipk(ivar+1) = nclass sd_typvar(ivar)%cname = 'top' ; sd_typvar(ivar+1)%cname = 'bottom' sd_typvar(ivar)%cunits = 'meters' ; sd_typvar(ivar+1)%cunits = 'meters' sd_typvar(ivar)%valid_min = 0. ; sd_typvar(ivar+1)%valid_min = 0. sd_typvar(ivar)%valid_max = 10000. ; sd_typvar(ivar+1)%valid_max = 10000. sd_typvar(ivar)%clong_name = 'class_min_depth' ; sd_typvar(ivar+1)%clong_name = 'class_max_depth' sd_typvar(ivar)%cshort_name = 'top' ; sd_typvar(ivar+1)%cshort_name = 'bottom' ivar = ivar + 1 ivtrpcl = -1 ; ihtrpcl = -1 ; istrpcl = -1 IF ( nclass > 1 ) THEN ! define additional variable for vertical profile of transport (per class) ivar = ivar + 1 ; ivtrpcl = ivar ipk(ivar) = nclass sd_typvar(ivar)%cname = 'vtrp_dep'//TRIM(csuffixvarnam) sd_typvar(ivar)%cunits = 'SV' sd_typvar(ivar)%valid_min = 0. sd_typvar(ivar)%valid_max = 10000. sd_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'Volume_Transport_per_class' sd_typvar(ivar)%cshort_name = 'vtrp_dep' IF ( lpm ) THEN ivar = ivar + 1 ; iptrpcl = ivar ; imtrpcl = ivar+1 ipk(ivar) = nclass ; ipk(ivar+1) = nclass sd_typvar(ivar)%cname = 'ptrp_dep'//TRIM(csuffixvarnam) ; sd_typvar(ivar+1)%cname = 'mtrp_dep'//TRIM(csuffixvarnam) sd_typvar(ivar)%cunits = 'SV' ; sd_typvar(ivar+1)%cunits = 'SV' sd_typvar(ivar)%valid_min = -500. ; sd_typvar(ivar+1)%valid_min = -500. sd_typvar(ivar)%valid_max = 500. ; sd_typvar(ivar+1)%valid_max = 500. sd_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'Positive_trp_per_class' ; sd_typvar(ivar+1)%clong_name = TRIM(cprefixlongnam)//'Negative_trp_per_class' sd_typvar(ivar)%cshort_name = 'ptrp_dep' ; sd_typvar(ivar+1)%cshort_name = 'mtrp_dep' ivar = ivar + 1 ENDIF IF ( lheat ) THEN ivar = ivar + 1 ; ihtrpcl = ivar ; istrpcl = ivar+1 ipk(ivar) = nclass ; ipk(ivar+1) = nclass sd_typvar(ivar)%cname = 'htrp_dep'//TRIM(csuffixvarnam) ; sd_typvar(ivar+1)%cname = 'strp_dep'//TRIM(csuffixvarnam) sd_typvar(ivar)%cunits = 'PW' ; sd_typvar(ivar+1)%cunits = 'kt/s' sd_typvar(ivar)%valid_min = -1000. ; sd_typvar(ivar+1)%valid_min = -1000. sd_typvar(ivar)%valid_max = 1000. ; sd_typvar(ivar+1)%valid_max = 1000. sd_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'Heat_Transport_per_class' ; sd_typvar(ivar+1)%clong_name = TRIM(cprefixlongnam)//'Salt_Transport_per_class' sd_typvar(ivar)%cshort_name = 'htrp_dep' ; sd_typvar(ivar+1)%cshort_name = 'strp_dep' ivar = ivar + 1 ENDIF ENDIF END SUBROUTINE set_typvar SUBROUTINE interm_pt (ydpt, kk, pai, pbi, paj, pbj, ydpti) !!--------------------------------------------------------------------- !! *** ROUTINE nterm_pt *** !! !! ** Purpose : Find the best intermediate points on a pathway. !! !! ** Method : ydpt : complex vector of the positions of the nearest points !! kk : current working index !! pai, pbi : slope and original ordinate of x(y) !! paj, pbj : slope and original ordinate of y(x) !! ydpti : Complex holding the position of intermediate point !! !! ** Reference : 19/07/1999 : J.M. Molines in Clipper !!---------------------------------------------------------------------- COMPLEX, DIMENSION(:), INTENT(in ) :: ydpt COMPLEX, INTENT(out) :: ydpti REAL(KIND=4), INTENT(in ) :: pai, pbi, paj, pbj INTEGER(KIND=4), INTENT(in ) :: kk ! ... local COMPLEX :: ylptmp1, ylptmp2 REAL(KIND=4) :: za0, zb0 REAL(KIND=4) :: za1, zb1 REAL(KIND=4) :: zd1, zd2 REAL(KIND=4) :: zxm, zym REAL(KIND=4) :: zxp, zyp !!---------------------------------------------------------------------- ! ... Determines whether we use y(x) or x(y): IF (ABS(paj) <= 1) THEN ! ..... use y(x) ! ... possible intermediate points: ylptmp1=ydpt(kk-1)+(1.,0.) ! M1 ylptmp2=ydpt(kk-1)+CMPLX(0.,SIGN(1.,paj)) ! M2 ! ! ... M1 is the candidate point: zxm=REAL(ylptmp1) zym=IMAG(ylptmp1) za0=paj zb0=pbj ! za1=-1./za0 zb1=zym - za1*zxm ! ... P1 is the projection of M1 on the strait line zxp=-(zb1-zb0)/(za1-za0) zyp=za0*zxp + zb0 ! ... zd1 is the distance M1P1 zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp) ! ! ... M2 is the candidate point: zxm=REAL(ylptmp2) zym=IMAG(ylptmp2) za1=-1./za0 zb1=zym - za1*zxm ! ... P2 is the projection of M2 on the strait line zxp=-(zb1-zb0)/(za1-za0) zyp=za0*zxp + zb0 ! ... zd2 is the distance M2P2 zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp) ! ... chose the smallest (zd1,zd2) IF (zd2 <= zd1) THEN ydpti=ylptmp2 ! use M2 ELSE ydpti=ylptmp1 ! use M1 END IF ! ELSE ! ... use x(y) ! ... possible intermediate points: ylptmp1=ydpt(kk-1)+CMPLX(SIGN(1.,pai),0.) ! M1 ylptmp2=ydpt(kk-1)+(0.,1.) ! M2 ! ! ... M1 is the candidate point: zxm=REAL(ylptmp1) zym=IMAG(ylptmp1) za0=pai zb0=pbi ! za1=-1./za0 zb1=zxm - za1*zym zyp=-(zb1-zb0)/(za1-za0) zxp=za0*zyp + zb0 zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp) ! zxm=REAL(ylptmp2) zym=IMAG(ylptmp2) za1=-1./za0 zb1=zxm - za1*zym zyp=-(zb1-zb0)/(za1-za0) zxp=za0*zyp + zb0 zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp) IF (zd2 <= zd1) THEN ydpti=ylptmp2 ELSE ydpti=ylptmp1 END IF END IF END SUBROUTINE interm_pt END PROGRAM cdftransport cdftools-3.0/cdfstd.f900000644000175000017500000002342112241227304016111 0ustar amckinstryamckinstryPROGRAM cdfstd !!====================================================================== !! *** PROGRAM cdfstd *** !!===================================================================== !! ** Purpose : Compute Standard deviation values for all the !! variables in a bunch of cdf files given as argument !! Store the results on a 'similar' cdf file. !! !! ** Method : Compute mean, mean squared, then the variance and !! the standard deviation !! !! History : 2.1 : 04/2006 : F. Castruccio : Original code (from cdfmoy) !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jfil, jt ! dummy loop index INTEGER(KIND=4) :: jvar, jv ! dummy loop index INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! number of variables in a file INTEGER(KIND=4) :: ntframe ! cumul of time frame INTEGER(KIND=4) :: ncout ! ncid of stdev file output INTEGER(KIND=4) :: ncou2 ! ncid of mean file output (optional) INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! varid's of input variables INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! levels and varid's of output vars INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varoutm ! varid's of mean var output (optional) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! 2d data array REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! tim counter REAL(KIND=4), DIMENSION(1) :: timean ! mean time REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtab, dtab2 ! cumulated values and squared values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dstd ! standard deviation REAL(KIND=8) :: dtotal_time ! cumulated time CHARACTER(LEN=256) :: cf_in ! input file CHARACTER(LEN=256) :: cf_out='cdfstd.nc' ! std dev output file CHARACTER(LEN=256) :: cf_moy='cdfmoy.nc' ! mean output file (optional) CHARACTER(LEN=256) :: cv_dep ! depth variable name CHARACTER(LEN=256) :: cldum ! dummy string CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_namesi ! array of var name CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nameso ! array of var name for output TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvari ! attributes of input variables TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvaro ! attributes of output variables LOGICAL :: lcaltmean ! time mean computation flag LOGICAL :: lsave=.false. ! mean value save flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfstd list_of files [-save]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the standard deviation of the variables belonging to a set of' PRINT *,' files given as arguments. This computation is direct and does not ' PRINT *,' required a pre-processing with any of the cdfmoy tools.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' List on netcdf files of the same type, forming a time-series' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -save ] : Save the mean value of the field, in addition to the ' PRINT *,' std deviation' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' - netcdf file : ', TRIM(cf_out) PRINT *,' variables : IN-var_std, same units than input variables.' PRINT *,' - netcdf file : ', TRIM(cf_moy),' in case of -save option.' PRINT *,' variables : IN-var, same units than input variables.' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfmoy, cdfrmsssh, cdfstdevw' STOP ENDIF ! look for -save option and one of the file name ijarg = 1 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-save' ) lsave = .true. CASE DEFAULT cf_in = cldum ! CALL getarg (ijarg, cf_in) ; ijarg = ijarg + 1 EXIT ! got the first file END SELECT END DO IF ( chkfile(cf_in) ) STOP ! missing file npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z',kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr) IF (ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk ALLOCATE( dtab(npiglo,npjglo), dtab2(npiglo,npjglo), v2d(npiglo,npjglo) ) ALLOCATE( dstd(npiglo,npjglo) ) nvars = getnvar(cf_in) PRINT *,' nvars =', nvars ALLOCATE (cv_namesi(nvars), cv_nameso(nvars) ) ALLOCATE (stypvari(nvars), stypvaro(nvars) ) ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars) ) IF ( lsave ) ALLOCATE (id_varoutm(nvars) ) cv_namesi(:) = getvarname(cf_in, nvars, stypvari) id_var(:) = (/(jv, jv=1,nvars)/) ipk(:) = getipk(cf_in, nvars, cdep=cv_dep) DO jvar = 1, nvars cv_nameso(jvar) = TRIM(cv_namesi(jvar))//'_std' ENDDO WHERE( ipk == 0 ) cv_nameso='none' DO jvar = 1, nvars stypvaro(jvar) = stypvari(jvar) stypvaro(jvar)%cname = cv_nameso(jvar) stypvaro(jvar)%clong_name = 'Std Deviation of '//TRIM(cv_namesi(jvar)) stypvaro(jvar)%cshort_name = cv_nameso(jvar) END DO ! create output fileset ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep ) ierr = createvar (ncout, stypvaro, nvars, ipk, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk, cdep=cv_dep ) IF ( lsave ) THEN ! create output fileset for mean values ncou2 = create (cf_moy, cf_in, npiglo, npjglo, npk, cdep=cv_dep ) ierr = createvar (ncou2, stypvari, nvars, ipk, id_varoutm ) ierr = putheadervar(ncou2, cf_in, npiglo, npjglo, npk, cdep=cv_dep ) ENDIF lcaltmean=.TRUE. DO jvar = 1,nvars IF ( cv_namesi(jvar) == cn_vlon2d .OR. & cv_namesi(jvar) == cn_vlat2d .OR. & cv_nameso(jvar) == 'none' ) THEN ! skip these variable ELSE PRINT *,' Working with ', TRIM(cv_namesi(jvar)), ipk(jvar) DO jk = 1, ipk(jvar) PRINT *,'level ',jk dtab(:,:) = 0.d0; dtab2(:,:) = 0.d0; dtotal_time = 0.d0 ntframe = 0 DO jfil = 1, narg CALL getarg (jfil, cf_in) IF ( chkfile(cf_in) ) STOP ! missing file IF ( lcaltmean ) THEN npt = getdim (cf_in, cn_t) ALLOCATE (tim(npt) ) tim(:) = getvar1d(cf_in, cn_vtimec, npt) dtotal_time = dtotal_time + SUM(DBLE(tim)) DEALLOCATE ( tim ) END IF DO jt=1,npt ntframe = ntframe + 1 v2d( :,:) = getvar(cf_in, cv_namesi(jvar), jk, npiglo, npjglo, ktime=jt) dtab( :,:) = dtab( :,:) + v2d(:,:)*1.d0 dtab2(:,:) = dtab2(:,:) + v2d(:,:)*v2d(:,:)*1.d0 END DO END DO ! finish with level jk ; compute mean (assume spval is 0 ) dtab( :,:) = dtab( :,:) / ntframe dtab2(:,:) = dtab2(:,:) / ntframe WHERE ( dtab2 - dtab*dtab >= 0 ) dstd = SQRT(dtab2 - dtab*dtab) ELSEWHERE dstd = 0.d0 END WHERE ! store variable on output file ierr = putvar(ncout, id_varout(jvar), REAL(dstd), jk, npiglo, npjglo, kwght=ntframe) IF ( lsave ) ierr = putvar(ncou2, id_varoutm(jvar), REAL(dtab), jk, npiglo, npjglo, kwght=ntframe) IF ( lcaltmean ) THEN timean(1) = dtotal_time / ntframe ierr = putvar1d(ncout, timean, 1, 'T') IF ( lsave ) ierr = putvar1d(ncou2, timean, 1, 'T') lcaltmean = .FALSE. ! tmean already computed END IF END DO ! loop to next level END IF END DO ! loop to next var in file ierr = closeout(ncout) ierr = closeout(ncou2) END PROGRAM cdfstd cdftools-3.0/cdfsstconv.f900000644000175000017500000005662112241227304017026 0ustar amckinstryamckinstryPROGRAM cdfflxconv !!------------------------------------------------------------------- !! PROGRAM CDFFLXCONV !! ****************** !! !! ** Purpose: Convert a set of fluxes dimgfile (Clipper like) !! to a set of CDF files (Drakkar like ) !! !! ** Method: takes the current year as input, and config name !! automatically read !! ECMWF.Y${year}.M??.FLUX.${config}.dimg (daily, 1 file per month) !! ECMWF.Y${year}.M??.STRESS.${config}.dimg (daily, 1 file per month) !! REYNOLDS.Y${year}.SST.${config}.dimg ( weekly, 1 file per year ) ! Danger ! !! creates 6 netcdf daily files : !! ECMWF_emp_1d_${year}.${config}.nc !! ECMWF_qnet_1d_${year}.${config}.nc !! ECMWF_qsr_1d_${year}.${config}.nc !! ECMWF_sst_1d_${year}.${config}.nc !! ECMWF_taux_1d_${year}.${config}.nc !! ECMWF_tauy_1d_${year}.${config}.nc !! Requires coordinates.diags file (to be input consistent) !! !! history: !! Original: J.M. Molines (Feb. 2007 ) !!------------------------------------------------------------------- !! $Rev$ !! $Date$ !! $Id$ !!-------------------------------------------------------------- !! !! * Modules used USE cdfio !! * Local variables IMPLICIT NONE INTEGER :: ji,jj,jk, jvar, jmonth, jdim, jday, jt INTEGER :: narg, iargc, nvar INTEGER :: npiglo,npjglo, npk !: size of the domain INTEGER :: iyear, icurrday, jul, jul1, jul2 INTEGER :: id1, id2, ii1, ii2, ntime, ntp, ntn, itt INTEGER :: january1, december31 INTEGER, DIMENSION(:), ALLOCATABLE :: itime REAL(KIND=4) , DIMENSION (:,:,:), ALLOCATABLE :: v2d REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glam, gphi, z2d, v2daily REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamu, gphiu REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamv, gphiv REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: dep, timetab REAL(KIND=8) , DIMENSION (:), ALLOCATABLE :: timetag, timetagp,timetagn REAL(KIND=4) ,DIMENSION(1) :: timean CHARACTER(LEN=256) :: ctag, confcase ! Dimg stuff INTEGER :: irecl, ii, nt, ndim, irec INTEGER :: numflx=10, numcoo=11, numtau=12, numsst=14, numsstp=15, numsstn=16 CHARACTER(LEN=256) :: cflux, ctau, csstr,csstrp, csstrn CHARACTER(LEN=256) :: coord='coordinates.diags' CHARACTER(LEN=256) :: cheader, cdum, config CHARACTER(LEN=4) :: cver REAL(KIND=4) :: x1,y1, dx,dy, spval ! coordinates.diags INTEGER :: nrecl8 REAL(KIND=8) :: zrecl8, zpiglo,zpjglo REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: dzvar CHARACTER(LEN=256) :: cltextco LOGICAL :: lexist ! Netcdf Stuff CHARACTER(LEN=256) :: cemp, cqnet, cqsr, ctaux, ctauy, csst TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvaremp,typvarqnet,typvarqsr TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvartaux,typvartauy,typvarsst INTEGER, DIMENSION(:), ALLOCATABLE :: ipkemp, ipkqnet, ipkqsr, id_varoutemp,id_varoutqnet, id_varoutqsr INTEGER, DIMENSION(:), ALLOCATABLE :: ipktaux, ipktauy, ipksst, id_varouttaux,id_varouttauy, id_varoutsst INTEGER :: ncoutemp, ncoutqnet, ncoutqsr, ncouttaux, ncouttauy, ncoutsst INTEGER :: istatus !! Read command line narg= iargc() IF ( narg /= 2 ) THEN PRINT *,' Usage : cdfflxconv YEAR config ' PRINT *,' Output 6 cdf files : for emp, qnet, qsr, sst, taux, tauy with standard var name :' PRINT *,' sowaflup, sohefldo, soshfldo, sst, sozotaux, sometauy ' PRINT *,' coordinates.diags ( clipper like) is required in current dir ' STOP ENDIF !! CALL getarg (1, cdum) READ(cdum,*) iyear CALL getarg (2, config) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! ..... FLUXES FLUXES FLUXES ..... !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT *, 'Doing fluxes ... ' GOTO 10 !! read glam gphi in the coordinates file for T point (fluxes) nrecl8=200 OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8) READ(numcoo,rec=1) cltextco,zrecl8,zpiglo,zpjglo CLOSE(numcoo) nrecl8=zrecl8 ; npiglo=zpiglo ; npjglo=zpjglo ALLOCATE ( glam(npiglo,npjglo), gphi(npiglo,npjglo) ,dzvar(npiglo,npjglo) ) OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8) READ(numcoo,REC=2)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glam(:,:) = dzvar(:,:) READ(numcoo,REC=6)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphi(:,:) = dzvar(:,:) DEALLOCATE ( dzvar ) CLOSE(numcoo) !! build nc output files WRITE(cemp,'(a,I4.4,a)') 'ECMWF_emp_1d_',iyear,'.'//TRIM(config)//'.nc' WRITE(cqnet,'(a,I4.4,a)') 'ECMWF_qnet_1d_',iyear,'.'//TRIM(config)//'.nc' WRITE(cqsr,'(a,I4.4,a)') 'ECMWF_qsr_1d_',iyear,'.'//TRIM(config)//'.nc' jmonth=1 !! Build dimg file names WRITE(cflux,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.FLUX.'//TRIM(config)//'.dimg' ! WRITE(ctau ,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',imonth,'.STRESS.'//TRIM(config)//'.dimg' ! WRITE(csst ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg' ! open (and check ?? if they exists ) irecl=isdirect(cflux) ; OPEN( numflx,FILE=cflux, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk ALLOCATE (v2d(npiglo, npjglo,4), dep(npk) ) ALLOCATE (z2d(npiglo, npjglo) ) READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & timean(1) CLOSE(numflx) ! Build cdf files output nvar = 1 ! 1 var but many files ... (OK ... 3 actually ) ALLOCATE ( typvaremp(nvar), ipkemp(nvar), id_varoutemp(nvar) ) ALLOCATE ( typvarqnet(nvar), ipkqnet(nvar), id_varoutqnet(nvar) ) ALLOCATE ( typvarqsr(nvar), ipkqsr(nvar), id_varoutqsr(nvar) ) jvar=1 ipkemp(jvar) = 1 typvaremp(jvar)%cname='sowaflup' ! E - P = dim 3 - dim 4 dimgfile typvaremp(jvar)%cunits='kg/m2/s' typvaremp(jvar)%rmissing_value=0. typvaremp(jvar)%valid_min= -0.002 typvaremp(jvar)%valid_max= 0.002 typvaremp(jvar)%clong_name='E-P Upward water flux' typvaremp(jvar)%cshort_name='sowaflup' typvaremp(jvar)%conline_operation='N/A' typvaremp(jvar)%caxis='TYX' ipkqnet(jvar) = 1 typvarqnet(jvar)%cname='sohefldo' ! QNET = dim 1 dimgfile typvarqnet(jvar)%cunits='W/m2' typvarqnet(jvar)%rmissing_value=0. typvarqnet(jvar)%valid_min= -1000. typvarqnet(jvar)%valid_max= 1000. typvarqnet(jvar)%clong_name='Net_Downward_Heat_Flux' typvarqnet(jvar)%cshort_name='sohefldo' typvarqnet(jvar)%conline_operation='N/A' typvarqnet(jvar)%caxis='TYX' ipkqsr(jvar) = 1 typvarqsr(jvar)%cname='soshfldo' ! QSR = dim 2 dimgfile typvarqsr(jvar)%cunits='W/m2' typvarqsr(jvar)%rmissing_value=0. typvarqsr(jvar)%valid_min= -1000. typvarqsr(jvar)%valid_max= 1000. typvarqsr(jvar)%clong_name='Short_Wave_Radiation' typvarqsr(jvar)%cshort_name='soshfldo' typvarqsr(jvar)%conline_operation='N/A' typvarqsr(jvar)%caxis='TYX' ncoutemp =create(cemp, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncoutemp ,typvaremp,nvar, ipkemp,id_varoutemp ) istatus= putheadervar(ncoutemp, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ncoutqnet =create(cqnet, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncoutqnet ,typvarqnet,nvar, ipkqnet,id_varoutqnet ) istatus= putheadervar(ncoutqnet, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ncoutqsr =create(cqsr, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncoutqsr ,typvarqsr,nvar, ipkqsr,id_varoutqsr ) istatus= putheadervar(ncoutqsr, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ! Ready for time loop on month icurrday=0 DO jmonth = 1, 12 WRITE(cflux,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.FLUX.'//TRIM(config)//'.dimg' irecl=isdirect(cflux) ; OPEN( numflx,FILE=cflux, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim ! loop for days in files DO jday=1,nt icurrday=icurrday +1 DO jdim=1,ndim irec=1+(jday-1)*ndim +jdim READ(numflx,REC=irec) (( v2d(ji,jj,jdim),ji=1,npiglo),jj=1,npjglo) END DO ! emp z2d=(v2d(:,:,3) - v2d(:,:,4) )/ 86400. ! scaling from mm/d to kg/m2/s istatus = putvar(ncoutemp,id_varoutemp(1),z2d,icurrday,npiglo,npjglo) ! qnet istatus = putvar(ncoutqnet,id_varoutqnet(1),v2d(:,:,1),icurrday,npiglo,npjglo) ! qsr istatus = putvar(ncoutqsr,id_varoutqsr(1),v2d(:,:,2),icurrday,npiglo,npjglo) END DO ! loop on days CLOSE(numflx) END DO ! loop on month ! update time_counter ALLOCATE( timetab (icurrday) ) timetab=(/(jt,jt=1,icurrday)/) istatus=putvar1d(ncoutemp,timetab,icurrday,'T') istatus=putvar1d(ncoutqnet,timetab,icurrday,'T') istatus=putvar1d(ncoutqsr,timetab,icurrday,'T') ! close fluxes files istatus=closeout(ncoutemp) istatus=closeout(ncoutqnet) istatus=closeout(ncoutqsr) DEALLOCATE (v2d , dep, z2d , timetab ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! ..... STRESSES STRESSES STRESSES ...... !!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT *,' Doing Stresses ...' !! read glam gphi in the coordinates file for U point (fluxes) nrecl8=200 OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8) READ(numcoo,rec=1) cltextco,zrecl8,zpiglo,zpjglo CLOSE(numcoo) nrecl8=zrecl8 ; npiglo=zpiglo ; npjglo=zpjglo ALLOCATE ( glamu(npiglo,npjglo), gphiu(npiglo,npjglo) ,dzvar(npiglo,npjglo) ) ALLOCATE ( glamv(npiglo,npjglo), gphiv(npiglo,npjglo) ) OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8) READ(numcoo,REC=3)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamu(:,:) = dzvar(:,:) READ(numcoo,REC=7)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiu(:,:) = dzvar(:,:) READ(numcoo,REC=4)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamv(:,:) = dzvar(:,:) READ(numcoo,REC=8)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiv(:,:) = dzvar(:,:) DEALLOCATE ( dzvar ) CLOSE(numcoo) !! build nc output files WRITE(ctaux,'(a,I4.4,a)') 'ECMWF_taux_1d_',iyear,'.'//TRIM(config)//'.nc' WRITE(ctauy,'(a,I4.4,a)') 'ECMWF_tauy_1d_',iyear,'.'//TRIM(config)//'.nc' jmonth=1 !! Build dimg file names WRITE(ctau ,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg' ! WRITE(csst ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg' ! open (and check ?? if they exists ) irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk ALLOCATE (v2d(npiglo, npjglo,2), dep(npk) ) ALLOCATE (z2d(npiglo, npjglo) ) READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & timean(1) CLOSE(numtau) ! Build cdf files output nvar = 1 ! 1 var but many files ... (OK ... 3 actually ) ALLOCATE ( typvartaux(nvar), ipktaux(nvar), id_varouttaux(nvar) ) ALLOCATE ( typvartauy(nvar), ipktauy(nvar), id_varouttauy(nvar) ) jvar=1 ipktaux(jvar) = 1 typvartaux(jvar)%cname='sozotaux' ! taux dim 1 of dimgfile typvartaux(jvar)%cunits='N/m2' typvartaux(jvar)%rmissing_value=0. typvartaux(jvar)%valid_min= -0.1 typvartaux(jvar)%valid_max= 0.1 typvartaux(jvar)%clong_name='Zonal Wind Stress' typvartaux(jvar)%cshort_name='sozotaux' typvartaux(jvar)%conline_operation='N/A' typvartaux(jvar)%caxis='TYX' ipktauy(jvar) = 1 typvartauy(jvar)%cname='sometauy' ! tauy dim 2 of dimgfile typvartauy(jvar)%cunits='N/m2' typvartauy(jvar)%rmissing_value=0. typvartauy(jvar)%valid_min= -0.1 typvartauy(jvar)%valid_max= 0.1 typvartauy(jvar)%clong_name='Meridional Wind Stress' typvartauy(jvar)%cshort_name='sometauy' typvartauy(jvar)%conline_operation='N/A' typvartauy(jvar)%caxis='TYX' ncouttaux =create(ctaux, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncouttaux ,typvartaux,nvar, ipktaux,id_varouttaux ) istatus= putheadervar(ncouttaux, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ncouttauy =create(ctauy, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncouttauy ,typvartauy,nvar, ipktauy,id_varouttauy ) istatus= putheadervar(ncouttauy, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ! Ready for time loop on month icurrday=0 DO jmonth = 1, 12 WRITE(ctau,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg' irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim ! loop for days in files DO jday=1,nt icurrday=icurrday +1 DO jdim=1,ndim irec=1+(jday-1)*ndim +jdim READ(numtau,REC=irec) (( v2d(ji,jj,jdim),ji=1,npiglo),jj=1,npjglo) END DO ! taux istatus = putvar(ncouttaux,id_varouttaux(1),v2d(:,:,1),icurrday,npiglo,npjglo) ! tauy istatus = putvar(ncouttauy,id_varouttauy(1),v2d(:,:,2),icurrday,npiglo,npjglo) END DO ! loop on days CLOSE(numtau) END DO ! loop on month ! update time_counter ALLOCATE( timetab (icurrday) ) timetab=(/(jt,jt=1,icurrday)/) istatus=putvar1d(ncouttaux,timetab,icurrday,'T') istatus=putvar1d(ncouttauy,timetab,icurrday,'T') ! close fluxes files istatus=closeout(ncouttaux) istatus=closeout(ncouttauy) DEALLOCATE (v2d , dep, z2d , timetab) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! ..... SST SST SST ..... !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 10 continue PRINT *,' Doing SST ...' !! glam gphi are already read ( T point) !! build nc output files WRITE(csst,'(a,I4.4,a)') 'REYNOLDS_sst_1d_',iyear,'.'//TRIM(config)//'.nc' !! Build dimg file names WRITE(csstr ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg' ! open (and check ?? if they exists ) irecl=isdirect(csstr) ; OPEN( numsst,FILE=csstr, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numsst,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt ALLOCATE (v2d(npiglo, npjglo,nt+2),itime(nt+2), dep(npk) ,timetab(nt), timetag(nt) ) ALLOCATE (z2d(npiglo, npjglo) ,v2daily(npiglo,npjglo) ) READ(numsst,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & (timetab(jt), jt=1,nt) timetag=timetab ! convert to dble precision DEALLOCATE(timetab) ! Build cdf files output nvar = 1 ! 1 var but many files ... (OK ... 3 actually ) ALLOCATE ( typvarsst(nvar), ipksst(nvar), id_varoutsst(nvar) ) jvar=1 ipksst(jvar) = 1 typvarsst(jvar)%cname='sst' ! sst dim 1 of dimgfile typvarsst(jvar)%cunits='C' typvarsst(jvar)%rmissing_value=0. typvarsst(jvar)%valid_min= -10. typvarsst(jvar)%valid_max= 50. typvarsst(jvar)%clong_name='Reynolds SST' typvarsst(jvar)%cshort_name='SST' typvarsst(jvar)%conline_operation='N/A' typvarsst(jvar)%caxis='TYX' ncoutsst =create(csst, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncoutsst ,typvarsst,nvar, ipksst,id_varoutsst ) istatus= putheadervar(ncoutsst, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ! We want to interpolate the data for every day. (weekly in the file) ! if first day of the file is not 01/01, needs to read previous year ! Clipper SST files are not y2k compliant ... IF (timetag (1) < 10000 ) THEN timetag(:)=timetag(:)+20000000. ELSE timetag(:)=timetag(:)+19000000. ENDIF january1=iyear*10000+01*100+01 december31=iyear*10000+12*100+31 jul1=julday(january1) jul2=julday(december31) itt=0 IF (jul1 < julday(INT(timetag(1))) ) THEN ! need to read previous year WRITE(csstrp ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear-1,'.SST.'//TRIM(config)//'.dimg' irecl=isdirect(csstrp) ; OPEN( numsstp,FILE=csstrp, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numsstp,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntp ALLOCATE (timetagp (ntp) ,timetab(ntp)) READ(numsstp,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntp, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & (timetab(jt), jt=1,ntp) timetagp=timetab DEALLOCATE(timetab) IF (timetagp (1) < 10000 ) THEN timetagp(:)=timetagp(:)+20000000. ELSE timetagp(:)=timetagp(:)+19000000. ENDIF IF ( julday(INT(timetagp (ntp))) <= jul1 ) THEN !read ntp sst as 1 data itt = itt +1 READ(numsstp,REC=ntp+1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday( INT(timetagp(ntp)) ) ELSE IF ( julday(INT(timetagp (ntp-1)) ) <= jul1 ) THEN itt = itt +1 READ(numsstp,REC=ntp) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT(timetagp(ntp-1)) ) ELSE IF ( julday(INT(timetagp (ntp-2) )) <= jul1 ) THEN itt = itt +1 READ(numsstp,REC=ntp-1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT(timetagp(ntp-2)) ) ELSE PRINT *,' Something is wrong in previous file SST ' ; STOP ENDIF ENDIF DO jt=1,nt itt = itt +1 READ(numsst,REC=jt+1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT(timetag(jt)) ) END DO IF ( jul2 > julday(INT(timetag(nt))) ) THEN ! need to read next year IF ( iyear == 2000 ) THEN ! persistance ... itt=itt+1 ; v2d(:,:,itt)= v2d(:,:,itt-1) ; itime(itt)=jul2 ELSE WRITE(csstrn ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear+1,'.SST.'//TRIM(config)//'.dimg' irecl=isdirect(csstrn) ; OPEN( numsstn,FILE=csstrn, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numsstn,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntn ALLOCATE (timetagn (ntn) ,timetab(ntn)) READ(numsstn,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntn, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & (timetab(jt), jt=1,ntn) timetagn=timetab DEALLOCATE( timetab) IF (timetagn (1) < 10000 ) THEN timetagn(:)=INT(timetagn(:))+20000000 ELSE timetagn(:)=INT(timetagn(:))+19000000 ENDIF IF ( julday(INT(timetagn (1) )) >= jul2 ) THEN !read 1 sst as 1 data itt = itt +1 READ(numsstn,REC=2) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT(timetagn(1)) ) ELSE IF ( julday(INT(timetagn (2)) ) >= jul2 ) THEN itt = itt +1 READ(numsstn,REC=3) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT( timetagn(2)) ) ELSE IF ( julday(INT(timetagn (3))) >= jul2 ) THEN itt = itt +1 READ(numsstn,REC=4) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo) itime(itt)=julday(INT(timetagn(3)) ) ELSE PRINT *,' Something is wrong in next file SST ' ; STOP ENDIF ENDIF ENDIF ntime=itt icurrday=0 ii1=1 ; ii2 = 2 ; id1=itime(ii1) ; id2=itime(ii2) DO jul = jul1, jul2 icurrday=icurrday + 1 IF ( jul > id2 ) THEN ii1=ii1+1 ; ii2=ii2+1 ; id1=itime(ii1) ; id2=itime(ii2) ENDIF v2daily(:,:)=FLOAT((jul - id1 ))/(FLOAT(id2-id1))*(v2d(:,:,ii2) - v2d(:,:,ii1) ) + v2d(:,:,ii1) istatus = putvar(ncoutsst,id_varoutsst(1),v2daily(:,:),icurrday,npiglo,npjglo) END DO ! update time_counter ALLOCATE( timetab (icurrday) ) timetab=(/(jt,jt=1,icurrday)/) istatus=putvar1d(ncoutsst,timetab,icurrday,'T') ! close fluxes files istatus=closeout(ncoutsst) istatus=closeout(ncoutsst) DEALLOCATE (v2d , dep, z2d ) CONTAINS INTEGER FUNCTION isdirect(clname) !!! FUNCTION ISDIRECT !!! ***************** !!! !!! PURPOSE : This integer function returns the record length if clname !!! is a valid dimg file, it returns 0 either. !!! !!! METHOD : Open the file and look for the key characters (@!01) for !!! identification. !!! !!! AUTHOR : Jean-Marc Molines (Apr. 1998) !!! ------------------------------------------------------------------------- IMPLICIT NONE CHARACTER(LEN=*), INTENT(in) :: clname CHARACTER(LEN=4) :: cver CHARACTER(LEN=256) :: clheader ! INTEGER :: irecl ! OPEN(100,FILE=clname, FORM ='UNFORMATTED', ACCESS ='DIRECT', RECL =88) READ(100,REC=1) cver ,clheader,irecl CLOSE(100) ! IF (cver == '@!01' ) THEN isdirect=irecl ELSE isdirect=0 END IF ! END FUNCTION isdirect FUNCTION julday(kdastp) !! ------------------------------------------------------------------ !! *** FUNCTION JULDAY *** !! !! Purpose: This routine returns the julian day number which begins at noon !! of the calendar date specified by month kmm, day kid, and year kiyyy. !! positive year signifies a.d.; negative, b.c. (remember that the !! year after 1 b.c. was 1 a.d.) !! routine handles changeover to gregorian calendar on oct. 15, 1582. !! !! Method: This routine comes directly from the Numerical Recipe Book, !! press et al., numerical recipes, cambridge univ. press, 1986. !! !! Arguments: !! kdastp : OPA date yyyymmdd (instead of kmm kid kiyyy) !! kmm : input, corresponding month !! kid : input, corresponding day !! kiyyy : input, corresponding year, positive IF a.d, negative b.c. !! !! !! history !! 1998: J.M. Molines for the Doctor form. !! 2007 : J.M. Molines in F90 !! ----------------------------------------------------------------- ! * Declarations ! INTEGER :: julday, kiyyy,kid,kmm INTEGER, INTENT(in) ::kdastp ! * Local INTEGER, PARAMETER ::jpgreg=15+31*(10+12*1582) INTEGER :: iy, im, ia ! ... Year 0 never existed ... kiyyy=kdastp/10000 kmm=(kdastp - kiyyy*10000)/100 kid= kdastp - kiyyy*10000 - kmm*100 IF (kiyyy == 0) STOP 101 ! IF (kiyyy < 0) kiyyy = kiyyy + 1 IF (kmm > 2) THEN iy = kiyyy im = kmm + 1 ELSE iy = kiyyy - 1 im = kmm + 13 END IF ! julday = INT(365.25*iy) + INT(30.6001*im) + kid + 1720995 IF (kid+31*(kmm+12*kiyyy).GE.jpgreg) THEN ia = INT(0.01*iy) julday = julday + 2 - ia + INT(0.25*ia) END IF END FUNCTION JULDAY END PROGRAM cdfflxconv cdftools-3.0/cdfmppini.f900000644000175000017500000004522012241227304016614 0ustar amckinstryamckinstryPROGRAM cdfmppini !!====================================================================== !! *** PROGRAM cdfmppini *** !!===================================================================== !! ** Purpose : off line domain decomposition using mesh_hgr !! !! ** Method : just an incapsulation of mpp_ini from NEMO !! !! History : 2.1 : 05/2010 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! mpp_init2 Nemo routine for mpp initialisation !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE ! REM : some of the doctor rules are not followed because we want to use ! the mpp_init2 routine almost out of the box, thus we need to define ! variables which are parameters in NEMO, with the same name (jp..) INTEGER(KIND=4), PARAMETER :: wp=8 ! working precision INTEGER(KIND=4) :: jpni, jpnj, jpnij INTEGER(KIND=4) :: jpreci=1 , jprecj=1 INTEGER(KIND=4) :: jpi, jpj, jpiglo, jpjglo INTEGER(KIND=4) :: jperio=6, jv INTEGER(KIND=4) :: narg, iargc, numout=6 INTEGER(KIND=4) :: ijarg, ireq INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: imask INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nimppt, njmppt, nlcit, nlcjt INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nldit, nldjt, nleit, nlejt INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nbondi, nbondj, icount CHARACTER(LEN=80) :: cf_msk='m' CHARACTER(LEN=80) :: cf_out='mppini.txt' CHARACTER(LEN=80) :: cv_in CHARACTER(LEN=80) :: cldum LOGICAL :: lwp=.true. !---------------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg < 2 ) THEN PRINT *,' usage : cdfmppini jpni jpnj [m/b/z] [-jperio jperio]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Perform the mpp initialisation with NEMO routine mpp_init2 and' PRINT *,' give some statistics about the domains. Save the layout on a ' PRINT *,' text file.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' jpni : number of domains in the i direction.' PRINT *,' jpnj : number of domains in the j direction.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [m/b/z] : use one of these letter to choose the land/sea mask.' PRINT *,' m : take mask from ',TRIM(cn_fmsk),' (tmask) [ default ]' PRINT *,' b : take mask from ',TRIM(cn_fbathymet),' (Bathymetry)' PRINT *,' z : take mask from ',TRIM(cn_fzgr),' (mbathy)' PRINT *,' Default is ',TRIM(cf_msk) PRINT *,' [-jperio jperio ] : specify jperio. ' PRINT '(a,i2)',' default value is ', jperio PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' one of ',TRIM(cn_fmsk),', ',TRIM(cn_fbathymet),' or ',TRIM(cn_fzgr),' according to option' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' - Standard output' PRINT *,' - ASCII file ', TRIM(cf_out) STOP ENDIF cf_msk = cn_fmsk ; cv_in='tmask' ijarg=1 ; ireq=0 DO WHILE ( ijarg <= narg ) CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE( 'm' ) ; cf_msk=cn_fmsk ; cv_in='tmask' CASE( 'b' ) ; cf_msk=cn_fbathymet ; cv_in='Bathymetry' CASE( 'z' ) ; cf_msk=cn_fzgr ; cv_in='mbathy' CASE( '-jperio' ) CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) jperio CASE DEFAULT ireq = ireq+1 SELECT CASE ( ireq ) CASE ( 1 ) ; READ(cldum,*) jpni CASE ( 2 ) ; READ(cldum,*) jpnj CASE DEFAULT ; PRINT *,' Too many arguments.'; STOP END SELECT END SELECT END DO IF ( chkfile (cf_msk )) STOP ! missing file jpiglo = getdim (cf_msk,cn_x) jpjglo = getdim (cf_msk,cn_y) jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ALLOCATE ( imask(jpiglo,jpjglo) ) imask(:,:) = getvar(cf_msk, cv_in, 1, jpiglo, jpjglo) WHERE (imask <= 0 ) imask = 0 WHERE (imask > 0 ) imask = 1 CALL mpp_init2 PRINT *, 'JPIGLO= ', jpiglo PRINT *, 'JPJGLO= ', jpjglo PRINT *, 'JPI = ', jpi PRINT *, 'JPJ = ', jpj PRINT *, 'JPNI = ', jpni PRINT *, 'JPNJ = ', jpnj PRINT *, 'JPNIJ = ', jpnij PRINT *, 'NBONDI between : ',MINVAL(nbondi),' AND ', MAXVAL(nbondi) PRINT *, 'NBONDJ between : ',MINVAL(nbondj),' AND ', MAXVAL(nbondj) PRINT *,' Accounting ...' ALLOCATE (icount(jpnij)) DO jv=-1,2 icount=0 WHERE(nbondi == jv ) icount=1 PRINT *,' NBONDI = ', jv,' : ', sum(icount) ENDDO DO jv=-1,2 icount=0 WHERE(nbondj == jv ) icount=1 PRINT *,' NBONDJ = ', jv,' : ', sum(icount) ENDDO CONTAINS SUBROUTINE mpp_init2 !!---------------------------------------------------------------------- !! *** ROUTINE mpp_init2 *** !! !! * Purpose : Lay out the global domain over processors. !! FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED !! FOR DEFINING BETTER CUTTING OUT. !! This routine is used with a the bathymetry file. !! In this version, the land processors are avoided and the adress !! processor (nproc, narea,noea, ...) are calculated again. !! The jpnij parameter can be lesser than jpni x jpnj !! and this jpnij parameter must be calculated before with an !! algoritmic preprocessing program. !! !! ** Method : Global domain is distributed in smaller local domains. !! Periodic condition is a function of the local domain position !! (global boundary or neighbouring domain) and of the global !! periodic !! Type : jperio global periodic condition !! nperio local periodic condition !! !! ** Action : nimpp : longitudinal index !! njmpp : latitudinal index !! nperio : lateral condition type !! narea : number for local area !! nlci : first dimension !! nlcj : second dimension !! nproc : number for local processor !! noea : number for local neighboring processor !! nowe : number for local neighboring processor !! noso : number for local neighboring processor !! nono : number for local neighboring processor !! !! History : !! ! 94-11 (M. Guyon) Original code !! ! 95-04 (J. Escobar, M. Imbard) !! ! 98-02 (M. Guyon) FETI method !! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions !! 9.0 ! 04-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 !!---------------------------------------------------------------------- !! INTEGER(KIND=4) :: ji, jj, jn, jproc, jarea ! dummy loop indices INTEGER(KIND=4) :: inum = 99 ! temporary logical unit INTEGER(KIND=4) :: & ii, ij, ifreq, il1, il2, & ! temporary integers icont, ili, ilj, & ! " " isurf, ijm1, imil, & ! " " iino, ijno, iiso, ijso, & ! " " iiea, ijea, iiwe, ijwe, & ! " " iresti, irestj, iproc ! " " INTEGER(KIND=4) :: nreci, nrecj, nperio INTEGER(KIND=4), DIMENSION(10000) :: iint, ijnt INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: iin, ijn INTEGER(KIND=4), DIMENSION(jpni,jpnj) :: & iimppt, ijmppt, ilci , ilcj , & ! temporary workspace ipproc, ibondj, ibondi, & ! " " ilei , ilej , ildi , ildj , & ! " " ioea , iowe , ioso , iono ! " " REAL(wp) :: zidom , zjdom ! temporary scalars INTEGER(KIND=4) :: nono, noso, noea, nowe INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ii_nono, ii_noso, ii_noea, ii_nowe ! 0. initialisation ! ----------------- ! 1. Dimension arrays for subdomains ! ----------------------------------- ! Computation of local domain sizes ilci() ilcj() ! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo ! The subdomains are squares leeser than or equal to the global ! dimensions divided by the number of processors minus the overlap ! array. nreci=2*jpreci nrecj=2*jprecj iresti = 1 + MOD( jpiglo - nreci -1 , jpni ) irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj ) ilci(1:iresti ,:) = jpi ilci(iresti+1:jpni ,:) = jpi-1 ilcj(:, 1:irestj) = jpj ilcj(:, irestj+1:jpnj) = jpj-1 IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains' IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------' IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj zidom = nreci + sum(ilci(:,1) - nreci ) IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo zjdom = nrecj + sum(ilcj(1,:) - nrecj ) IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo IF(lwp) WRITE(numout,*) ! 2. Index arrays for subdomains ! ------------------------------- iimppt(:,:) = 1 ijmppt(:,:) = 1 ipproc(:,:) = -1 IF( jpni > 1 )THEN DO jj = 1, jpnj DO ji = 2, jpni iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci END DO END DO ENDIF IF( jpnj > 1 )THEN DO jj = 2, jpnj DO ji = 1, jpni ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj END DO END DO ENDIF ! 3. Subdomain description in the Regular Case ! -------------------------------------------- nperio = 0 icont = -1 DO jarea = 1, jpni*jpnj ii = 1 + MOD(jarea-1,jpni) ij = 1 + (jarea-1)/jpni ili = ilci(ii,ij) ilj = ilcj(ii,ij) ibondj(ii,ij) = -1 IF( jarea > jpni ) ibondj(ii,ij) = 0 IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1 IF( jpnj == 1 ) ibondj(ii,ij) = 2 ibondi(ii,ij) = 0 IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1 IF( MOD(jarea,jpni) == 0 ) ibondi(ii,ij) = 1 IF( jpni == 1 ) ibondi(ii,ij) = 2 ! 2.4 Subdomain neighbors iproc = jarea - 1 ioso(ii,ij) = iproc - jpni iowe(ii,ij) = iproc - 1 ioea(ii,ij) = iproc + 1 iono(ii,ij) = iproc + jpni ildi(ii,ij) = 1 + jpreci ilei(ii,ij) = ili -jpreci IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1 IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili ildj(ii,ij) = 1 + jprecj ilej(ii,ij) = ilj - jprecj IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1 IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj ! warning ii*ij (zone) /= nproc (processors)! IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN IF( jpni == 1 )THEN ibondi(ii,ij) = 2 nperio = 1 ELSE ibondi(ii,ij) = 0 ENDIF IF( MOD(jarea,jpni) == 0 ) THEN ioea(ii,ij) = iproc - (jpni-1) ENDIF IF( MOD(jarea,jpni) == 1 ) THEN iowe(ii,ij) = iproc + jpni - 1 ENDIF ENDIF isurf = 0 DO jj = 1+jprecj, ilj-jprecj DO ji = 1+jpreci, ili-jpreci IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1 END DO END DO IF(isurf /= 0) THEN icont = icont + 1 ipproc(ii,ij) = icont iint(icont+1) = ii ijnt(icont+1) = ij ENDIF END DO jpnij=icont+1 ALLOCATE(iin(jpnij),ijn(jpnij),nimppt(jpnij), njmppt(jpnij), nlcit(jpnij), nlcjt(jpnij) ) ALLOCATE(nldit(jpnij), nldjt(jpnij) ) ALLOCATE(nleit(jpnij), nlejt(jpnij) ) ALLOCATE(nbondi(jpnij), nbondj(jpnij) ) ALLOCATE(ii_nono(jpnij), ii_noso(jpnij), ii_noea(jpnij) , ii_nowe(jpnij) ) iin(:)=iint(1:jpnij) ijn(:)=ijnt(1:jpnij) ! Control ! 4. Subdomain print ! ------------------ IF(lwp) THEN ifreq = 4 il1 = 1 DO jn = 1,(jpni-1)/ifreq+1 il2 = MIN(jpni,il1+ifreq-1) WRITE(numout,*) WRITE(numout,9400) ('***',ji=il1,il2-1) DO jj = jpnj, 1, -1 WRITE(numout,9403) (' ',ji=il1,il2-1) WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2) WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2) WRITE(numout,9403) (' ',ji=il1,il2-1) WRITE(numout,9400) ('***',ji=il1,il2-1) END DO WRITE(numout,9401) (ji,ji=il1,il2) il1 = il1+ifreq END DO 9400 FORMAT(' ***',20('*************',a3)) 9403 FORMAT(' * ',20(' * ',a3)) 9401 FORMAT(' ',20(' ',i3,' ')) 9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * ')) 9404 FORMAT(' * ',20(' ',i4,' * ')) ENDIF ! 5. neighbour treatment ! ---------------------- DO jarea = 1, jpni*jpnj iproc = jarea-1 ii = 1 + MOD(jarea-1,jpni) ij = 1 + (jarea-1)/jpni IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0 & .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN iino = 1 + MOD(iono(ii,ij),jpni) ijno = 1 + (iono(ii,ij))/jpni IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2 IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1 ENDIF IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0 & .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN iiso = 1 + MOD(ioso(ii,ij),jpni) ijso = 1 + (ioso(ii,ij))/jpni IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2 IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1 ENDIF IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0 & .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN iiea = 1 + MOD(ioea(ii,ij),jpni) ijea = 1 + (ioea(ii,ij))/jpni IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2 IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1 ENDIF IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0 & .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN iiwe = 1 + MOD(iowe(ii,ij),jpni) ijwe = 1 + (iowe(ii,ij))/jpni IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2 IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1 ENDIF END DO ! just to save nono etc for all proc DO jarea = 1, jpnij ii = iin(jarea) ij = ijn(jarea) IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN iiso = 1 + MOD(ioso(ii,ij),jpni) ijso = 1 + (ioso(ii,ij))/jpni noso = ipproc(iiso,ijso) ii_noso(jarea)= noso ENDIF IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN iiwe = 1 + MOD(iowe(ii,ij),jpni) ijwe = 1 + (iowe(ii,ij))/jpni nowe = ipproc(iiwe,ijwe) ii_nowe(jarea)= nowe ENDIF IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN iiea = 1 + MOD(ioea(ii,ij),jpni) ijea = 1 + (ioea(ii,ij))/jpni noea = ipproc(iiea,ijea) ii_noea(jarea)= noea ENDIF IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN iino = 1 + MOD(iono(ii,ij),jpni) ijno = 1 + (iono(ii,ij))/jpni nono = ipproc(iino,ijno) ii_nono(jarea)= nono ENDIF END DO ! 6. Change processor name ! ------------------------ DO jproc = 1, jpnij ii = iin(jproc) ij = ijn(jproc) nimppt(jproc) = iimppt(ii,ij) njmppt(jproc) = ijmppt(ii,ij) nlcit(jproc) = ilci(ii,ij) nlcjt(jproc) = ilcj(ii,ij) nldit(jproc) = ildi(ii,ij) nldjt(jproc) = ildj(ii,ij) nleit(jproc) = ilei(ii,ij) nlejt(jproc) = ilej(ii,ij) END DO ! Save processor layout in ascii file IF (lwp) THEN OPEN (inum, FILE=cf_out, FORM='FORMATTED', RECL=255) WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpiglo,jpjglo WRITE(inum,'(a)') 'RANK nlci nlcj nldi nldj nlei nlej nimpp njmpp nono noso nowe noea nbondi nbondj ' DO jproc = 1, jpnij ii = iin(jproc) ij = ijn(jproc) nbondi(jproc) = ibondi(ii,ij) nbondj(jproc) = ibondj(ii,ij) WRITE(inum,'(15i5)') jproc-1, nlcit(jproc), nlcjt(jproc), & nldit(jproc), nldjt(jproc), & nleit(jproc), nlejt(jproc), & nimppt(jproc), njmppt(jproc),& ii_nono(jproc), ii_noso(jproc), ii_nowe(jproc), ii_noea(jproc) ,& nbondi(jproc), nbondj(jproc) END DO CLOSE(inum) END IF END SUBROUTINE mpp_init2 END PROGRAM cdfmppini cdftools-3.0/cdfbottom.f900000644000175000017500000001676012241227304016633 0ustar amckinstryamckinstryPROGRAM cdfbottom !!====================================================================== !! *** PROGRAM cdfbottom *** !!===================================================================== !! ** Purpose : Extract the bottom value for the 3D variables !! which are in the input file. Store the results !! on a similar file, with the same variable name. !! !! ** Method: Uses the corresponding mask file to determine the bottom. !! If no mask found it assumes that 0.0000 values corresponds !! to masked values. !! !! History : 2.1 : 11/2005 : J.M. Molines : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk , jv, jvar, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! argument on line INTEGER(KIND=4) :: npiglo, npjglo, npk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! number of variables in the input file INTEGER(KIND=4) :: ncout ! ncid of output ncdf file INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, ipko ! outptut variables : number of levels, INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var, id_varout ! ncdf varid's REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zfield ! Array to read a layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zbot ! array to store the bottom value REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter of the file CHARACTER(LEN=256) :: cf_out='bottom.nc' ! output file name CHARACTER(LEN=256) :: cf_in, cldum ! working strings CHARACTER(LEN=256) :: cv_dep ! true name of dep dimension CHARACTER(LEN=5) :: cv_msk=' ' ! name of the mask variable CHARACTER(LEN=1) :: ctype=' ' ! point type (T U V ..) CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for variable attribute !!-------------------------------------------------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfbottom IN-file [ T | U | V | F]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Create a 2D file with bottom most values for all the variables' PRINT *,' which are in the input 3D file.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : input netcdf 3D file.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ T | U | V | F] : specify the type of grid point on the C-grid' PRINT *,' if not given, assume that land points are values with 0.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fmsk),' file is required if the grid point is specified' PRINT *,' or if the land value is not 0.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : same names than input file, long_name attribute is' PRINT *,' prefixed by Bottom ' STOP ENDIF ijarg = 1 CALL getarg (ijarg, cf_in) ; ijarg = ijarg + 1 IF ( chkfile(cf_in) ) STOP ! missing files npiglo = getdim (cf_in,cn_x) npjglo = getdim (cf_in,cn_y) npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr) ! defautl cn_z is depth IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z', cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'sigma', cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'nav_lev', cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF ENDIF npt = getdim (cf_in,cn_t) ALLOCATE (zfield(npiglo,npjglo), zbot(npiglo,npjglo), zmask(npiglo,npjglo)) ALLOCATE (tim(npt) ) DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, ctype ) ; ijarg = ijarg + 1 IF ( chkfile (cn_fmsk ) ) STOP ! missing mask file SELECT CASE ( ctype ) CASE ( 'T', 't', 'S', 's' ) cv_msk='tmask' CASE ( 'U', 'u' ) cv_msk='umask' CASE ( 'V', 'v' ) cv_msk='vmask' CASE ( 'F', 'f' ) cv_msk='fmask' PRINT *, 'Be carefull with fmask ... !!!' CASE DEFAULT PRINT *, ' ERROR : This type of point ', ctype,' is not known !' STOP END SELECT END DO ! look for the number of variables in the input file nvars = getnvar(cf_in) PRINT *,' nvars =', nvars ALLOCATE (cv_names(nvars) ,stypvar(nvars)) ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars), ipko(nvars) ) cv_names(:)=getvarname(cf_in,nvars,stypvar) id_var(:) = (/(jv, jv=1,nvars)/) ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk (cf_in,nvars,cdep=cv_dep) ipko(:) = 1 ! all variables output are 2D WHERE( ipk <= 1 ) cv_names='none' DO jvar=1,nvars stypvar(jvar)%cname = cv_names(jvar) stypvar(jvar)%caxis = 'TYX' cldum=stypvar(jvar)%clong_name stypvar(jvar)%clong_name = 'Bottom '//TRIM(cldum) END DO ! create output fileset ! create output file taking the sizes in cf_in ncout = create (cf_out, cf_in , npiglo, npjglo, 1 ) ! 1 level file ierr = createvar (ncout , stypvar, nvars , ipko , id_varout ) ierr = putheadervar(ncout , cf_in , npiglo, npjglo, 1 ) DO jvar = 1,nvars zfield = 0. zbot = 0. IF (cv_names(jvar) == 'none' ) THEN ! skip these variable ELSE PRINT *, ' WORKING with ', TRIM( cv_names(jvar) ), ipk(jvar) DO jt = 1, npt DO jk = 1, ipk(jvar) zmask = 1. zfield(:,:) = getvar(cf_in, cv_names(jvar), jk, npiglo, npjglo, ktime=jt) IF ( cv_msk == ' ' ) THEN WHERE ( zfield /= 0 ) zbot = zfield END WHERE ELSE zmask(:,:) = getvar(cn_fmsk, cv_msk, jk, npiglo, npjglo) WHERE ( zmask /= 0 ) zbot = zfield END WHERE ENDIF END DO ierr = putvar(ncout, id_varout(jvar), zbot, 1, npiglo, npjglo, ktime=jt) ENDDO ENDIF END DO tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdfbottom cdftools-3.0/cdfpolymask.f900000644000175000017500000001574412241227304017167 0ustar amckinstryamckinstryPROGRAM cdfpolymask !!====================================================================== !! *** PROGRAM cdfpolymask *** !!===================================================================== !! ** Purpose : Create a nc file with 1 into subareas defined as a !! polygone. !! !! ** Method : Use polylib routine (from finite element mesh generator !! Trigrid) !! Read vertices of polygone in an ascii file an produce a !! resulting file the same shape as file givent in argumment !! (used only for size and header ) !! !! History : 2.1 : 07/2007 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! polymask !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! output var levels and varid REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rpmask ! mask array REAL(KIND=4), DIMENSION(1) :: tim ! dummy time counter CHARACTER(LEN=256) :: cf_ref ! name of reference file CHARACTER(LEN=256) :: cf_poly ! name of ascii poly file CHARACTER(LEN=256) :: cf_out='polymask.nc' ! output file name CHARACTER(LEN=256) :: cldum ! dummy arguments TYPE(variable), DIMENSION(1) :: stypvar ! output attribute LOGICAL :: lreverse=.FALSE. ! reverse flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg < 2 ) THEN PRINT *,' usage : cdfpolymask POLY-file REF-file [ -r]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Create a maskfile with polymask variable having 1' PRINT *,' inside the polygon, and 0 outside. Option -r revert' PRINT *,' the behaviour (0 inside, 1 outside).' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' POLY-file : input ASCII file describing a polyline in I J grid.' PRINT *,' This file is structured by block, one block corresponding ' PRINT *,' to a polygon:' PRINT *,' 1rst line of the block gives a polygon name' PRINT *,' 2nd line gives the number of vertices (nvert) and a dummy 0' PRINT *,' the block finishes with nvert pairs of (I,J) describing ' PRINT *,' the polygon vertices.' PRINT *,' REF-file : reference netcdf file for header of polymask file.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -r ] : revert option. When used, 0 is inside the polygon,' PRINT *,' 1 outside.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : polymask' STOP ENDIF ijarg = 1 CALL getarg (ijarg, cf_poly) ; ijarg = ijarg + 1 CALL getarg (ijarg, cf_ref ) ; ijarg = ijarg + 1 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-r' ) ; lreverse = .TRUE. CASE DEFAULT PRINT *,' unknown optional arugment (', TRIM(cldum),' )' PRINT *,' in actual version only -r -- for reverse -- is recognized ' STOP END SELECT END DO IF ( chkfile(cf_poly) .OR. chkfile(cf_ref) ) STOP ! missing files npiglo = getdim (cf_ref, cn_x) npjglo = getdim (cf_ref, cn_y) npk = 1 ipk(1) = 1 stypvar(1)%cname = 'polymask' stypvar(1)%cunits = '1/0' stypvar(1)%rmissing_value = 999. stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 1. stypvar(1)%clong_name = 'Polymask' stypvar(1)%cshort_name = 'polymask' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo ALLOCATE( rpmask(npiglo,npjglo) ) ncout = create (cf_out, cf_ref, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_ref, npiglo, npjglo, npk ) CALL polymask(cf_poly, rpmask) ierr = putvar(ncout, id_varout(1), rpmask, 1, npiglo, npjglo) tim(:) = 0. ierr = putvar1d(ncout, tim, 1, 'T') ierr = closeout(ncout) CONTAINS SUBROUTINE polymask( cdpoly, pmask) !!--------------------------------------------------------------------- !! *** ROUTINE polymask *** !! !! ** Purpose : Build polymask from asci polygon file !! !! ** Method : Use Poly routines and functions from modpoly module !! !!---------------------------------------------------------------------- USE modpoly CHARACTER(LEN=*), INTENT(in ) :: cdpoly ! polygon file name REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: pmask ! mask array INTEGER(KIND=4) :: ji, jj, jjpoly ! dummy loop index INTEGER(KIND=4) :: infront ! number of REAL(KIND=4) :: zin, zout ! CHARACTER(LEN=256), DIMENSION(jpolys) :: cl_area ! name of the areas LOGICAL :: ll_in ! flag for in/out poly !!---------------------------------------------------------------------- IF ( lreverse ) THEN zin = 0. ; zout = 1. ELSE zin = 1. ; zout = 0. ENDIF pmask(:,:) = zout CALL ReadPoly(cdpoly, infront, cl_area) DO jjpoly=1, infront CALL PrepPoly(jjpoly) DO jj=npjglo, 1, -1 DO ji=1,npiglo CALL InPoly(jjpoly,float(ji), float(jj), ll_in) IF (ll_in ) pmask(ji,jj) = zin ENDDO ENDDO ENDDO END SUBROUTINE polymask END PROGRAM cdfpolymask cdftools-3.0/cdfcoloc.f900000644000175000017500000006425112241227304016424 0ustar amckinstryamckinstryPROGRAM cdfcoloc !!====================================================================== !! *** PROGRAM cdfcoloc *** !!===================================================================== !! ** Purpose : Colocates model values on data points. The 3D or 2D !! position of the points are already in the corresponding !! weight file. (Bilinear interpolation). !! !! ** Method : Use the weight file provided as argument and computed !! with cdfweight !! !! History : 2.1 : 05/2007 : J.M. Molines : Original code !! 3.0 : 03/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! subroutine rotation : perform vector rotation to get geographical !! vector components !! subroutine getfld : decipher the field list given on the command line !! subroutine help_message : list available fields !! function interp : perform bilinear interpolation !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4), PARAMETER :: jptyp=16 ! number of available types INTEGER(KIND=4) :: ntyp ! number of type to produce ( look to ctype) INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index INTEGER(KIND=4) :: jid, jtyp ! dummy loop index INTEGER(KIND=4) :: idum ! dummy integer INTEGER(KIND=4) :: narg, iargc, iarg INTEGER(KIND=4) :: nid = 0 ! mooring counter initialize to 0 INTEGER(KIND=4) :: npiglo, npjglo ! grid size of the model INTEGER(KIND=4) :: npk ! grid size of the model INTEGER(KIND=4) :: npkv ! vertical dimension of the target variable ! ! (either 1 (2D) or npk (3D) INTEGER(KIND=4) :: numbin = 20 ! logical unit for I/O files other than NetCdf INTEGER(KIND=4) :: numout = 30 ! logical unit for I/O files other than NetCdf INTEGER(KIND=4) :: numskip = 31 ! logical unit for I/O files other than NetCdf ! variables in the weight file, 1 record per mooring INTEGER(KIND=4) :: id, idep INTEGER(KIND=4) :: nimin, njmin ! location of horizontal nearest point INTEGER(KIND=4) :: nkmin ! location vertical above target. INTEGER(KIND=4) :: nquadran ! grid sector from 1 to 4 (clockwise, 1=NE) ! ! in which target point is located with respect ! ! to nearest point. INTEGER(KIND=4) :: nSx, nSy ! index of the Sx and Sy for rotation INTEGER(KIND=4) :: nU, nV ! index of the U and V for rotation INTEGER(KIND=2), DIMENSION(:,:,:), ALLOCATABLE :: mask ! 3D working mask REAL(KIND=4) :: xmin, ymin, rdep REAL(KIND=4) :: vup, vdo, wup, wdo ! Working variables REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d ! 3D ! working variable (unavoidable) REAL(KIND=8) :: dxmin, dymin REAL(KIND=8) :: dalpha, dbeta, dgama REAL(KIND=8) :: dhN, dscale REAL(KIND=8) :: dlmin REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: d2d, de ! 2D working variable and horizontal metric REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dinterp ! result array (nid,jptyp) ! file name CHARACTER(LEN=256) :: cf_out CHARACTER(LEN=256) :: cf_skip CHARACTER(LEN=256) :: cf_weight CHARACTER(LEN=256) :: cf_weight_root CHARACTER(LEN=256) :: cf_gridt = 'none' CHARACTER(LEN=256) :: cf_gridtrc = 'none' CHARACTER(LEN=256) :: cf_diag = 'none' CHARACTER(LEN=256) :: cf_gridu = 'none' CHARACTER(LEN=256) :: cf_gridv = 'none' CHARACTER(LEN=256) :: cf_bathy = 'none' CHARACTER(LEN=256) :: cf_in CHARACTER(LEN=256) :: cf_weight_t CHARACTER(LEN=256) :: cf_weight_u CHARACTER(LEN=256) :: cf_weight_v CHARACTER(LEN=256) :: cctyp, cvar, cvmask ! current mooring CHARACTER(LEN=256) :: cldum ! dummy char variable for line input CHARACTER(LEN=256) :: ctmplst0 ! current list of type: separated by , CHARACTER(LEN=256) :: cformat ! ASCII format adapted to ntyp CHARACTER(LEN=12), DIMENSION(jptyp) :: ctype ! all possible type defined there CHARACTER(LEN=12), DIMENSION(:),ALLOCATABLE :: cltype ! actual type used given as argument LOGICAL :: llchk !!---------------------------------------------------------------------- CALL ReadCdfNames() ! exhaustive list of supported field ctype = (/'T ','S ','SSH ','CFCINV ','CFCCONC ','PENDEP ', & & 'MXL ','MXL01 ','MXLT02 ','ISOTHICK','U ','V ', & & 'Sx ','Sy ','H ','etopo '/) ctmplst0 = 'U,V,Sx,Sy,H' ! default list !! Read command line and output usage message if not compliant. narg= iargc() IF ( narg < 1 ) THEN PRINT *,' usage : cdfcoloc -w root_weight -t gridT -trc TRC_file ...' PRINT *,' ... -u gridU -v gridV [-l field list ] [-h]' PRINT *,' -w root_weight : specify the root name of the weight files' PRINT *,' _T.bin, _U.bin, or _V.bin will be appended ' PRINT *,' to name if necessary.' PRINT *,' -t gridT file : name of gridT model file' PRINT *,' -trc TRC file : name of gridT model file' PRINT *,' -d diag file : name of specific diagnostic file ' PRINT *,' -u gridU file : name of gridU model file' PRINT *,' -v gridV file : name of gridV model file' PRINT *,' -b bathy file : name of etopo like bathymetric file' PRINT *,' -l field list : list of fields to be colocated, separated by '',''' PRINT *,' Default list is :',TRIM(ctmplst0) PRINT *,' -h : Give the details of available field to colocate.' PRINT *,' Return a column ascii file id dep fields()' PRINT *, TRIM(cn_fmsk),' is required in local directory' PRINT *, TRIM(cn_fcoo),',',TRIM(cn_fzgr),' are also required for slope computation' STOP ENDIF iarg = 1 DO WHILE ( iarg <= narg ) CALL getarg ( iarg, cldum ) ; iarg = iarg + 1 SELECT CASE ( cldum ) CASE ('-w' ) ; CALL getarg ( iarg, cf_weight_root ) ; iarg = iarg + 1 CASE ('-t' ) ; CALL getarg ( iarg, cf_gridt ) ; iarg = iarg + 1 CASE ('-trc' ) ; CALL getarg ( iarg, cf_gridtrc ) ; iarg = iarg + 1 CASE ('-d' ) ; CALL getarg ( iarg, cf_diag ) ; iarg = iarg + 1 CASE ('-u' ) ; CALL getarg ( iarg, cf_gridu ) ; iarg = iarg + 1 CASE ('-v' ) ; CALL getarg ( iarg, cf_gridv ) ; iarg = iarg + 1 CASE ('-b' ) ; CALL getarg ( iarg, cf_bathy ) ; iarg = iarg + 1 CASE ('-l' ) ; CALL getarg ( iarg, ctmplst0 ) ; iarg = iarg + 1 CASE ('-h' ) ; CALL help_message CASE DEFAULT ; PRINT *,TRIM(cldum),' : option not available.' ; STOP END SELECT ENDDO ! intepret ctmplst0 to set up cltype list, ntype and build cf_out file name CALL getfld( ) idum = INDEX(TRIM(cf_out),'.') - 1 IF ( idum == -1 ) THEN idum = LEN_TRIM(cf_out) ENDIF cf_skip = cf_out(1:idum)//'_skip.txt' WRITE(cf_weight_t,'(a,a,".bin")') TRIM(cf_weight_root), '_T' WRITE(cf_weight_u,'(a,a,".bin")') TRIM(cf_weight_root), '_U' WRITE(cf_weight_v,'(a,a,".bin")') TRIM(cf_weight_root), '_V' ! Check if required files are available llchk = .FALSE. IF ( cf_bathy /= 'none' ) THEN ! dealing with special case of etopo file llchk = llchk .OR. chkfile(cf_bathy ) IF (llchk ) STOP ! missing files npiglo = getdim (cf_bathy,'lon') npjglo = getdim (cf_bathy,'lat') npk = 1 ELSE llchk = llchk .OR. chkfile(cn_fmsk ) IF (llchk ) STOP ! missing files npiglo = getdim (cn_fmsk,cn_x) npjglo = getdim (cn_fmsk,cn_y) npk = getdim (cn_fmsk,cn_z) ENDIF ALLOCATE (v3d(npiglo, npjglo, npk), mask(npiglo, npjglo, npk) ) ALLOCATE (d2d(npiglo, npjglo ), de(npiglo,npjglo) ) ! loop on all variables to collocate DO jtyp=1,ntyp cctyp=TRIM(cltype(jtyp)) ! depending upon the type, set the weigth file, variable name, mask variable, data file ! vertical dimension of output variable and a scale factor SELECT CASE ( cctyp) CASE ('T') ! temperature, not used for Greg Holloway output cf_weight = cf_weight_t cf_in = cf_gridt cvar = cn_votemper cvmask = 'tmask' npkv = npk dscale = 1.d0 CASE ('S') ! salinity, not used for Greg Holloway output cf_weight = cf_weight_t cf_in = cf_gridt cvar = cn_vosaline cvmask = 'tmask' npkv = npk dscale = 1.d0 CASE ('SSH') ! SSH, not used for Greg Holloway output cf_weight = cf_weight_t cf_in = cf_gridt cvar = cn_sossheig cvmask = 'tmask' npkv = 1 dscale = 100.d0 CASE ('CFCINV') ! CFC inventory, not used for Greg Holloway output cf_weight = cf_weight_t cf_in = cf_gridtrc cvar = cn_invcfc cvmask = 'tmask' npkv = 1 dscale = 1000000.d0 CASE ('CFCCONC') ! CFC inventory, not used for Greg Holloway output cf_weight = cf_weight_t cf_in = cf_gridtrc cvar = cn_cfc11 cvmask = 'tmask' npkv = 1 dscale = 1.d0 CASE ('PENDEP') ! CFC penetration depth cf_weight = cf_weight_t cf_in = cf_diag cvar = cn_pendep cvmask = 'tmask' npkv = 1 dscale = 1.d0 CASE ('MXL','MXL01' ) ! Mixed layer depth cf_weight = cf_weight_t cf_in = cf_gridt cvar = cn_somxl010 cvmask = 'tmask' npkv = 1 dscale = 1.d0 CASE ('MXLT02' ) ! Mixed layer depth cf_weight = cf_weight_t cf_in = cf_gridt cvar = cn_somxlt02 cvmask = 'tmask' npkv = 1 dscale = 1.d0 CASE ('ISOTHICK' ) ! Mixed layer depth cf_weight = cf_weight_t cf_in = cf_diag cvar = cn_isothick cvmask = 'tmask' npkv = 1 dscale = 1.d0 CASE ('U') ! Zonal component of velocity cf_weight = cf_weight_u cf_in = cf_gridu cvar = cn_vozocrtx cvmask = 'umask' npkv = npk dscale = 100.d0 ! to be cm/s in the output CASE ('V') ! Meridional component of velocity cf_weight = cf_weight_v cf_in = cf_gridv cvar = cn_vomecrty cvmask = 'vmask' npkv = npk dscale = 100.d0 ! to be cm/s in the output CASE ('Sx') ! Zonal component of bottom slope cf_weight = cf_weight_u cf_in = 'none' cvar = 'none' cvmask = 'umask' npkv = 1 dscale = 100.d0 ! to be in % in the output llchk = llchk .OR. chkfile(cn_fcoo ) llchk = llchk .OR. chkfile(cn_fzgr ) IF ( llchk ) STOP ! Sx is the i-slope of bottom topog: read adequate metric ! and compute it on v3d(:,:,1) de(:,:) = getvar(cn_fcoo, cn_ve1u, 1, npiglo, npjglo) d2d(:,:) = getvar(cn_fzgr, 'hdepw', 1, npiglo, npjglo) DO ji=2, npiglo-1 v3d(ji,:,1) = (d2d(ji+1,:) - d2d(ji,:)) / de(ji,:) END DO CASE ('Sy') ! Meridional component of bottom slope cf_weight = cf_weight_v cf_in = 'none' cvar = 'none' cvmask = 'vmask' npkv = 1 dscale = 100.d0 ! to be in % in the output llchk = llchk .OR. chkfile(cn_fcoo ) llchk = llchk .OR. chkfile(cn_fzgr ) IF ( llchk ) STOP ! Sy is the j-slope of bottom topog: read adequate metric ! and compute it on v3d(:,:,1) de(:,:) = getvar(cn_fcoo, cn_ve2v, 1, npiglo, npjglo) d2d(:,:) = getvar(cn_fzgr, 'hdepw', 1, npiglo, npjglo) DO jj=2, npjglo-1 v3d(:,jj,1) = (d2d(:,jj+1) - d2d(:,jj)) / de(:,jj) END DO CASE ('H') ! Bottom topography cf_weight = cf_weight_t cf_in = cn_fzgr cvar = 'hdepw' cvmask = 'tmask' npkv = 1 dscale = 1.d0 CASE ('etopo') ! Bottom topography from external file cf_weight = cf_weight_t cf_in = cf_bathy cvar = 'z' cvmask = 'none' npkv = 1 dscale = 1.d0 END SELECT IF (chkfile (cf_weight) .OR. chkfile( cf_in) ) STOP ! missing file ! Now enter the generic processing PRINT *,'START coloc for ', TRIM(cctyp) IF (jtyp == 1 ) THEN ! count number of station and allocate dinterp ! assuming weight file ( T U V ) have the same number of stations. OPEN(numbin, FILE=cf_weight,FORM='unformatted') ! Determine the number of records in the weight file DO READ(numbin, END=100) nid=nid+1 END DO 100 CONTINUE CLOSE(numbin) PRINT *, nid ,' stations to process...' ! allocate result array ALLOCATE ( dinterp(nid,ntyp) ) ENDIF OPEN(numbin, FILE=cf_weight,FORM='unformatted') IF (cf_in /= 'none' ) THEN ! read data (except for Sx and Sy ) DO jk=1, npkv v3d(:,:,jk)=getvar(cf_in,cvar,jk, npiglo,npjglo) END DO ENDIF ! read corresponding mask IF ( cvmask == 'none' ) THEN ! special case of etopo files ( valid values are < 0 ) mask = 1 WHERE ( v3d >= 0 ) mask = 0 ELSE DO jk=1, npkv mask(:,:,jk)=getvar(cn_fmsk,cvmask,jk, npiglo,npjglo) END DO ENDIF DO jid=1,nid ! READ(numbin) id, dymin, dxmin, idep ,nimin, njmin, nkmin, nquadran, dhN, dalpha, dbeta, dgama READ(numbin) id, ymin, xmin, rdep ,nimin, njmin, nkmin, nquadran, dhN, dalpha, dbeta, dgama dinterp(jid,jtyp)=interp() ! do not scale dummy values IF ( dinterp (jid,jtyp) > -99990.d0 ) dinterp (jid,jtyp) = dinterp (jid,jtyp) * dscale END DO CLOSE(numbin) END DO ! Loop on type OPEN(numout, FILE=cf_out ) OPEN(numskip, FILE=cf_skip) ! need to re-read some informations from the weight file (idep, dhN) cf_weight = cf_weight_t OPEN(numbin, FILE=cf_weight, FORM='unformatted') DO jid=1, nid ! loop on all stations READ(numbin) id, ymin, xmin, rdep, nimin, njmin, nkmin, nquadran, dhN IF ( xmin > 180.0) xmin = xmin - 360.0 ! output only stations with no problems ( dinterp > -99990 ) dlmin=MINVAL(dinterp(jid,:) ) IF ( dlmin > -99990.d0 ) THEN ! apply vector rotation to have results on the geographic reference system (N-S, E-W ) IF ( nSx > 0 ) THEN ! (Sx, Sy pair ) CALL rotation( dinterp(jid,nSx), dinterp(jid,nSy), dhN) ENDIF IF ( nU > 0 ) THEN ! (U, V pair) CALL rotation( dinterp(jid,nU), dinterp(jid,nV), dhN) ENDIF WRITE(numout, cformat) id, rdep, (dinterp(jid,jtyp),jtyp=1,ntyp) ELSE ! save discarted stations for control WRITE(numskip, cformat) id, rdep, (dinterp(jid,jtyp),jtyp=1,ntyp) ENDIF END DO CLOSE(numbin) CLOSE(numout) PRINT *,' Done.' CONTAINS FUNCTION interp () !!--------------------------------------------------------------------- !! *** FUNCTION interp *** !! !! ** Purpose : Perform spatial interpolation !! !! ** Method : Use the informations in weigth file to perform !! bilinear interpolation !! !!---------------------------------------------------------------------- REAL(KIND=8) :: interp ! return value INTEGER(KIND=4) :: ii1, ij1, ii2, ij2 ! working integers INTEGER(KIND=4) :: ii3, ij3, ii4, ij4 ! working integers INTEGER(KIND=4) :: ik1, ik2 ! working integers !!---------------------------------------------------------------------- ! skip out of domain stations (flagged with nimin = -1000) IF (nimin == -1000 ) THEN interp=-99999.d0 RETURN ENDIF ! choose the 4 interpolation points, according to sector and nearest point (nimin, njmin) SELECT CASE (nquadran) CASE (1) ii1=nimin ; ij1 = njmin ii2=nimin +1 ; ij2 = njmin ii3=nimin +1 ; ij3 = njmin + 1 ii4=nimin ; ij4 = njmin + 1 CASE (2) ii1=nimin ; ij1 = njmin ii2=nimin ; ij2 = njmin - 1 ii3=nimin +1 ; ij3 = njmin - 1 ii4=nimin +1 ; ij4 = njmin CASE (3) ii1=nimin ; ij1 = njmin ii2=nimin -1 ; ij2 = njmin ii3=nimin -1 ; ij3 = njmin - 1 ii4=nimin ; ij4 = njmin - 1 CASE (4) ii1=nimin ; ij1 = njmin ii2=nimin ; ij2 = njmin + 1 ii3=nimin -1 ; ij3 = njmin + 1 ii4=nimin -1 ; ij4 = njmin END SELECT ! nkmin is always above target point ik1 = nkmin ; ik2 = nkmin + 1 IF (npkv == 1 ) THEN ! 2D var, do not take care of vertical interpolation ik1 = 1 ; ik2 = 0 ; wdo = 0. ENDIF ! compute sum of masked weight above target point wup = mask(ii1,ij1,ik1)*(1-dalpha)*(1-dbeta) + mask(ii2,ij2,ik1) * dalpha *(1-dbeta) + & & mask(ii3,ij3,ik1)* dalpha*dbeta + mask(ii4,ij4,ik1) * (1-dalpha)*dbeta ! interpolate with non-masked values, above target point vup = v3d(ii1,ij1,ik1)*(1-dalpha)*(1-dbeta) + v3d(ii2,ij2,ik1) * dalpha *(1-dbeta) + & & v3d(ii3,ij3,ik1)* dalpha*dbeta + v3d(ii4,ij4,ik1) * (1-dalpha)*dbeta IF (ik2 /= 0 ) THEN ! for 3D variables ! compute sum of masked weight below target point wdo = mask(ii1,ij1,ik2)*(1-dalpha)*(1-dbeta) + mask(ii2,ij2,ik2) * dalpha *(1-dbeta) + & & mask(ii3,ij3,ik2)* dalpha*dbeta + mask(ii4,ij4,ik2) * (1-dalpha)*dbeta ! interpolate with non-masked values, below target point vdo = v3d(ii1,ij1,ik2)*(1-dalpha)*(1-dbeta) + v3d(ii2,ij2,ik2) * dalpha *(1-dbeta) + & & v3d(ii3,ij3,ik2)*dalpha*dbeta + v3d(ii4,ij4,ik2) * (1-dalpha)*dbeta ENDIF IF ( wup == 0 ) THEN ! all points are masked interp=-99999.d0 ELSE IF ( wdo == 0 ) THEN ! all points below are masked, or 2D interp= vup/wup ELSE ! general case interp= (1 - dgama) * vup/wup + dgama * vdo/wdo ENDIF END FUNCTION interp SUBROUTINE rotation (ddu, ddv, ddcourse) !!--------------------------------------------------------------------- !! *** ROUTINE rotation *** !! !! ** Purpose : This subroutine returns the input vectors on the !! geographical reference !! !! ** Method : Projection acording to ddcourse (heading) !! !!---------------------------------------------------------------------- REAL(KIND=8), INTENT(inout) :: ddu ! input u component (along I) REAL(KIND=8), INTENT(inout) :: ddv ! input v component (along J) REAL(KIND=8), INTENT(in ) :: ddcourse ! local direction of the I=cst lines ! ! with respect to N (deg). REAL(KIND=8) :: dlu ! Local working variables REAL(KIND=8) :: dlv ! Local working variables REAL(KIND=8) :: dlconv ! " REAL(KIND=8) :: dlcourse ! " REAL(KIND=8) :: dlpi ! " !!---------------------------------------------------------------------- dlpi = ACOS(-1.d0) ; dlconv = dlpi/180.d0 dlcourse = ddcourse*dlconv ! heading in radians dlu = ddu ; dlv = ddv ddu = dlu*COS(dlcourse) +dlv*SIN(dlcourse) ddv = -dlu*SIN(dlcourse) +dlv*COS(dlcourse) END SUBROUTINE rotation SUBROUTINE getfld () !!--------------------------------------------------------------------- !! *** ROUTINE getfld *** !! !! ** Purpose : decipher ctmplst : looking for ',' separating field !! count the number of field in ctmplst0 : ntyp !! Set up pairing for vector components. !! Initialize format output !! !! ** Method : use global variables !! !!---------------------------------------------------------------------- INTEGER(KIND=4) :: jt CHARACTER(LEN=256) :: cltmplst !!---------------------------------------------------------------------- cltmplst = ctmplst0 ntyp = 1 idum = INDEX(cltmplst,',') DO WHILE ( idum > 0 ) cltmplst=cltmplst(idum+1:) idum=INDEX(cltmplst,',') ntyp = ntyp + 1 ENDDO ALLOCATE (cltype(ntyp) ) ! populates cltype with individual field cltmplst = ctmplst0 DO jtyp = 1, ntyp idum=INDEX(cltmplst,',') IF (idum == 0 ) THEN cltype(jtyp) = TRIM(cltmplst) ELSE cltype(jtyp) = cltmplst(1:idum-1) ENDIF cltmplst=cltmplst(idum+1:) ENDDO ! check if all fields are supported: DO jtyp=1, ntyp DO jt =1 , jptyp IF ( cltype(jtyp) == TRIM(ctype(jt)) ) EXIT ENDDO IF ( jt == jptyp + 1 ) THEN PRINT *, 'ERROR in field list :', TRIM(cltype(jtyp) ),' not supported' STOP ENDIF ENDDO ! locate pairing for vector variables nSx = -1 ; nSy = -1 nU = -1 ; nV = -1 DO jtyp = 1, ntyp IF ( cltype(jtyp) == 'Sx' ) nSx = jtyp IF ( cltype(jtyp) == 'Sy' ) nSy = jtyp IF ( cltype(jtyp) == 'U' ) nU = jtyp IF ( cltype(jtyp) == 'V' ) nV = jtyp END DO IF ( nSx * nSy < 0 ) THEN PRINT *, ' You must specify both Sx and Sy' PRINT *, ' in order to perform rotation' STOP ENDIF IF ( nU * nV < 0 ) THEN PRINT *, ' You must specify both U and V' PRINT *, ' in order to perform rotation' STOP ENDIF ! build output file name cf_out='iz' DO jtyp=1, ntyp cf_out=TRIM(cf_out)//'_'//TRIM(cltype(jtyp)) ENDDO cf_out=TRIM(cf_out)//'.txt' ! Build output format WRITE(cformat,'(a,i2,a)') '(I5, I6,',ntyp,'e14.6)' END SUBROUTINE getfld SUBROUTINE help_message () !!--------------------------------------------------------------------- !! *** ROUTINE help_message *** !! !! ** Purpose : Print the list of available fields, and describes the !! corresponding required input files !! !!---------------------------------------------------------------------- CHARACTER(LEN=24), DIMENSION(jptyp) :: comments CHARACTER(LEN=10), DIMENSION(jptyp) :: crequired !!---------------------------------------------------------------------- PRINT *,' List of available field to process:' PRINT *,'field name comments input files' ! ctype = (/'T','S','SSH','CFCINV','CFCCONC','PENDEP','MXL','MXL01', ! 'MXLT02','ISOTHICK','U ','V ','Sx','Sy','H ','etopo'/) comments = (/' Potential temperature ', & & ' Salinity ', & & ' Sea Surface height ', & & ' CFC inventory ', & & ' CFC concentration ', & & ' Penetration depth ', & & ' Mixed layer depth s0.01', & & ' Mixed layer depth s0.01', & & ' Mixed layer depth t0.2 ', & & ' Isopycnal thickness ', & & ' Zonal velocity ', & & ' Meridional velocity ', & & ' Zonal bottom slope ', & & ' Meridional bottom slope', & & ' Local model bathymetry ', & & ' etopo like bathymetry ' /) crequired = (/' -t gridT ', & & ' -t gridT ', & & ' -t gridT ', & & ' -trc TRC ', & & ' -trc TRC ', & & ' -d diag ', & & ' -t gridT ', & & ' -t gridT ', & & ' -t gridT ', & & ' -d diag ', & & ' -u gridU ', & & ' -v gridV ', & & ' zgr coord', & & ' zgr coord', & & ' zgr ', & & ' -b etopo ' /) DO jtyp=1, jptyp PRINT '( 12a,x,24a,x,10a)', TRIM(ctype(jtyp)), comments(jtyp), crequired(jtyp) ENDDO STOP END SUBROUTINE help_message END PROGRAM cdfcoloc cdftools-3.0/Macrolib/0000755000175000017500000000000012241227304016050 5ustar amckinstryamckinstrycdftools-3.0/Macrolib/macro.g950000644000175000017500000000120412241227304017474 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # $Rev: 173 $ # $Date: 2008-03-17 11:42:21 +0100 (Mon, 17 Mar 2008) $ # -------------------------------------------------------------- # #NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf #NCDF = -I/usr/local/netcdf-3.6.1/ifort/include -L /usr/local/netcdf-3.6.1/ifort/lib/ \ # -I/opt/netcdf/include -L /opt/netcdf/lib/ \ # -I/usr/local/include -L/usr/local/lib -lnetcdf NCDF= -I /usr/local/g95/include /usr/local/g95/lib/libnetcdf.a F90=g95 MPF90=mpif90 FFLAGS= -O $(NCDF) -fno-second-underscore -fendian=big -ffixed-line-length-132 LMPI=-lmpich #INSTALL=$(HOME)/bin INSTALL=/usr/local/bin cdftools-3.0/Macrolib/macro.ifort0000644000175000017500000000103012241227304020210 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # $Rev$ # $Date$ # -------------------------------------------------------------- # #NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf NCDF = -I/usr/local/netcdf-3.6.1/ifort/include -L /usr/local/netcdf-3.6.1/ifort/lib/ \ -I/opt/netcdf/include -L /opt/netcdf/lib/ \ -I/usr/local/include -L/usr/local/lib -lnetcdf F90=ifort MPF90=mpif90 FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian -CB -fpe0 -g -traceback -ftrapuv LMPI=-lmpich INSTALL=$(HOME)/bin INSTALL_MAN=$(HOME)/man cdftools-3.0/Macrolib/macro.rhodes0000644000175000017500000000055412241227304020363 0ustar amckinstryamckinstry# Makefile for CDFTOOLS on RHODES.IDRIS.FR (SGI Origin 2100) # !! $Rev$ # !! $Date$ # !! $Id$ # !!-------------------------------------------------------------- # NCDF = -I/usr/local/pub/netcdf-3.6.1/include -L/usr/local/pub/netcdf-3.6.1/lib -lnetcdf F90=f90 MPF90=f90 FFLAGS= -O2 -mips4 -bytereclen $(NCDF) -bytereclen INSTALL=$(HOME_BIS)/CDFTOOLS-2.1/ cdftools-3.0/Macrolib/macro.zahir0000644000175000017500000000071212241227304020210 0ustar amckinstryamckinstry# Makefile for CDFTOOLS : AIX (zahir) # !! $Rev$ # !! $Date$ # !! $Id$ # !!-------------------------------------------------------------- # NCDF = -I/usr/local/pub/netcdf/include -L/usr/local/pub/netcdf/lib -lnetcdf NCDF= -I/usr/local/pub/netcdf/netcdf-3.5.0/include -L/usr/local/pub/netcdf/netcdf-3.5.0/lib -lnetcdf F90=xlf90 MPF90=mpxlf90_r #FFLAGS= -O4 -qsuffix=f=f90 $(NCDF) -q64 -qsave FFLAGS= -O4 -qsuffix=f=f90 $(NCDF) -q64 INSTALL=./ cdftools-3.0/Macrolib/macro.meolkerg0000644000175000017500000000117512241227304020704 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # $Rev: 173 $ # $Date: 2008-03-17 11:42:21 +0100 (lun 17 mar 2008) $ # -------------------------------------------------------------- # NCDF = -I/opt/netcdf-4.1/include -L /opt/netcdf-4.1/lib/ \ -lnetcdf HDF5 = -I/opt/hdf5-1.8.4/include -L/opt/hdf5-1.8.4/lib -lhdf5_hl -lhdf5 ZLIB = -I/opt/zlib-1.2.3/include -L/opt/zlib-1.2.3/lib -lz #NCDF = -I/opt/netcdf-4.1.1-ifort/include -L /opt/netcdf-4.1.1-ifort/lib/ \ # -lnetcdf #HDF5 = #ZLIB = F90=ifort MPF90=mpif90 FFLAGS= -O $(NCDF) $(HDF5) $(ZLIB) -assume byterecl -convert big_endian LMPI=-lmpich INSTALL=/usr/local/cdftools_3.0/bin cdftools-3.0/Macrolib/macro.jade0000644000175000017500000000121012241227304017770 0ustar amckinstryamckinstry# macro.jade for jade at CINES # $Rev$ # $Date$ # $Id$ # ------------------------------------------------------------- # NCDF= -I/opt/software/SGI/netcdf/4.0/include -L/opt/software/SGI/netcdf/4.0/lib -lnetcdff -lnetcdf F90=ifort MPF90=mpif90 # flag static is used to allow the use of CDFTOOLS in parallel with mpi_metamon #FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian -CB -fpe0 -g -traceback -ftrapuv FFLAGS= -static -O $(NCDF) -assume byterecl -convert big_endian #FFLAGS= -static -O $(NCDF) -assume byterecl -convert big_endian -g -traceback -fpe0 -ftrapuv -CB LMPI=-lmpich INSTALL=$(WORKDIR)/bin INSTALL_MAN=$(WORKDIR)/man cdftools-3.0/Macrolib/macro.icm0000644000175000017500000000060612241227304017645 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # $Rev: 608 $ # $Date: 2012-07-03 15:29:11 +0200 (Tue, 03 Jul 2012) $ # -------------------------------------------------------------- # NCDF = -I/home/nhoareau/netcdf-ifort/include -L/home/nhoareau/netcdf-ifort/lib -lnetcdf F90=ifort MPF90=mpif90 FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian LMPI= INSTALL=$(HOME)/bin INSTALL_MAN=$(HOME)/man cdftools-3.0/Macrolib/macro.curie0000644000175000017500000000110112241227304020173 0ustar amckinstryamckinstry# macro.jade for jade at CINES # $Rev: 539 $ # $Date: 2011-07-11 12:33:35 +0200 (Mon, 11 Jul 2011) $ # $Id: macro.jade 539 2011-07-11 10:33:35Z molines $ # ------------------------------------------------------------- # NCDF= -I/usr/local/netcdf-4.1.1/include -L/usr/local/netcdf-4.1.1/lib -lnetcdff -lnetcdf F90=ifort MPF90=mpif90 # flag static is used to allow the use of CDFTOOLS in parallel with mpi_metamon #FFLAGS= -static -O $(NCDF) -assume byterecl -convert big_endian FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian LMPI=-lmpich INSTALL=$(WORKDIR)/bin cdftools-3.0/Macrolib/macro.gfortran0000644000175000017500000000062312241227304020716 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # $Rev: 522 $ # $Date: 2011-06-17 12:50:13 +0200 (Fri, 17 Jun 2011) $ # -------------------------------------------------------------- # #NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf NCDF = -I/usr/include -lnetcdff -lnetcdf #F90=gfortran -v F90=gfortran MPF90= FFLAGS= -O $(NCDF) -fno-second-underscore -ffree-line-length-256 LMPI=-lmpich INSTALL=$(HOME)/bin cdftools-3.0/Macrolib/macro.meolkara0000644000175000017500000000123112241227304020663 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # $Rev: 173 $ # $Date: 2008-03-17 11:42:21 +0100 (lun 17 mar 2008) $ # -------------------------------------------------------------- # NCDF_ROOT=/opt/netcdf/4.1.1 #NCDF_ROOT=/opt/netcdf/4.1 #HDF5_ROOT=/opt/hdf5/1.8.4 #ZLIB_ROOT=opt/zlib/1.2.3 NCDF = -I$(NCDF_ROOT)/include -L $(NCDF_ROOT)/lib/ \ -lnetcdf #HDF5 = -I$(HDF5_ROOT)/include -L$(HDF5_ROOT)/lib -lhdf5_hl -lhdf5 #ZLIB = -I$(ZLIB_ROOT)/include -L$(ZLIB_ROOT)/lib -lz F90=ifort MPF90=mpif90 FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian #FFLAGS= -O $(NCDF) $(HDF5) $(ZLIB) -assume byterecl -convert big_endian LMPI=-lmpich INSTALL=$(HOME)/bin cdftools-3.0/Macrolib/macro.porzig0000644000175000017500000000067112241227304020411 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # $Rev: 95 $ # $Date: 2007-09-18 11:00:06 +0200 (Tue, 18 Sep 2007) $ # -------------------------------------------------------------- # #NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf NCDF = -I/export/home/services/netcdf-3.6.0-p1/include -L/export/home/services/netcdf-3.6.0-p1/lib -lnetcdf F90=ifort MPF90=ifort FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian LMPI=-lmpi INSTALL=$(HOME)/bin cdftools-3.0/Macrolib/macro.vayu0000644000175000017500000000067712241227304020071 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # $Rev: 608 $ # $Date: 2012-07-03 23:29:11 +1000 (Tue, 03 Jul 2012) $ # -------------------------------------------------------------- # #NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf NCDF = -I$(NETCDF_BASE)/include/Intel -L$(NETCDF_BASE)/lib/Intel -lnetcdf -lnetcdff F90=ifort MPF90=mpif90 FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian LMPI=-lmpich INSTALL=$(HOME)/bin INSTALL_MAN=$(HOME)/man cdftools-3.0/Macrolib/macro.mirage0000644000175000017500000000043012241227304020334 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # $Rev$ # $Date$ # -------------------------------------------------------------- # NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf F90=ifort MPF90=ifort FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian LMPI=-lmpi INSTALL=$(HOME)/bin cdftools-3.0/Macrolib/macro.vargas0000644000175000017500000000065612241227304020365 0ustar amckinstryamckinstry# Makefile for CDFTOOLS : AIX (zahir) # !! $Rev: 82 $ # !! $Date: 2007-07-17 10:24:09 +0200 (Tue, 17 Jul 2007) $ # !! $Id: macro.zahir 82 2007-07-17 08:24:09Z molines $ # !!-------------------------------------------------------------- # NCDF= -lnetcdf F90=xlf90 MPF90=mpxlf90_r #FFLAGS= -O4 -qsuffix=f=f90 $(NCDF) -q64 -qsave FDATE_FLAG= -brename:.fdate,.fdate_ FFLAGS= -O4 -qsuffix=f=f90 $(NCDF) -q64 INSTALL=./ cdftools-3.0/Macrolib/macro.ada0000644000175000017500000000073112241227304017621 0ustar amckinstryamckinstry# macro.ada for ada at IDRIS # $Rev$ # $Date$ # $Id$ # ------------------------------------------------------------- # F90=ifort MPF90=mpiifort # assume compiler wrapper is working for netcdf on ada # flag static is used to allow the use of CDFTOOLS in parallel with mpi_metamon #FFLAGS= -O -assume byterecl -convert big_endian -CB -fpe0 -g -traceback -ftrapuv FFLAGS= -O2 -assume byterecl -convert big_endian INSTALL=$(WORKDIR)/bin INSTALL_MAN=$(WORKDIR)/man cdftools-3.0/Macrolib/macro.p6300000644000175000017500000000053712241227304017570 0ustar amckinstryamckinstry# Makefile for CDFTOOLS : AIX (p630) # !! $Rev$ # !! $Date$ # !! $Id$ # !!-------------------------------------------------------------- # NCDF = -I/usr/local/netcdf-3.6.0-p1/include -L/usr/local/netcdf-3.6.0-p1/lib -lnetcdf F90=xlf90 MPF90=mpxlf90_r FFLAGS= -O4 -qsuffix=f=f90 -bmaxdata:500000000 $(NCDF) -q64 -qsave INSTALL=/usr/local/bin cdftools-3.0/Macrolib/macro.gorgon0000644000175000017500000000041012241227304020361 0ustar amckinstryamckinstry# Makefile for CDFTOOLS (Linux with pgi) # NCDF = -I/usr/local/Cluster-Apps/netcdf/pgi/3.6.1/include -L/usr/local/Cluster-Apps/netcdf/pgi/3.6.1/lib -lnetcdf INCDIR = -I/usr/local/Cluster-Apps/netcdf/pgi/3.6.1/include F90=pgf90 FFLAGS = -fast $(NCDF) -byteswapio cdftools-3.0/Macrolib/macro.mac0000644000175000017500000000105412241227304017633 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # $Rev: 173 $ # $Date: 2008-03-17 11:42:21 +0100 (Mon, 17 Mar 2008) $ # -------------------------------------------------------------- # #NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf NCDF = -I/usr/local/netcdf-3.6.1/ifort/include -L /usr/local/netcdf-3.6.1/ifort/lib/ \ -I/opt/netcdf/include -L /opt/netcdf/lib/ \ -I/usr/local/include -L/usr/local/lib -lnetcdf F90=ifort MPF90=mpif90 FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian LMPI=-lmpich #INSTALL=$(HOME)/bin INSTALL=/usr/local/bin cdftools-3.0/Macrolib/macro.pgi0000644000175000017500000000036512241227304017656 0ustar amckinstryamckinstry# Makefile for CDFTOOLS (Linux with pgi) # !! $Rev$ # !! $Date$ # !! $Id$ # !!-------------------------------------------------------------- # NCDF = -lnetcdf F90=pgf90 MPF90=pgf90 FFLAGS = -fast $(NCDF) -byteswapio INSTALL=/usr/local/bin cdftools-3.0/Macrolib/macro.nymphea0000644000175000017500000000053112241227304020533 0ustar amckinstryamckinstry# Makefile for CDFTOOLS : Nymphea (OSF1) # !! $Rev$ # !! $Date$ # !! $Id$ # !!-------------------------------------------------------------- # NCDF = -I/home/nymphea/services/bibli/netcdf-3.6.0/include -L/home/nymphea/services/bibli/netcdf-3.6.0/lib -lnetcdf F90=f90 FFLAGS= -convert big_endian -assume byterecl $(NCDF) INSTALL=$(HOME)/bin cdftools-3.0/Macrolib/macro.sx80000644000175000017500000000060012241227304017611 0ustar amckinstryamckinstry#Makefile for CDFTOOLS : SX8 (brodie) # !! $Rev$ # !! $Date$ # !! $Id$ # !!-------------------------------------------------------------- # MPF90 = sxmpif90 F90 = sxf90 #- NCDF = -I/SXlocal/pub/netCDF/netCDF-3.6.1/include -L/SXlocal/pub/netCDF/netCDF-3.6.1/lib -lnetcdf FFLAGS=$(NCDF) -dW -sx8 -C vopt -Wf"-P nh" -Wf,-pvctl noassume loopcnt=10000 -L transform INSTALL=./ cdftools-3.0/Macrolib/macro.ifort_ursus0000644000175000017500000000043512241227304021461 0ustar amckinstryamckinstry# Makefile for CDFTOOLS # !! $Rev$ # !! $Date$ # !! $Id$ # !!-------------------------------------------------------------- # NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf F90=ifort MPF90=ifort FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian INSTALL=$(HOME)/bin cdftools-3.0/cdfrmsssh.f900000644000175000017500000001336212241227304016641 0ustar amckinstryamckinstryPROGRAM cdfrmsssh !!====================================================================== !! *** PROGRAM cdfrmsssh *** !!===================================================================== !! ** Purpose : Compute the RMS of SSH, from the mean squared value. !! !! ** Method : Read gridT and gridT2 and compute rms !! !! History : 2.1 : 11/2004 : J.M. Molines : Original code !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output variable INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4), DIMENSION(1) :: ipko, id_varout ! output variable REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvbar, zvba2 ! mean and mean2 variable REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsdev ! standard deviation CHARACTER(LEN=256) :: cf_in ! input mean file name CHARACTER(LEN=256) :: cf_in2 ! input mean2 file name CHARACTER(LEN=256) :: cf_out = 'rms.nc' ! output file name CHARACTER(LEN=256) :: cv_in, cv_in2 ! input variable names CHARACTER(LEN=256) :: cldum ! dummy character variable TYPE(variable), DIMENSION(1) :: stypvaro ! output data structure LOGICAL :: lchk = .FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() cv_in = cn_sossheig narg= iargc() IF ( narg < 2 ) THEN PRINT *,' usage : cdfrmsssh T-file T2-file ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the standard deviation of the SSH from its' PRINT *,' mean value and its mean square value. ' PRINT *,' ' PRINT *,' Note that what is computed in this program is stictly the' PRINT *,' standard deviation. It is very often called RMS, which is' PRINT *,' an abuse. It is the same only in the case of zero mean value.' PRINT *,' However, for historical reason, the name of this tool, remains' PRINT *,' unchanged: cdfrmsssh' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with mean values for SSH' PRINT *,' T2-file : netcdf file with mean squared values for SSH' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_in)//'_rms, same unit than the input.' PRINT *,' ' PRINT *,' SEA ALSO :' PRINT *,' cdfstd, cdfstdevw, cdfstdevts.' STOP ENDIF ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg) CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE DEFAULT ireq = ireq + 1 SELECT CASE ( ireq ) CASE ( 1 ) ; cf_in = cldum CASE ( 2 ) ; cf_in2 = cldum CASE DEFAULT PRINT *, ' Too many variables ' ; STOP END SELECT END SELECT ENDDO ! check existence of files lchk = lchk .OR. chkfile(cf_in ) lchk = lchk .OR. chkfile(cf_in2 ) IF (lchk ) STOP ! missing file npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z) npt = getdim (cf_in, cn_t) ipko(1) = 1 stypvaro(1)%cname = TRIM(cv_in)//'_rms' stypvaro(1)%cunits = 'm' stypvaro(1)%rmissing_value = 0. stypvaro(1)%valid_min = 0. stypvaro(1)%valid_max = 100. stypvaro(1)%clong_name = 'RMS_Sea_Surface_height' stypvaro(1)%cshort_name = TRIM(cv_in)//'_rms' stypvaro(1)%conline_operation = 'N/A' stypvaro(1)%caxis = 'TYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE( zvbar(npiglo,npjglo), zvba2(npiglo,npjglo) ) ALLOCATE( dsdev(npiglo,npjglo), tim(npt) ) ncout = create (cf_out, cf_in, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvaro, 1, ipko, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk ) cv_in2 = TRIM(cv_in)//'_sqd' DO jt = 1, npt zvbar(:,:) = getvar(cf_in, cv_in, 1, npiglo, npjglo, ktime=jt) zvba2(:,:) = getvar(cf_in2, cv_in2, 1, npiglo, npjglo, ktime=jt) dsdev(:,:) = SQRT ( DBLE(zvba2(:,:) - zvbar(:,:)*zvbar(:,:)) ) ierr = putvar(ncout, id_varout(1), REAL(dsdev), 1, npiglo, npjglo, ktime=jt) END DO tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdfrmsssh cdftools-3.0/modutils.f900000644000175000017500000002332712241227304016507 0ustar amckinstryamckinstryMODULE modutils !!====================================================================== !! *** MODULE modutils *** !! Hold functions and subroutine dedicated to common utility task !!===================================================================== !! History : 3.0 : 04/2011 : J.M. Molines : Original code !! : 10/2012 : N. Ferry, E. Durand, F. Hernandez : add shapiro !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! SetGlobalAtt : Set Global Attribute to the command line !! SetFilename : Build standard name from confname !! shapiro_fill_smooth : shapiro smoother or filler !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- USE cdfio IMPLICIT NONE PRIVATE PUBLIC SetGlobalAtt PUBLIC SetFileName PUBLIC shapiro_fill_smooth CONTAINS SUBROUTINE SetGlobalAtt(cdglobal, cd_append) !!--------------------------------------------------------------------- !! *** ROUTINE SetGlobalAtt *** !! !! ** Purpose : Append command line to the string given as argument. !! This is basically used for setting a global attribute !! in the output files !! !! ** Method : Decrypt line command with getarg !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(inout) :: cdglobal CHARACTER(LEN=1), OPTIONAL, INTENT(in ) :: cd_append INTEGER(KIND=4) :: iargc, inarg INTEGER(KIND=4) :: jarg CHARACTER(LEN=100) :: cl_arg CHARACTER(LEN=1 ) :: cl_app !!---------------------------------------------------------------------- cl_app = 'N' IF ( PRESENT( cd_append ) ) THEN cl_app = 'A' ENDIF CALL getarg(0, cl_arg) SELECT CASE ( cl_app) CASE ('A') cdglobal = TRIM(cdglobal)//' ; '//TRIM(cl_arg) CASE ('N') cdglobal = TRIM(cl_arg) END SELECT inarg = iargc() DO jarg=1, inarg CALL getarg(jarg,cl_arg) cdglobal = TRIM(cdglobal)//' '//TRIM(cl_arg) END DO END SUBROUTINE SetGlobalAtt CHARACTER(LEN=256) FUNCTION SetFileName(cdconf, cdtag, cdgrid ,ld_stop ) !!--------------------------------------------------------------------- !! *** FUNCTION SetFileName *** !! !! ** Purpose : Build filename from cdconf, tag and grid !! !! ** Method : Check 2 forms of file names and return !! error is file is missing !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdconf, cdtag, cdgrid LOGICAL, OPTIONAL, INTENT(in) :: ld_stop LOGICAL :: ll_stop !!---------------------------------------------------------------------- IF ( PRESENT(ld_stop) ) THEN ll_stop = ld_stop ELSE ll_stop = .TRUE. ENDIF WRITE( SetFileName,'(a,"_",a,"_grid",a,".nc")') TRIM(cdconf), TRIM(cdtag), TRIM(cdgrid) IF ( chkfile(SetFileName ,ld_verbose=.FALSE.) ) THEN ! look for another name WRITE(SetFileName,'(a,"_",a,"_grid_",a,".nc")') TRIM(cdconf), TRIM(cdtag), TRIM(cdgrid) IF ( chkfile( SetFileName, ld_verbose=.FALSE.) .AND. ll_stop ) THEN PRINT *,' ERROR : missing grid',TRIM(cdgrid),'or even grid_',TRIM(cdgrid),' file ' STOP ENDIF ENDIF END FUNCTION SetFileName SUBROUTINE shapiro_fill_smooth ( psig, kpi, kpj, kpass, cdfs, pbad, klmasktrue, psigf ) !!--------------------------------------------------------------------- !! *** ROUTINE shapiro_fill_smooth *** !! !! ** Purpose : Shapiro smoother or filler !! !! ** Method : Shapiro algorithm !! psig : variable to be filtered 2D !! kpi,kpj : dimension of psig !! kpass : number of passes of the filter !! cdfs : 'smooth' or 'fill' according to choice !! pbad : psig Fill_Value !! klmasktrue : mask flag for continent. !! If land extrapolation is desired, set klmasktrue=1 everywhere !! !! psigf : filtered/filled variable (output) !! !! code history: !! original : 05-11 (N. Ferry) !! additions : 05-12 (E. Durand) !! correction: 07-12 (F. Hernandez) !! cdftools norm : 11-12 (J.M. Molines) !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in ) :: kpi, kpj, kpass INTEGER(KIND=4), DIMENSION(kpi,kpj), INTENT(in ) :: klmasktrue REAL(KIND=4), INTENT(in ) :: pbad REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in ) :: psig REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(out) :: psigf CHARACTER(LEN=6), INTENT(in ) :: cdfs INTEGER(KIND=4) :: ji, jj, jp ! dummy loop index INTEGER(KIND=4), DIMENSION(0:kpi+1,kpj) :: ilmask_e ! extra i-point for E-W periodicity INTEGER(KIND=4), DIMENSION(0:kpi+1,kpj) :: ilmask0_e ! extra i-point for E-W periodicity INTEGER(KIND=4), DIMENSION(0:kpi+1,kpj) :: ilmasktrue_e ! extra i-point for E-W periodicity REAL(KIND=4), DIMENSION(0:kpi+1,kpj) :: zsigf_e ! extra i-point for E-W periodicity REAL(KIND=4), DIMENSION(0:kpi+1,kpj) :: zsig_e ! extra i-point for E-W periodicity REAL(KIND=4) :: znum, zden, zsum !!---------------------------------------------------------------------- ! ... Initialization : zsig_e (1:kpi,:) = psig (:,:) ilmasktrue_e(1:kpi,:) = klmasktrue(:,:) ! E-W periodic zsig_e (0,:) = zsig_e (kpi,:) ilmasktrue_e(0,:) = ilmasktrue_e(kpi,:) zsig_e (kpi+1,:) = zsig_e (1,:) ilmasktrue_e(kpi+1,:) = ilmasktrue_e(1,:) ! check cdfs compliance IF ( cdfs(1:4) .NE. 'fill' .AND. cdfs(1:6) .NE. 'smooth' ) THEN PRINT*, 'cdfs = ',cdfs ,' <> fill or smooth' STOP ENDIF ! ! ... Shapiro filter : ! DO jp = 1, kpass ! number of passes for the filter ! ! in both cases 'smooth' and ' fill' we check points w/o values ilmask_e(:,:) = 0 ; ilmask0_e(:,:) = 0 WHERE ( zsig_e(:,:) /= pbad ) ! set ilmask_e = 1 when field is already filled ilmask_e (:,:) = 1 ilmask0_e(:,:) = 1 ENDWHERE ! case 'fill' IF ( cdfs(1:4) == 'fill' ) THEN ilmask0_e(:,:) = 0 DO ji=1,kpi DO jj=2,kpj-1 zsum = ilmask_e(ji+1,jj) + ilmask_e(ji-1,jj) + ilmask_e(ji,jj+1) + ilmask_e(ji,jj-1) ! set ilmask0_e = 1 if it is possible to do a 4-point interpolation (N-S-E-W) ! not on land IF ( ( zsum >= 1 ) .AND. & ( ilmask_e (ji,jj) == 0 ) .AND. & ( ilmasktrue_e(ji,jj) == 1 ) ) THEN ilmask0_e(ji,jj) = 1 ENDIF ENDDO ! for the northernmost line zsum = ilmask_e(ji+1,kpj) + ilmask_e(ji-1,kpj) + ilmask_e(ji,kpj-1) IF ( ( zsum >= 1 ) .AND. & ( ilmask_e (ji,kpj) == 0 ) .AND. & ( ilmasktrue_e(ji,kpj) == 1 ) ) THEN ilmask0_e(ji,kpj) = 1 ENDIF ENDDO ENDIF ! ! loop on data points for both cases DO ji = 1, kpi DO jj = 2, kpj-1 IF ( ilmask0_e(ji,jj) == 1. ) THEN znum = zsig_e(ji-1,jj )*ilmask_e(ji-1,jj ) & + zsig_e(ji+1,jj )*ilmask_e(ji+1,jj ) & + zsig_e(ji ,jj-1)*ilmask_e(ji ,jj-1) & + zsig_e(ji ,jj+1)*ilmask_e(ji ,jj+1) zden = ilmask_e(ji-1,jj ) & + ilmask_e(ji+1,jj ) & + ilmask_e(ji ,jj-1) & + ilmask_e(ji ,jj+1) zsigf_e(ji,jj) = znum/zden ELSE zsigf_e(ji,jj) = zsig_e(ji,jj) ENDIF ENDDO ! for the northernmost line, we do not take kpj+1 into account IF ( ilmask0_e(ji,kpj) == 1. ) THEN znum = zsig_e(ji-1,kpj )*ilmask_e(ji-1,kpj ) & + zsig_e(ji+1,kpj )*ilmask_e(ji+1,kpj ) & + zsig_e(ji ,kpj-1)*ilmask_e(ji ,kpj-1) zden = ilmask_e(ji-1,kpj ) & + ilmask_e(ji+1,kpj ) & + ilmask_e(ji ,kpj-1) zsigf_e(ji,kpj) = znum/zden ELSE zsigf_e(ji,kpj) = zsig_e(ji,kpj) ENDIF ENDDO ! ! fill or smooth ? ! IF ( cdfs(1:6) == 'smooth' ) THEN WHERE ( ilmasktrue_e(:,:) == 1 ) zsig_e(:,:) = zsigf_e(:,:) END WHERE ENDIF ! IF ( cdfs(1:4) == 'fill' ) THEN WHERE ( ilmask0_e(:,:) == 1 ) zsig_e(:,:) = zsigf_e(:,:) END WHERE ENDIF ! Boundary condition : E-W (simplifie) zsig_e(0,:) = zsig_e(kpi,:) zsig_e(kpi+1,:) = zsig_e(1,:) ! ENDDO ! jp psigf(:,:) = zsig_e(1:kpi,:) END SUBROUTINE shapiro_fill_smooth END MODULE modutils cdftools-3.0/cdfnan.f900000644000175000017500000001563212241227304016100 0ustar amckinstryamckinstryPROGRAM cdfnan !!====================================================================== !! *** PROGRAM cdfnan *** !!===================================================================== !! ** Purpose : Replace the nan values by spval or another value !! given in argument !! !! History : 2.1 : 05/2010 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jvar, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line INTEGER(KIND=4) :: ncid ! ncid of input file for rewrite INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! Number of variables in a file INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id REAL(KIND=4) :: zspval, replace ! spval, replace value REAL(KIND=4) :: rabsmax ! spval, replace value REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tab ! Arrays for data CHARACTER(LEN=256) :: cldum ! dummy string for getarg CHARACTER(LEN=256) :: cf_inout ! file name CHARACTER(LEN=256) :: cunits, clname, csname ! attributes CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! type for attributes LOGICAL :: l_replace = .false. ! flag for replace value !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfnan list_of_model_output_files [-value replace] [-absmax rabsmax ] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Detect NaN values in the input files, and change them to ' PRINT *,' either spval (missing_value) or the value given as option.' PRINT *,' Does the same for absolute values > huge(0.0)' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' list of model output files. They must be of same type and have' PRINT *,' similar sizes. CAUTION : input files are rewritten !' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-value replace ] : use replace instead of missing_value for' PRINT *,' changing NaN.' PRINT *,' [-absmax rabsmax ] : replace values whose absolute value is greater ' PRINT *,' than rabsmax.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : input file is rewritten without NaN.' PRINT *,' variables : same name as input.' STOP ENDIF rabsmax=huge(0.0) ijarg=1 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE (cldum) CASE ('-value' ) CALL getarg( ijarg, cldum) ; ijarg = ijarg+1 ; READ(cldum,*) replace ; l_replace=.true. CASE ('-absmax' ) CALL getarg( ijarg, cldum) ; ijarg = ijarg+1 ; READ(cldum,*) rabsmax CASE DEFAULT cf_inout=TRIM(cldum) END SELECT END DO IF ( chkfile (cf_inout) ) STOP ! missing file npiglo = getdim (cf_inout, cn_x ) npjglo = getdim (cf_inout, cn_y ) npk = getdim (cf_inout, cn_z, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_inout,'z',kstatus=ierr) IF (ierr /= 0 ) THEN PRINT *, 'ASSUME NO VERTICAL DIMENSIONS !' npk=0 ENDIF ENDIF PRINT *, 'npiglo=', npiglo PRINT *, 'npjglo=', npjglo PRINT *, 'npk =', npk ALLOCATE( tab(npiglo,npjglo) ) nvars = getnvar(cf_inout) ALLOCATE (cv_names(nvars), id_var(nvars),ipk(nvars), stypvar(nvars)) cv_names(:) = getvarname(cf_inout,nvars,stypvar) ipk(:) = getipk(cf_inout,nvars) id_var(:) = getvarid(cf_inout,nvars) !re scan argument list ijarg = 1 DO WHILE (ijarg <= narg ) CALL getarg (ijarg, cf_inout) ; ijarg = ijarg + 1 SELECT CASE ( cf_inout) CASE ('-value' ) ! replace already read, just skip ijarg = ijarg + 1 CASE ('-absmax' ) ! already read, just skip ijarg = ijarg + 1 CASE DEFAULT ! reading files PRINT *, 'Change NaN on file ', cf_inout ncid = ncopen(cf_inout) npt = getdim (cf_inout,cn_t) DO jvar = 1,nvars IF ( cv_names(jvar) == cn_vlon2d .OR. & & cv_names(jvar) == cn_vlat2d .OR. & & cv_names(jvar) == cn_vtimec .OR. & & cv_names(jvar) == cn_vdeptht .OR. & & cv_names(jvar) == cn_vdepthu .OR. & & cv_names(jvar) == cn_vdepthv ) THEN ! skip these variable ELSE IF ( l_replace ) THEN zspval=replace ELSE ierr = getvaratt (cf_inout, cv_names(jvar), cunits, zspval, clname, csname) ENDIF DO jt=1,npt DO jk = 1, ipk(jvar) tab(:,:) = getvar(cf_inout, cv_names(jvar), jk, npiglo, npjglo, ktime=jt ) ! WHERE( isnan(tab(:,:)) ) tab(:,:) = zspval ! isnan function is not available on xlf90 compiler ! we replace it by the following test that gives the same results ! reference : http://www.unixguide.net/ibm/faq/faq3.03.shtml WHERE( tab(:,:) /= tab(:,:) ) tab(:,:) = zspval WHERE( tab(:,:) < -rabsmax ) tab(:,:) = zspval WHERE( tab(:,:) > rabsmax ) tab(:,:) = zspval ierr = putvar(ncid, id_var(jvar), tab, jk, npiglo, npjglo, ktime=jt) ENDDO END DO ENDIF ENDDO END SELECT ENDDO ierr = closeout(ncid) END PROGRAM cdfnan cdftools-3.0/cdfmht_gsop.f900000644000175000017500000004675712241227304017160 0ustar amckinstryamckinstryPROGRAM cdfmht_gsop !!------------------------------------------------------------------- !! *** PROGRAM cdfmht_gsop *** !! !! ** Purpose : Compute the Meridional Heat Transport (MHT) !! Components for GSOP intercomparison !! PARTIAL STEPS !! !! ** Method : The MHT is computed from the V velocity field and T temperature field, integrated !! from the bottom to the surface. !! The MHT is decomposed into 3 components : BT, SH, AG. !! Results are saved on gsopmht.nc file with variables name respectively !! zomhtatl, zobtmhta, zoshmhta, zoagmhta !! !! !! history ; !! Original : J.M. Molines (jul. 2005) !! G.C. Smith ( Sep 2007) Added MOC decomposition following : !! Lee & Marotzke (1998), Baehr, Hirschi, Beismann, & Marotzke (2004), Cabanes, Lee, & Fu (2007), !! Koehl & Stammer (2007). !! See also the powerpoint presentation by Tony Lee at the third CLIVAR-GSOP intercomparison !! available at : http://www.clivar.org/organization/gsop/synthesis/mit/talks/lee_MOC_comparison.ppt !! !! A. Lecointre (Dec 2008) Replaced by a MHT decomposition !! !!------------------------------------------------------------------- !! $Rev$ !! $Date$ !! $Id$ !!-------------------------------------------------------------- !! * Modules used USE cdfio USE eos !! * Local variables IMPLICIT NONE INTEGER :: jpbasins ! =5 modif Alb 29/11/08 pour fonctionner avec MERA INTEGER, PARAMETER :: jpgsop=4 INTEGER :: jgsop, jbasin, jj, jk ,ji !: dummy loop index INTEGER :: ierr !: working integer INTEGER :: narg, iargc !: command line INTEGER :: npiglo,npjglo, npk !: size of the domain INTEGER :: ncout, np INTEGER :: numout=10 INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! INTEGER, DIMENSION(jpgsop) :: ipk_gsop, id_varout_gsop ! INTEGER, DIMENSION(2) :: iloc REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1u, e1v, e3v, gphiv, zv !: metrics, velocity REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: Hdep, vbt REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: btht REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zt,zt_v,zsal,tmask,umask,vmask, vgeoz REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zsig0 REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: vgeo,vgeosh,vageosh,vfull,tfull,vmaskz,tmaskz REAL(KIND=4) :: rau0, grav, f0, fcor, zmsv, zphv, rpi ! REAL(KIND=4) :: grav, f0, fcor, zmsv, zphv, rpi REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: e3vz REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0. REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: deptht, gdepw !: deptw REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zzmask !: npiglo x npjglo REAL(KIND=4), DIMENSION (1) :: tim REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zomht !: jpbasins x npjglo REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zomht_gsop !: jpgsop x npjglo REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zomht_geos_full !: npjglo x npk REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zomht_ageos_full !: npjglo x npk REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomhtfull !: jpbasin x npjglo x npk CHARACTER(LEN=256) :: cfilet, cfilev , cfileoutnc='gsopmht.nc' CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cbasinmask='new_maskglo.nc' CHARACTER(LEN=256) ,DIMENSION(jpgsop) :: cvarname_gsop !: array of var name for output TYPE(variable), DIMENSION(jpgsop) :: stypvar !: modif Alb 26/11/08 structure for attributes LOGICAL :: llglo = .false. !: indicator for presence of new_maskglo.nc file INTEGER :: istatus ! constants REAL(KIND=4),PARAMETER :: rho0=1000., rcp=4000. ! rau0 en kg x m-3 et rcp en m2 x s-2 x degC-1 !! Read command line and output usage message if not compliant. narg= iargc() IF ( narg == 0 ) THEN PRINT *,' Usage : cdfmht_gsop V file Tfile' PRINT *,' Computes the MHT for atlantic basin' PRINT *,' PARTIAL CELLS VERSION' PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,new_maskglo.nc ,mask.nc ' PRINT *,' must be in the current directory' PRINT *,' Output on gsopmht.nc: ' PRINT *,' variables zomhtatl : MHT Atlantic Ocean ' PRINT *,' variables zobtmhta : Barotropic component ' PRINT *,' variables zoshmhta : Vertical shear geostrophic component ' PRINT *,' variables zoagmhta : vertical shear ageostrophic component (Ekman + residu)' STOP ENDIF CALL getarg (1, cfilev) npiglo= getdim (cfilev,'x') npjglo= getdim (cfilev,'y') npk = getdim (cfilev,'depth') CALL getarg (2, cfilet) ! Detects newmaskglo file modif Alb 29/11/08 pour MERA INQUIRE( FILE='new_maskglo.nc', EXIST=llglo ) IF (llglo) THEN jpbasins = 5 ELSE jpbasins = 1 ENDIF ! define new variables for output stypvar(1)%cname= 'zobtmhta' stypvar(1)%cunits='PetaWatt' stypvar(1)%rmissing_value=99999. stypvar(1)%valid_min= -1000. stypvar(1)%valid_max= 1000. stypvar(1)%scale_factor= 1. stypvar(1)%add_offset= 0. stypvar(1)%savelog10= 0. stypvar(1)%clong_name='Barotropic_Merid_HeatTransport' stypvar(1)%cshort_name='zobtmhta' stypvar(1)%conline_operation='N/A' stypvar(1)%caxis='TY' stypvar(2)%cname= 'zoshmhta' stypvar(2)%cunits='PetaWatt' stypvar(2)%rmissing_value=99999. stypvar(2)%valid_min= -1000. stypvar(2)%valid_max= 1000. stypvar(2)%scale_factor= 1. stypvar(2)%add_offset= 0. stypvar(2)%savelog10= 0. stypvar(2)%clong_name='GeoShear_Merid_HeatTransport' stypvar(2)%cshort_name='zoshmhta' stypvar(2)%conline_operation='N/A' stypvar(2)%caxis='TY' stypvar(3)%cname= 'zoagmhta' stypvar(3)%cunits='PetaWatt' stypvar(3)%rmissing_value=99999. stypvar(3)%valid_min= -1000. stypvar(3)%valid_max= 1000. stypvar(3)%scale_factor= 1. stypvar(3)%add_offset= 0. stypvar(3)%savelog10= 0. stypvar(3)%clong_name='Ageo_Merid_HeatTransport' stypvar(3)%cshort_name='zoagmhta' stypvar(3)%conline_operation='N/A' stypvar(3)%caxis='TY' stypvar(4)%cname= 'zomhtatl' stypvar(4)%cunits='PetaWatt' stypvar(4)%rmissing_value=99999. stypvar(4)%valid_min= -1000. stypvar(4)%valid_max= 1000. stypvar(4)%scale_factor= 1. stypvar(4)%add_offset= 0. stypvar(4)%savelog10= 0. stypvar(4)%clong_name='Meridional_HeatTransport_Atlantic' stypvar(4)%cshort_name='zomhtatl' stypvar(4)%conline_operation='N/A' stypvar(4)%caxis='TY' ipk_gsop(1) = npk ipk_gsop(2) = npk ipk_gsop(3) = npk ipk_gsop(4) = npk ! Allocate arrays ALLOCATE ( zmask(jpbasins,npiglo,npjglo) ) ALLOCATE ( tmask(npiglo,npjglo) ) ALLOCATE ( tmaskz(npiglo,npjglo,npk) ) ALLOCATE ( umask(npiglo,npjglo) ) ALLOCATE ( vmask(npiglo,npjglo) ) ALLOCATE ( vmaskz(npiglo,npjglo,npk) ) ALLOCATE ( zv(npiglo,npjglo) ) ALLOCATE ( vfull(npiglo,npjglo,npk) ) ALLOCATE ( zt(npiglo,npjglo), zt_v(npiglo,npjglo) ) ! temperature au point T et au point V ALLOCATE ( tfull(npiglo,npjglo,npk) ) ! temperature au point V ALLOCATE ( e1u(npiglo,npjglo),e1v(npiglo,npjglo),e3v(npiglo,npjglo), gphiv(npiglo,npjglo) ,gdepw(npk) ) ALLOCATE ( Hdep(npiglo,npjglo), vbt(npiglo,npjglo) ) ALLOCATE ( e3vz(npiglo,npjglo,npk) ) ALLOCATE ( zomhtfull(jpbasins,npjglo,npk) ) ALLOCATE ( zomht(jpbasins, npjglo) ) ALLOCATE ( zomht_gsop(jpgsop, npjglo) ) ALLOCATE ( btht(npjglo,npk) ) ALLOCATE ( zsal(npiglo,npjglo), zsig0(npiglo,npjglo) ) ALLOCATE ( deptht(npk) ) ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo)) ALLOCATE ( zzmask(npiglo,npjglo) ) ALLOCATE ( vgeo(npiglo,npjglo,npk) ) ALLOCATE ( vgeoz(npiglo,npjglo) ) ALLOCATE ( vgeosh(npiglo,npjglo,npk) ) ALLOCATE ( zomht_geos_full(npjglo,npk) ) ALLOCATE ( vageosh(npiglo,npjglo,npk) ) ALLOCATE ( zomht_ageos_full(npjglo,npk) ) e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo) e1u(:,:) = getvar(coordhgr, 'e1u', 1,npiglo,npjglo) gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo) deptht(:) = getvare3(coordzgr, 'gdept',npk) gdepw(:) = getvare3(coordzgr, 'gdepw',npk) gdepw(:) = -1.* gdepw(:) iloc=maxloc(gphiv) dumlat(1,:) = gphiv(iloc(1),:) dumlon(:,:) = 0. ! set the dummy longitude to 0 ! create output fileset ncout =create(cfileoutnc, cfilev,1,npjglo,1,cdep='depthw') ierr= createvar(ncout ,stypvar,jpgsop, ipk_gsop,id_varout_gsop ) ierr= putheadervar(ncout, cfilev,1, npjglo,1,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw) tim=getvar1d(cfilev,'time_counter',1) ierr=putvar1d(ncout,tim,1,'T') ! reading the masks ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif zmask=0 zmask(1,:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo) IF (llglo) THEN zmask(2,:,:)=getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo) zmask(4,:,:)=getvar(cbasinmask,'tmaskind',1,npiglo,npjglo) zmask(5,:,:)=getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo) zmask(3,:,:)=zmask(5,:,:)+zmask(4,:,:) ! ensure that there are no overlapping on the masks WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1 ELSE zmask(2,:,:)=getvar('mask.nc','tmask',1,npiglo,npjglo) ENDIF ! initialize mht to 0 zomht(:,:) = 0. zomhtfull(:,:,:) = 0. zomht_gsop(:,:) = 0. vbt(:,:) = 0.0 Hdep(:,:) = 0.0 btht(:,:) = 0.0 vgeo(:,:,:)=0.0 vfull(:,:,:)=0.0 tfull(:,:,:)=0.0 ! Constants for geostrophic calc rau0 = 1025.0 grav = 9.81 rpi = 3.14159 f0 = 2.0*(2.0*rpi)/(24.0*3600.0) ! Get velocities v and temperature T and e3v_ps and masks at all levels DO jk = 1,npk vmask(:,:)=getvar('mask.nc','vmask',jk,npiglo,npjglo) vmaskz(:,:,jk) = vmask(:,:) tmask(:,:)=getvar('mask.nc','tmask',jk,npiglo,npjglo) tmaskz(:,:,jk) = tmask(:,:) zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo) ! au point V vfull(:,:,jk) = zv(:,:) ! au point V zt(:,:)= getvar(cfilet, 'votemper', jk,npiglo,npjglo) ! au point T DO ji = 1,npiglo ! mettre la temperature au point V DO jj = 1,npjglo-1 zt_v(ji,jj)= ((zt(ji,jj) + zt(ji,jj+1)) * tmask(ji,jj) * tmask(ji,jj+1))/2 END DO END DO tfull(:,:,jk)= zt_v(:,:) ! au point V e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo) e3vz(:,:,jk) = e3v(:,:) ENDDO !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! CALCUL OF THE TOTAL MHT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DO jk = 1,npk-1 ! MHT totale au point V ! integrates 'zonally' (along i-coordinate) DO ji=1,npiglo ! For all basins DO jbasin = 1, jpbasins DO jj=1,npjglo zomhtfull(jbasin,jj,jk) = zomhtfull(jbasin,jj,jk) + vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(jbasin,ji,jj)*vfull(ji,jj,jk)*tfull(ji,jj,jk)*rho0*rcp/1.e15 ENDDO ! loop to next latitude END DO ! loop to next basin END DO ! loop to next longitude ENDDO ! loop to next level ! integrates vertically from bottom to surface the total MHT DO jk=npk , 1 , -1 zomht(:,:) = zomht(:,:) + zomhtfull(:,:,jk) END DO ! loop to next level ! Save variable in zomht_gsop zomht_gsop(4,:) = zomht(2,:) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! CALCUL OF THE BAROTROPIC MHT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Calculate ATLANTIC Barotropic velocity au point V DO jk = 1,npk-1 DO ji=1,npiglo DO jj=1,npjglo vbt(ji,jj) = vbt(ji,jj) + e3vz(ji,jj,jk)*zmask(2,ji,jj)*vfull(ji,jj,jk)*vmaskz(ji,jj,jk) ! hardwire to jbasin=2 Hdep(ji,jj) = Hdep(ji,jj) + e3vz(ji,jj,jk)*zmask(2,ji,jj)*vmaskz(ji,jj,jk) ENDDO ! loop to next latitude ENDDO ! loop to next longitude ENDDO ! loop to next level ! Normalize Barotropic velocity DO ji=1,npiglo DO jj=1,npjglo IF ( Hdep(ji,jj) > 0.0 ) THEN vbt(ji,jj) = vbt(ji,jj)/Hdep(ji,jj) ELSE IF ( vbt(ji,jj) /= 0.0 ) THEN print *, 'Is something wrong?, ji,jj=',ji,jj ENDIF vbt(ji,jj) = 0.0 ENDIF ENDDO ! loop to next latitude ENDDO ! loop to next longitude ! Integrate zonally the barotropic velocity DO jk=1, npk DO jj=1,npjglo DO ji=1,npiglo btht(jj,jk) = btht(jj,jk) + vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vbt(ji,jj)*tfull(ji,jj,jk)*rho0*rcp/1.e15 ENDDO ENDDO ENDDO ! Now Integrate vertically to get Barotropic Meridional Heat Transport DO jk=npk , 1 , -1 zomht_gsop(1,:)=zomht_gsop(1,:) + btht(:,jk) END DO ! loop to next level !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! CALCUL OF THE GEOSTROPHIC MHT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! reinitialiser la temperature au point T a 0 zt(:,:)=0.0 DO jk = 1,npk-1 ! Calculate density !! attention, density est au point U, il faut la mettre au point V zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo) zt(:,:)= getvar(cfilet, 'votemper', jk,npiglo,npjglo) ! au point T zzmask=1 WHERE(zsal(:,:)* zmask(2,:,:) == 0 ) zzmask = 0 ! geostrophic calculation must use in situ density gradient ! la il faut prendre la temperature au point T zsig0(:,:) = sigmai ( zt,zsal,deptht(jk),npiglo,npjglo )* zzmask(:,:) ! Calculate Geostrophic velocity ! value at v points is average of values at u points DO ji = 2, npiglo-1 DO jj = 2, npjglo-1 IF ( gphiv(ji,jj) == 0.0 ) THEN vgeo(ji,jj,jk) = 0.0 ELSE zmsv = 1. / MAX( tmaskz(ji ,jj+1,jk)*tmaskz(ji-1,jj+1,jk) + tmaskz(ji+1,jj+1,jk)*tmaskz(ji ,jj+1,jk) & + tmaskz(ji, jj ,jk)*tmaskz(ji-1,jj ,jk) + tmaskz(ji+1,jj ,jk)*tmaskz(ji ,jj ,jk) , 1. ) zphv = ( zsig0(ji ,jj+1) - zsig0(ji-1,jj+1) ) * tmaskz(ji ,jj+1,jk)*tmaskz(ji-1,jj+1,jk) / e1u(ji-1,jj+1) & + ( zsig0(ji+1,jj+1) - zsig0(ji ,jj+1) ) * tmaskz(ji+1,jj+1,jk)*tmaskz(ji ,jj+1,jk) / e1u(ji ,jj+1) & + ( zsig0(ji ,jj ) - zsig0(ji-1,jj ) ) * tmaskz(ji ,jj ,jk)*tmaskz(ji-1,jj ,jk) / e1u(ji-1,jj ) & + ( zsig0(ji+1,jj ) - zsig0(ji ,jj ) ) * tmaskz(ji+1,jj ,jk )*tmaskz(ji ,jj ,jk) / e1u(ji ,jj ) zphv = (1. / rau0) * zphv * zmsv * vmaskz(ji,jj,jk) fcor = f0*SIN(rpi*gphiv(ji,jj)/180.0) vgeo(ji,jj,jk) = -grav*zphv/fcor*e3vz(ji,jj,jk)*zmask(2,ji,jj) ENDIF ENDDO ! loop to next latitude ENDDO ! loop to next longitude ENDDO ! loop to next level ! Vertical shear-velocity: Remove vertical average vgeoz(:,:) = 0.0 vgeosh(:,:,:)=0.0 DO ji=1, npiglo DO jj = 1, npjglo ! Integrate vertically to get geostrophic velocity referenced to bottom DO jk = npk-1,1,-1 vgeo(ji,jj,jk) = vgeo(ji,jj,jk+1) + vgeo(ji,jj,jk) ENDDO ! Calculate vertical sum DO jk = 1, npk vgeoz(ji,jj) = vgeoz(ji,jj) + vgeo(ji,jj,jk)*zmask(2,ji,jj)*e3vz(ji,jj,jk)*vmaskz(ji,jj,jk) ENDDO ! Remove total depth to get vertical mean IF ( Hdep(ji,jj) > 0.0 ) THEN vgeoz(ji,jj) = vgeoz(ji,jj)/Hdep(ji,jj) ELSE vgeoz(ji,jj) = 0.0 ENDIF ! Remove vertical mean from geostrophic velocity to get geostrophic vertical shear velocity. DO jk = 1, npk vgeosh(ji,jj,jk) = zmask(2,ji,jj)*vgeo(ji,jj,jk) - vgeoz(ji,jj) ENDDO ENDDO ! loop to next latitude ENDDO ! loop to next longitude ! Calculate vertical shear MHT - integrate over x zomht_geos_full(:,:) = 0.0 DO jk=1, npk DO jj=1,npjglo DO ji=1,npiglo zomht_geos_full(jj,jk) = zomht_geos_full(jj,jk) + & & vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vgeosh(ji,jj,jk)*tfull(ji,jj,jk)*rho0*rcp/1.e15 END DO ENDDO ENDDO ! Integrate vertically the geostrophic MHT DO jk=npk , 1 , -1 zomht_gsop(2,:) = zomht_gsop(2,:) + zomht_geos_full(:,jk) END DO ! loop to next level !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! CALCUL OF THE AGEOSTROPHIC MHT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! vageosh(:,:,:)=0.0 ! Calculate Vageostrophique au point V DO jk=1,npk vageosh(:,:,jk)=vfull(:,:,jk)-vgeosh(:,:,jk)-vbt(:,:) END DO ! Calculate vertical shear ageostrophique streamfunction - integrate over x zomht_ageos_full(:,:) = 0.0 DO jk=1, npk DO jj=1,npjglo DO ji=1,npiglo zomht_ageos_full(jj,jk) = zomht_ageos_full(jj,jk) + vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vageosh(ji,jj,jk)*tfull(ji,jj,jk)*rho0*rcp/1.e15 END DO ENDDO ENDDO ! Now Integrate vertically to get streamfunction AGEOSTROPHIE DO jk=npk , 1 , -1 zomht_gsop(3,:) = zomht_gsop(3,:) + zomht_ageos_full(:,jk) END DO ! loop to next level ! ! integrates vertically from bottom to surface the total MHT ! DO jk=npk-1 , 1 , -1 ! zomht(:,:,jk) = zomht(:,:,jk+1) + zomht(:,:,jk) ! END DO ! loop to next level ! ! Normalize Barotropic velocity ! DO ji=1,npiglo ! DO jj=1,npjglo ! IF ( Hdep(ji,jj) > 0.0 ) THEN ! vbt(ji,jj) = vbt(ji,jj)/Hdep(ji,jj) ! ELSE ! IF ( vbt(ji,jj) /= 0.0 ) THEN ! print *, 'Is something wrong?, ji,jj=',ji,jj ! ENDIF ! vbt(ji,jj) = 0.0 ! ENDIF ! END DO ! ENDDO ! ! Calculate Barotropic Meridional Heat Transport - integrate over x ! DO jk=1, npk ! DO jj=1,npjglo ! DO ji=1,npiglo ! btht(jj,jk) = btht(jj,jk) - vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vbt(ji,jj)*ztfull(ji,jj,jk)/1.e15 ! END DO ! ENDDO ! ENDDO ! Now Integrate vertically to get Barotropic Meridional Heat Transport ! DO jk=npk-1 , 1 , -1 ! btht(:,jk) = btht(:,jk+1) + btht(:,jk) ! END DO ! loop to next level ! ! Calculate Vageostrophique au point V ! DO jk=1,npk ! vageosh(:,:,jk)=vfull(:,:,jk)-vgeosh(:,:,jk)-vbt(:,:) ! END DO ! ! Calculate vertical shear ageostrophique streamfunction - integrate over x ! DO jk=1, npk ! DO jj=1,npjglo ! DO ji=1,npiglo ! zomht_gsop(3,jj,jk) = zomht_gsop(3,jj,jk) - vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vageosh(ji,jj,jk)*ztfull(ji,jj,jk)/1.e15 ! END DO ! ENDDO ! ENDDO ! ! Now Integrate vertically to get streamfunction AGEOSTROPHIE ! DO jk=npk-1 , 1 , -1 ! zomht_gsop(3,:,jk) = zomht_gsop(3,:,jk+1) + zomht_gsop(3,:,jk) ! END DO ! loop to next level ! ! Save variables in zomht_gsop ! zomht_gsop(1,:,:) = btht(:,:) ! zomht_gsop(4,:,:) = zomht(2,:,:) jj = 190 FIND26: DO jj=1,npjglo IF ( dumlat(1,jj) > 26.0 ) EXIT FIND26 ENDDO FIND26 print *, 'MHT:zomht_gsop(4,jj) = ', zomht_gsop(4,jj) print *, 'BT:zomht_gsop(1,jj) = ', zomht_gsop(1,jj) print *, 'SH:zomht_gsop(2,jj) = ', zomht_gsop(2,jj) print *, 'AG:zomht_gsop(3,jj) = ', zomht_gsop(3,jj) !--------------------------------- ! netcdf output !--------------------------------- !print *, 'Writing netcdf...' DO jgsop = 1, jpgsop ierr = putvar (ncout, id_varout_gsop(jgsop),REAL(zomht_gsop(jgsop,:)), 1,1,npjglo) ENDDO ierr = closeout(ncout) END PROGRAM cdfmht_gsop cdftools-3.0/cdfdifmask.f900000644000175000017500000001113412241227304016733 0ustar amckinstryamckinstryPROGRAM cdfdifmask !!====================================================================== !! *** PROGRAM cdfdifmask *** !!===================================================================== !! ** Purpose : Build the difference between 2 mask files !! !! !! History : 2.1 : ?????? : ??? : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jvar ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! browsing command line INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(4) :: ipk ! outptut variables : levels, INTEGER(KIND=4), DIMENSION(4) :: id_varout ! ncdf varid's REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, zmask2 ! 2D mask at current level REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! dummy time variable CHARACTER(LEN=256) :: cf_out='mask_diff.nc' ! Output file name CHARACTER(LEN=256) :: cf_msk1, cf_msk2 ! name of input files CHARACTER(LEN=256) :: cv_in ! variable name TYPE(variable), DIMENSION(4) :: stypvar ! data structure LOGICAL :: lchk ! checking file existence !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfdifmask mask1 mask2' PRINT *,' PURPOSE :' PRINT *,' Compute the difference between 2 mask files.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' mask1, mask2 : model files to be compared.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : tmask, umask, vmask, fmask' STOP ENDIF CALL getarg (1, cf_msk1) CALL getarg (2, cf_msk2) lchk = chkfile ( cf_msk1 ) lchk = lchk .OR. chkfile ( cf_msk2 ) IF ( lchk ) STOP ! missing file npiglo = getdim (cf_msk1, cn_x) npjglo = getdim (cf_msk1, cn_y) npk = getdim (cf_msk1, 'z' ) ! mask file have a z depth dim instead of depth ... ipk(:) = npk stypvar(:)%cunits = '1/0' stypvar(:)%rmissing_value = 9999. stypvar(:)%valid_min = 0. stypvar(:)%valid_max = 1. stypvar(:)%conline_operation = 'N/A' stypvar(:)%caxis = 'TZYX' stypvar(:)%cprecision = 'by' stypvar(1)%cname='tmask' ; stypvar(1)%clong_name='tmask' ; stypvar(1)%cshort_name='tmask' stypvar(2)%cname='umask' ; stypvar(2)%clong_name='umask' ; stypvar(2)%cshort_name='umask' stypvar(3)%cname='vmask' ; stypvar(3)%clong_name='vmask' ; stypvar(3)%cshort_name='vmask' stypvar(4)%cname='fmask' ; stypvar(4)%clong_name='fmask' ; stypvar(4)%cshort_name='fmask' ncout = create (cf_out, cf_msk1, npiglo, npjglo, npk, cdep='z', cdepvar='nav_lev') ierr = createvar (ncout, stypvar, 4, ipk, id_varout ) ierr = putheadervar(ncout, cf_msk1, npiglo, npjglo, npk, cdep='nav_lev' ) ALLOCATE (zmask(npiglo,npjglo), zmask2(npiglo,npjglo)) DO jvar=1,4 cv_in = stypvar(jvar)%cname PRINT *, ' making difference for ', TRIM(cv_in) DO jk=1, npk PRINT * ,'jk = ', jk zmask(:,:) = getvar(cf_msk1, cv_in, jk, npiglo, npjglo) zmask2(:,:) = getvar(cf_msk2, cv_in, jk, npiglo, npjglo) zmask(:,:) = zmask2(:,:) - zmask(:,:) ierr = putvar(ncout, id_varout(jvar), zmask, jk, npiglo, npjglo) END DO ! loop to next level END DO tim(:) = 0. ierr = putvar1d(ncout, tim, 1, 'T') ierr = closeout(ncout) END PROGRAM cdfdifmask cdftools-3.0/cdfcoastline.f900000644000175000017500000001050612241227304017300 0ustar amckinstryamckinstryPROGRAM cdfcofpoint !!------------------------------------------------------------------- !! *** PROGRAM cdfmean *** !! !! ** Purpose : Compute distance of first coast in grid point !! Determine the edge of a mask (for further use !! with iceshelf parametrization) !! !! ** Method : long iterative method (check furtehr time all mask point) !! !! !! history ; !! Original : P. Mathiot (June, 2009) !!------------------------------------------------------------------- !! * Modules used USE cdfio !! * Local variables IMPLICIT NONE INTEGER :: npiglo, npjglo, npk, nt, npi, npj !: size of the domain INTEGER :: ji, jj, jk, jt, i INTEGER :: imin=0, imax=0, jmin=0, jmax=0 !: domain limitation for computation INTEGER :: kmin=0, kmax=0 !: domain limitation for computation INTEGER :: narg, iargc !: command line REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, mask, mask_out !: npiglo x npjglo CHARACTER(LEN=256) :: cfile, cldum CHARACTER(LEN=256) :: cmask='mask.nc' ! output stuff INTEGER, DIMENSION(1) :: ipk, id_varout TYPE(variable), DIMENSION(1) :: stypvar REAL(KIND=4) ,DIMENSION(1) :: timean CHARACTER(LEN=256) :: cfileout='pointcoast.nc' INTEGER :: ncout, ierr narg= iargc() IF ( narg == 0 ) THEN PRINT *,' Usage : cdfmean filemask [imin imax jmin jmax kmin kmax] ' PRINT *,' imin imax jmin jmax kmin kmax can be given in option ' PRINT *,' if imin = 0 then ALL i are taken' PRINT *,' if jmin = 0 then ALL j are taken' PRINT *,' if kmin = 0 then ALL k are taken' PRINT *,' output file is pointcoast.nc ' STOP ENDIF CALL getarg (1, cfile) npi= getdim (cfile,'x') npj= getdim (cfile,'y') npk = getdim (cfile,'depth') nt = getdim (cfile,'time') imin=1; jmin=1; jmax=npj; imax=npi IF (narg > 3 ) THEN IF ( narg /= 5 ) THEN PRINT *, ' ERROR : You must give 6 optional values (imin imax jmin jmax kmin kmax)' STOP ELSE ! input optional imin imax jmin jmax CALL getarg ( 2,cldum) ; READ(cldum,*) imin CALL getarg ( 3,cldum) ; READ(cldum,*) imax CALL getarg ( 4,cldum) ; READ(cldum,*) jmin CALL getarg ( 5,cldum) ; READ(cldum,*) jmax ENDIF ENDIF IF (npk == 0 ) THEN ; npk = 1 ; ENDIF ! no depth dimension ==> 1 level IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF IF (kmin /= 0 ) THEN ; npk =kmax -kmin + 1; ELSE ; kmin=1 ; ENDIF WRITE(6, *) 'npiglo=', npiglo WRITE(6, *) 'npjglo=', npjglo WRITE(6, *) 'npi =', npi WRITE(6, *) 'npj =', npj WRITE (6,*) 'npk =', npk WRITE (6,*) 'nt =', nt ! Allocate arrays ALLOCATE ( zmask(npi,npj), mask_out(npi,npj), mask(npi,npj) ) mask_out(:,:)=0 mask(:,:)= getvar(cfile, 'tmask', 1 ,npi,npj) i=0 DO WHILE ( SUM(mask(imin+1:imax-1,jmin+1:jmax-1)) .NE. 0 ) i=i+1 zmask=0 IF (MOD(i,10)==0) PRINT *, 'i = ',i, ' SUM(mask) = ',SUM(mask(imin+1:imax-1,jmin+1:jmax-1)) DO ji=imin+1,imax-1 DO jj=jmin+1,jmax-1 IF ((mask(ji,jj)==0) .AND. (mask_out(ji,jj)==i-1)) THEN IF (mask(ji+1,jj )==1) zmask(ji+1,jj )=1 IF (mask(ji ,jj-1)==1) zmask(ji ,jj-1)=1 IF (mask(ji-1,jj )==1) zmask(ji-1,jj )=1 IF (mask(ji ,jj+1)==1) zmask(ji ,jj+1)=1 END IF END DO END DO WHERE (zmask==1) mask=0 WHERE (zmask==1) mask_out=i END DO ! prepare file output ipk(1) = 1 stypvar(1)%cname='pointcoast' stypvar(1)%cunits='px' stypvar(1)%rmissing_value=0 stypvar(1)%valid_min= 1. stypvar(1)%valid_max= i stypvar(1)%clong_name='pointcoast' stypvar(1)%cshort_name='pointcoast' stypvar(1)%conline_operation='N/A' stypvar(1)%caxis='TZYX' stypvar(1)%cprecision='r4' PRINT *,' CREATE ...' ncout=create(cfileout, cfile,npi,npj,1) PRINT *,' CREATEVAR ...' ierr= createvar(ncout ,stypvar,1, ipk,id_varout ) PRINT *,' PUTHEADERVAR ...' ierr= putheadervar(ncout, cfile, npi,npj,npk) ierr=putvar(ncout,id_varout(1),mask_out,1,npi,npj) timean(:)=0. ierr=putvar1d(ncout,timean,1,'T') ierr = closeout(ncout) END PROGRAM cdfcofpoint cdftools-3.0/cdfbci.f900000644000175000017500000002111312241227304016050 0ustar amckinstryamckinstryPROGRAM cdfbci !!====================================================================== !! *** PROGRAM cdfbci *** !!===================================================================== !! ** Purpose : Compute the term of energetic transfert BCI !! for the baroclinic instability !! !! ** Method : take an input file which is the result of a preprocessing !! tool cdfmoyuvwt. !! !! History : 2.1 : 02/2008 : A. Melet : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk INTEGER(KIND=4) :: ilev INTEGER(KIND=4) :: npiglo, npjglo, npk, npt INTEGER(KIND=4) :: narg, iargc INTEGER(KIND=4) :: ncout, ierr INTEGER(KIND=4), DIMENSION(5) :: ipk, id_varout ! REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2t, e1t REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: anout, anovt, un, vn, tn REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: utn, vtn REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask, umask, vmask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: bci REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdtdx, rdtdy CHARACTER(LEN=256) :: cf_in CHARACTER(LEN=256) :: cf_out='bci.nc' TYPE (variable), DIMENSION(5) :: stypvar !: structure for attibutes !!---------------------------------------------------------------------- CALL ReadCdfNames() ! load cdf variable name narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfbci UVWT-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute elements for analysing the baroclinic instability' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' UVWT-file : input file is produced by cdfmoyuvwt, and the mean' PRINT *,' must be computed on a long-enough period for the ' PRINT *,' statistics to be meaningful. Points are on T grid.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' Need ', TRIM(cn_fhgr) ,' file' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : 5 output variables' PRINT *,' dTdx : zonal derivative of Tbar on T point (*1000)' PRINT *,' dTdy : meridional derivative of Tbar on T point (*1000)' PRINT *,' uT : anomaly of u times anomaly of T on T point' PRINT *,' vT : anomaly of v times anomaly of T on T point' PRINT *,' bci : transfert of energy for the baroclinic instability (*1000)' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfmoyuvwt ' STOP ENDIF CALL getarg(1, cf_in) IF (chkfile(cf_in) .OR. chkfile (cn_fhgr) ) STOP npiglo = getdim(cf_in, cn_x) npjglo = getdim(cf_in, cn_y) npk = getdim(cf_in, cn_z) npt = getdim(cf_in, cn_t) PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt ! define new variables for output ( must update att.txt) stypvar(1)%cname = 'dTdx' stypvar(1)%clong_name = 'zonal derivate of Tbar on T point (*1000)' stypvar(1)%cshort_name = 'dTdx' stypvar(2)%cname = 'dTdy' stypvar(2)%clong_name = 'meridional derivate of Tbar on T point (*1000)' stypvar(2)%cshort_name = 'dTdy' stypvar(3)%cname = 'uT' stypvar(3)%clong_name = 'anomaly of u times anomaly of T on T point' stypvar(3)%cshort_name = 'uT' stypvar(4)%cname = 'vT' stypvar(4)%clong_name = 'anomaly of v times anomaly of T on T point' stypvar(4)%cshort_name = 'vT' stypvar(5)%cname = 'bci' stypvar(5)%clong_name = 'transfert of energy for the baroclinic instability (*1000)' stypvar(5)%cshort_name = 'bci' stypvar%cunits = '1000 (u"T" dT/dx + v"T" dT/dy)' stypvar%rmissing_value = 0. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' ipk(:) = npk !test if lev exists IF ((npk==0) .AND. (ilev > 0) ) THEN PRINT *, 'Problem : npk = 0 and lev > 0 STOP' STOP END IF ! create output fileset ncout = create (cf_out, cf_in, npiglo, npjglo, npk ) ierr = createvar (ncout , stypvar, 5, ipk, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk ) ! Allocate the memory ALLOCATE ( e1t(npiglo,npjglo) , e2t(npiglo,npjglo) ) ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) ) ALLOCATE ( tn(npiglo,npjglo) ) ALLOCATE ( utn(npiglo,npjglo) , vtn(npiglo,npjglo) ) ALLOCATE ( umask(npiglo,npjglo) , vmask(npiglo,npjglo) ) ALLOCATE ( tmask(npiglo,npjglo) ) ALLOCATE ( rdtdx(npiglo,npjglo) , rdtdy(npiglo,npjglo) ) ALLOCATE ( anout(npiglo,npjglo) , anovt(npiglo,npjglo) ) ALLOCATE ( bci(npiglo,npjglo), tim(npt) ) e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) tim = getvar1d(cf_in, cn_vtimec, npt) ierr = putvar1d(ncout, tim, npt, 'T') DO jk=1, npk PRINT *,' level ',jk rdtdx(:,:) = 0.0 rdtdy(:,:) = 0.0 anovt(:,:) = 0.0 anout(:,:) = 0.0 un(:,:) = getvar(cf_in, 'ubar', jk ,npiglo, npjglo, ktime=1) vn(:,:) = getvar(cf_in, 'vbar', jk ,npiglo, npjglo, ktime=1) tn(:,:) = getvar(cf_in, 'tbar', jk ,npiglo, npjglo, ktime=1) utn(:,:) = getvar(cf_in, 'utbar', jk ,npiglo, npjglo, ktime=1) vtn(:,:) = getvar(cf_in, 'vtbar', jk ,npiglo, npjglo, ktime=1) ! compute the mask DO jj = 2, npjglo DO ji = 2, npiglo umask(ji,jj)= un(ji,jj)*un(ji-1,jj) vmask(ji,jj)= vn(ji,jj)*vn(ji,jj-1) tmask(ji,jj)= tn(ji,jj) IF (umask(ji,jj) /= 0.) umask(ji,jj)=1. IF (vmask(ji,jj) /= 0.) vmask(ji,jj)=1. IF (tmask(ji,jj) /= 0.) tmask(ji,jj)=1. END DO END DO DO jj = 2, npjglo DO ji = 2, npiglo ! vector opt. ! compute derivatives at T point rdtdx(ji,jj) = 1000/2. *( ( tn(ji,jj ) - tn(ji-1,jj) ) & & * tmask(ji,jj)*tmask(ji-1,jj) & & / ( 0.5* ( e1t(ji,jj) + e1t(ji-1,jj) )) & & +( tn(ji+1,jj ) - tn(ji,jj) ) & & * tmask(ji+1,jj)*tmask(ji,jj) & & / ( 0.5* ( e1t(ji+1,jj) + e1t(ji,jj) ))) rdtdy(ji,jj) = 1000/2. *( ( tn(ji,jj) - tn(ji,jj-1) ) & & * tmask(ji,jj)*tmask(ji,jj-1) & & / ( 0.5* ( e2t(ji,jj) + e2t(ji,jj-1) )) & & +( tn(ji,jj+1 ) - tn(ji,jj) ) & & * tmask(ji,jj+1)*tmask(ji,jj) & & / ( 0.5* ( e2t(ji,jj+1) + e2t(ji,jj) )) ) anout(ji,jj) = ( utn(ji,jj) & & - 1/2 * umask(ji,jj)*( un(ji,jj) + un(ji-1,jj) ) & & * tmask(ji,jj) * tn(ji,jj) ) anovt(ji,jj) = ( vtn(ji,jj) & & - 1/2 * vmask(ji,jj)*( vn(ji,jj) + vn(ji,jj-1) ) & & * tmask(ji,jj) * tn(ji,jj) ) ! compute bci term bci(ji,jj) = ( anout(ji,jj) * rdtdx(ji,jj) + anovt(ji,jj) * rdtdy(ji,jj) ) END DO END DO ! ierr = putvar(ncout, id_varout(1), rdtdx, jk, npiglo, npjglo, ktime=1) ierr = putvar(ncout, id_varout(2), rdtdy, jk, npiglo, npjglo, ktime=1) ierr = putvar(ncout, id_varout(3), anout, jk, npiglo, npjglo, ktime=1) ierr = putvar(ncout, id_varout(4), anovt, jk, npiglo, npjglo, ktime=1) ierr = putvar(ncout, id_varout(5), bci, jk, npiglo, npjglo, ktime=1) END DO ierr = closeout(ncout) END PROGRAM cdfbci cdftools-3.0/DOC/0000755000175000017500000000000012241227304014725 5ustar amckinstryamckinstrycdftools-3.0/DOC/cdfovide_guide.tex0000644000175000017500000001074712241227304020420 0ustar amckinstryamckinstry\documentclass[a4paper,11pt]{article} %\usepackage{epsf} \usepackage[latin1]{inputenc} %\usepackage{graphicx} %Check if we are compiling under latex or pdflatex \ifx\pdftexversion\undefined \usepackage[dvips]{graphicx} \else \usepackage[pdftex]{graphicx} \fi \advance\textwidth by 60pt \advance\oddsidemargin by -25pt \advance\evensidemargin by -25pt % \begin{document} \newcommand{\etal}{{\it et al.}} \newcommand{\DegN}{$^{\circ}$N} \newcommand{\DegW}{$^{\circ}$W} \newcommand{\DegE}{$^{\circ}$E} \newcommand{\DegS}{$^{\circ}$S} \newcommand{\Deg}{$^{\circ}$} \newcommand{\DegC}{$^{\circ}$C} \title{cdfovide : user manual} %\author{R. Dussin \thanks{Laboratoire de Physique des oceans, CNRS-Ifremer-UBO, Brest, France}, J.M. Molines \thanks{Laboratoire des Ecoulements Geophysiques et %Industriels, CNRS UMR 5519, Grenoble, France} } \author{R. Dussin, J.M. Molines} \maketitle \section{Introduction} cdfovide is part of a package called CDFTOOLS. About the install and common features of CDFTOOLS, please refer to CDFTOOLS documentation. This document explains briefly how to use it and some details of the code. The usage is : \begin{verbatim} cdfovide gridT gridU gridV \end{verbatim} \noindent The grid files \textbf{coordinates.nc} , \textbf{mesh\_hgr.nc} and \textbf{mesh\_zgr.nc} must be in your directory. \section{Some details of the code} The Ovide section is approximated by three legs defined such as : \begin{itemize} \item leg 1 : ( $43.0$ \DegW , $60.6$ \DegN ) to ( $31.3$ \DegW , $58.9$ \DegN ) \item leg 2 : ( $31.3$ \DegW , $58.9$ \DegN ) to ( $12.65$ \DegW , $40.33$ \DegN ) \item leg 3 : ( $12.65$ \DegW , $40.33$ \DegN ) to ( $8.7$ \DegW , $40.33$ \DegN ) \end{itemize} \noindent those values are hardcoded. However it is possible to change them in the code. It corresponds to the following lines : \begin{verbatim} !! We define what are the 3 segments of OVIDE section !! so that the user don't have to worry about it !! sec1 : (lonsta1,latsta1) -> (lonsta2,latsta2) !! and so on lonsta(1)=-43.0 lonsta(2)=-31.3 lonsta(3)=-12.65 lonsta(4)=-8.7 latsta(1)=60.6 latsta(2)=58.9 latsta(3)=40.33 latsta(4)=40.33 \end{verbatim} The model F gridpoints corresponding to the 4 ends ot the legs are computed using the same code as cdffindij. Then a broken line is computed using the same code as cdftransportiz. The indices of all the F-points are saved in the arrays isec and jsec. Their corresponding longitudes and latitudes are stored in nav\_lon and nav\_lat (NB : those are the lon and lat of the F points). If those arrays' size is $N$ (number of points), the others arrays' size is $N-1$ (number of segments). This is an example of the standard output with a ORCA025 run : \begin{verbatim} ------------------------------------------------------------ leg 1 start at -43.00N 60.60W and ends at -31.30N 58.90W corresponding to F-gridpoints( 986, 796) and (1026, 782) ------------------------------------------------------------ ------------------------------------------------------------ leg 2 start at -31.30N 58.90W and ends at -12.65N 40.33W corresponding to F-gridpoints(1026, 782) and (1098, 675) ------------------------------------------------------------ ------------------------------------------------------------ leg 3 start at -12.65N 40.33W and ends at -8.70N 40.33W corresponding to F-gridpoints(1098, 675) and (1114, 675) ------------------------------------------------------------ \end{verbatim} \noindent Once we have these list of F-gridpoints isec and jsec, we have to pick the values of $u$ or $v$ corresponding to the segment. If the segment is an horizontal one, we will pick a value for $v$ and $u=0$ and vice-versa. Hence the vozocrtx and vomecrty arrays in the output netcdf files will have empty lines, this is perfectly normal. We loop from F-point $1$ to $N-1$ and we define the current F-point as f(i,j). Four cases are investigated : \begin{itemize} \item horizontal segment, eastward : $v = v(i+1,j)$ and $u = 0$ \item horizontal segment, westward : $v = v(i,j)$ and $u = 0$ \item vertical segment, southward : $v = 0$ and $u = u(i,j)$ \item vertical segment, northward : $v = 0 $ and $u = u(i,j+1)$ \end{itemize} \noindent The $e1v$, $e2u$, $e3v$ and $e3u$ arrays are picked at the same points that $u$ and $v$. Also, $u = 0$ leads to $e2u = e3u = 0$ and vice-versa. The temperature and salinity are interpolated on the $u$ or $v$ point. In the bottom, if one value on the T-point is zero (land), the value is set to zero. \end{document}cdftools-3.0/DOC/cdftools_user.tex0000644000175000017500000051311312241227304020326 0ustar amckinstryamckinstry\documentclass[a4paper,11pt]{article} \usepackage[latin1]{inputenc} %\usepackage[a4paper=true,ps2pdf=true,pagebackref=true,breaklinks=true]{hyperref} \usepackage{makeidx} \makeindex % to use index, after a first compilation, run makeindex *.idx file % then command \printindex will incorporate the index in the latex file. %Check if we are compiling under latex or pdflatex \ifx\pdftexversion\undefined \usepackage[dvips]{graphicx} \else \usepackage[pdftex]{graphicx} \fi \setlength{\textwidth}{16.5 cm} \setlength{\textheight}{23.5 cm} \topmargin 0 pt \oddsidemargin 0 pt \evensidemargin 0 pt % \begin{document} \newcommand{\etal}{{\it et al.}} \newcommand{\DegN}{$^{\circ}$N} \newcommand{\DegW}{$^{\circ}$W} \newcommand{\DegE}{$^{\circ}$E} \newcommand{\DegS}{$^{\circ}$S} \newcommand{\Deg}{$^{\circ}$} \newcommand{\DegC}{$^{\circ}$C} \newcommand{\DS}{ \renewcommand{\baselinestretch}{1.8} \tiny \normalsize} \newcommand{\ST}{ \renewcommand{\baselinestretch}{1.2} \tiny \normalsize} \newcommand{\ao}{add\_offset} \newcommand{\SF}{scale\_factor} \title{CDFTOOLS: a fortran 90 package of programs and libraries for diagnostic of the DRAKKAR OPA9 output.\\ Part I : User Guide } \author{J.M. Molines \thanks{Laboratoire des Ecoulements G\'eophysiques et Industriels, CNRS UMR 5519, Grenoble, France}\ } \date{Last update: $ $Rev$ $ $ $Date$ $ } \maketitle \section*{Introduction} This document describes a set of programs written in Fortran 90, used as diagnostic tools for NEMO-OPA9 model output. This work has been initialized in the frame of the DRAKKAR project, where large model configuration are run. For this reason, a special care has been taken to minimize the required amount of memory. Also, most of the programs assume that the data base is DRAKKAR-like, which means with one file per snap-shot, cdf variable names etc... Shell scripts are also indicated as demo for how to use the programs. The user must carefully check all the variables in the scripts in order to ensure the compatibility with its own settings. The programs are sorted by category: Statistical (means, variance, RMS, EKE, etc ...), transport (mass, heat, salt), derived quantities (densities, Brunt Vaisala frequency, potential vorticity) and extracting/information tools (vertical profiles, position on the horizontal grid etc ...). This package is open, and in order to help for new developments, all the netcdf IO (at the IOIPSL standard) are collected in a unique module (cdfio.f90) which is used by the programs. In the same way the routines or functions concerning the equation of state of sea water are also collected into the module eos.f90. Developpers may read part II of this manual which is the programmer guide, where functions and subroutines included in these modules are described. \subsection*{Recently added tools} \begin{description} \item[cdflspv] : compute large scale potential vorticity (ie without relative vorticity) \item[cdfgeo-uv] : compute geostrophic velocities from SSH \item[cdfzeromean] : compute a zero-mean field. \item[cdfmoyuv cdfmoyuvwt cdfnrjcomp cdfkempemekeepe cdfbti cdfbci] : ask Ang\'elique ! \item[cdfisopycdep] : compute isoypcnal depths. \item[cdfsiginsitu] : compute in situ density. \item[cdfsigintegr] : compute integral of a quantity between isopycnal surfaces. \item[cdfvertmean] : compute vertical mean of a quantity between 2 horizontal levels. \item[cdfpendep] : compute penetration depth (ratio of surface concentration to inventory) for passive tracers. \item[cdfmoyt] : Just as cdfmoy but for instance, takes files with monthly fields (12) in it and return a monthly climatology. \item[cdflinreg] : Evaluates the linear trend on a time series of intput files, for each variables in the file. \item[cdfbuoyflx] : Evaluates the components of the fresh water flux, heat fluxes, and their respective buoyancy flux contribution. \item[cdfwflx] : Evaluates the components of the fresh water flux. \item[cdfmkmask] : Make a mask file from a standard gridT file using vosaline 0 values. \item[cdfspeed] : Compute the modulus of a velocity field (checked for forcing field only). \item[cdfmltmask] : Multiply a field by a mask: usefull for masking Levitus or forcing field. \item[cdfweight] : A tool to compute a weight file for further colocalisation. \item[cdfcoloc] : A tool to colocate model data on observed data, using a weight file fromCompute the modulus of a velocity field (checked for forcing field only). \item[cdfbathy] : A tool to modify and tune nemo bathymetry. \item[cdfstd] : Compute the standard deviation of variables from a series of files given as input. \item[cdfmoy\_annual] : Compute an annual mean from monthly means, applying weights to take into account that monthly mean were not computed with the same amount of data \item[cdfclip] : Save functionality than nckss but does not change the order of the variables. \item[cdfconvert] : Convert a set of dimg CLIPPER output file to DRAKKAR like netcdf file. \item[cdfflxconv] : Convert a set of fluxes dimgfile (Clipper like) to a set of CDF files (Drakkar like ) \item[cdf16bit] : Convert a standard 32bits model output file into a 16 bit file, using scale\_factor and add\_offset \item[cdfvita] : Compute surface ocean velocities components and module on the A-Grid (at T-points) from a opa C-grid input. \item[cdfmeanvar] : Compute spatial 3D mean as well as corresponding variance. \item[cdfstddevts] : Compute RMS for Temperature and Salinity. (goes together with cdfmoy\_sal2\_temp2). \item[cdfmax] : Display min/max for a variable in a file with location. \item[cdfmxlheatc] : Compute the Heat Content of the mixed layer ( J/m2). \item[cdfmxlsaltc] : Compute the Salt Content of the mixed layer (kg/m2) \item[cdfsigtrp] : Compute density class transport across a section. \item[cdfzoom] : Show an ASCII representation of a 2D (x-y, x-z or y-z) slab from any variable of an output file. \item[cdfmocsig] : Compute the MOC as a function of potential density ($\sigma_1$) \item[cdficediags]: Compute sea ice area, extent and volume from an icemod output \item[cdfzonalsum] : Compute the zonal sum of the variables in a file, may uses sub basins. (useful for tracer inventory, for instance). \end{description} \newpage \section{Statistics} \subsection*{\underline{cdfmoy:}} \addcontentsline{toc}{subsection}{cdfmoy} \index{cdfmoy} \begin{description} \item[Purpose:] Compute the mean fields for the file list given in argument. \item[Usage:] {\em cdfmoy nc\_files } \item[Input:] A list of homogeneous model output files ({\em e.g.: } xxx\_gridT.nc or xxx\_gridU.nc). \ For instance: cdfmoy ORCA025-G32\_y0010m10d??\_gridT.nc will compute the mean 'gridT' file for month 10 of year 10. \item[Required mesh\_mask files or other files:] none. \item[Output:] 2 files are produced : {\em cdfmoy.nc} and {\em cdfmoy2.nc}. {\em cdfmoy.nc} holds the mean fields for all the variables in the input files. {\em cdfmoy2.nc} holds the quadratic mean of some input variables (not all). In the current version, the quadratic mean for sossheig, vozocrtx, vomecrty, vovecrtz are saved. \item[Remark:] Assumes that land value are set to 0. \item[Associated script:] {\em cdfmoy.ll}: This script is used in the DRAKKAR project to calculate monthly means, quarterly means and annual means. This is a good example of how to use cdfmoy.\\ {\em cdfmoy-inter.ll}: This is a variant of the first script to compute inter-annual means. \end{description} \subsection*{\underline{cdfmoyt:}} \addcontentsline{toc}{subsection}{cdfmoyt} \index{cdfmoyt} \begin{description} \item[Purpose:] Compute the mean fields for the file list given in argument, not scanning individual files. \item[Usage:] {\em cdfmoyt nc\_files } \item[Input:] A list of homogeneous model output files ({\em e.g.: } xxx\_1m\_xxx.nc. \ For instance: cdfmoyt REYNOLDS\_SST\_1m\_1982.nc REYNOLDS\_SST\_1m\_1983.nc will compute a file with the average of the monthly field that are in the input files. \item[Required mesh\_mask files or other files:] none. \item[Output:] 2 files are produced : {\em cdfmoy.nc} and {\em cdfmoy2.nc}. {\em cdfmoy.nc} holds the mean fields for all the variables in the input files. {\em cdfmoy2.nc} holds the quadratic mean of some input variables (not all). In the current version, the quadratic mean for sossheig, vozocrtx, vomecrty, vovecrtz, sst are saved. \item[Remark:] Assumes that land value are set to 0. \end{description} \subsection*{\underline{cdfmoy\_mpp:}} \addcontentsline{toc}{subsection}{cdfmoy\_mpp} \index{cdfmoy\_mpp} \begin{description} \item[Purpose:] Compute the mean fields for the file list given in argument. This is a parallel version of cdfmoy (experimental). Paralelization is done across the tags. For the future, it may be probably more interesting do parallelize for the levels... \item[Usage:] {\em cdfmoy\_mpp nc\_files } \item[Input:] A list of homogeneous model output files ({\em e.g.: } xxx\_gridT.nc or xxx\_gridU.nc). \ \item[Required mesh\_mask files or other files:] none. \item[Output:] 2 files are produced : {\em cdfmoy.nc} and {\em cdfmoy2.nc}. {\em cdfmoy.nc} holds the mean fields for all the variables in the input files. {\em cdfmoy2.nc} holds the quadratic mean of some input variables (not all). In the current version, the quadratic mean for sossheig, vozocrtx, vomecrty, vovecrtz are saved. \item[Remark:] Assumes that land value are set to 0. \item[Associated script:] none \end{description} \subsection*{\underline{cdfmoy\_sp:}} \addcontentsline{toc}{subsection}{cdfmoy\_sp} \index{cdfmoy\_sp} \begin{description} \item[Purpose:] Compute the mean fields for the file list given in argument, just as in cdfmoy. The only difference is that land value (or missing values) are not necessarily 0. Useful when 0 have a physical meaning. \item[Usage:] {\em cdfmoy\_sp nc\_files } \item[Input:] A list of homogeneous model output files ({\em e.g.: } xxx\_gridT.nc or xxx\_gridU.nc). \ For instance: cdfmoy\_sp ORCA025-G32\_y0010m10d??\_gridT.nc will compute the mean 'gridT' file for month 10 of year 10. \item[Required mesh\_mask files or other files:] none \item[Output:] 2 files are produced : {\em cdfmoy.nc} and {\em cdfmoy2.nc}. {\em cdfmoy.nc} holds the mean fields for all the variables in the input files. {\em cdfmoy2.nc} holds the quadratic mean of some input variables (not all). In the current version, the quadratic mean for sossheig, vozocrtx, vomecrty, vovecrtz are saved. \item[Remark:] \item[Associated scripts:] {\em cdfmoy\_sp.ll}: This is an example where it is necessary to use cdfmoy\_sp instead of cdfmoy. \end{description} \subsection*{\underline{cdfmoy\_chsp:}} \addcontentsline{toc}{subsection}{cdfmoy\_chsp} \index{cdfmoy\_chsp} \begin{description} \item[Purpose:] Compute the mean fields for the file list given in argument, just as in cdfmoy. The only difference is that land value (or missing values) are not necessarily 0. Useful when 0 have a physical meaning. This version takes into account missing value from input files, but write results with missing value = 0 (as in drakkar runs). Usefull for reformating MERA data. \item[Usage:] {\em cdfmoy\_chsp nc\_files } \item[Input:] A list of homogeneous model output files ({\em e.g.: } xxx\_gridT.nc or xxx\_gridU.nc). \ For instance: cdfmoy\_chsp MERA11\_y0010m10d??\_gridT.nc will compute the mean 'gridT' file for month 10 of year 10. \item[Required mesh\_mask files or other files:] none \item[Output:] 2 files are produced : {\em cdfmoy.nc} and {\em cdfmoy2.nc}. {\em cdfmoy.nc} holds the mean fields for all the variables in the input files. {\em cdfmoy2.nc} holds the quadratic mean of some input variables (not all). In the current version, the quadratic mean for sossheig, vozocrtx, vomecrty, vovecrtz are saved. \item[Remark:] \item[Associated scripts:] none \end{description} \subsection*{\underline{cdfmoy\_sal2\_temp2:}} \addcontentsline{toc}{subsection}{cdfmoy\_sal2\_temp2} \index{cdfmoy\_sal2\_temp2} \begin{description} \item[Purpose:] As cdfmoy above: Compute the mean fields for the file list given in argument but additional quadratic means for temperature and salinity are kept in the output file, if they appear in the input file. \item[Usage:] {\em cdfmoy\_sal2\_temp2 nc\_files } \item[Input:] A list of homogeneous model output files ({\em e.g.: } xxx\_gridT.nc or xxx\_gridU.nc). \ For instance: cdfmoy ORCA025-G32\_y0010m10d??\_gridT.nc will compute the mean 'gridT' file for month 10 of year 10. \item[Required mesh\_mask files or other files:] none. \item[Output:] 2 files are produced : {\em cdfmoy.nc} and {\em cdfmoy2.nc}. {\em cdfmoy.nc} holds the mean fields for all the variables in the input files. {\em cdfmoy2.nc} holds the quadratic mean of some input variables (not all). In the current version, the quadratic mean for sossheig, votemper, vosaline, vozocrtx, vomecrty, vovecrtz are saved. \item[Remark:] Assumes that land value have are set to 0. If you have used this tools, it is likely that you want to compute temperature and salinity variability. See {\bf cdfstdts} \index{cdfstdevts} for this purpose. \item[Associated script:] You can adapt {\em cdfmoy.ll} and other for this case. Its almost the same. Only the content of the {\em cdfmoy2.nc} will differ. \end{description} \subsection*{\underline{cdfmoy\_annual:}} \addcontentsline{toc}{subsection}{cdfmoy\_annual} \index{cdfmoy\_annual} \begin{description} \item[Purpose:] Compute the mean fields for the file list given in argument. \item[Usage:] {\em cdfmoy\_annual 12 monthly mean files (DRAKKAR like)} \item[Input:] A list of homogeneous 12 monthly means. \item[Required mesh\_mask files or other files:] none. \item[Output:] 1 files are produced : {\tt cdfmoy\_annual.nc} \item[Remark:] Assumes that land value are set to 0. This program is usefull for calculating the annual mean from the monthly means calculated in DRAKKAR project. In this case, the weight applied to the months are 6 5 7 6 6 6 6 6 6 7. Anne-Marie claims that this may change the computation of water mass balances. \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfmoyuvwt:}} \addcontentsline{toc}{subsection}{cdfmoyuvwt} \index{cdfmoyuvwt} \begin{description} \item[Purpose:] Compute various time mean values for subsequent cdfbci or/and cdfbti. \item[Usage:] {\em cdfmoyuvwt config imin imax jmin jmax listoftags } \item[Input:] config is the conf-case name of the experiment, imin, imax, jmin, jmax, delimit a zoomed area, list of tags gives the time tags to take into account in the time mean computation. This program assumes that gridT, gridU gridV and gridW files for the given config and tags are present in the current directory. \item[Required mesh\_mask files or other files:] none. \item[Output:] 1 files are produced : {\tt moyuvwt.nc} This file contains 11 variables \begin{enumerate} \item {\bf ubar}:temporal mean of u on U point \item {\bf vbar}:temporal mean of v on V point \item {\bf u2bar}: temporal mean of u * u on U point \item {\bf v2bar}: temporal mean of v * v on V point \item {\bf uvbar}: temporal mean of u * v on T point \item {\bf wbar}: temporal mean of w on W point \item {\bf tbar}: temporal mean of T on T point (in K) \item {\bf utbar}: temporal mean of u * T (in K) on T point \item {\bf vtbar}: temporal mean of v * T (in K) on T point \item {\bf t2bar}: temporal mean of T * T (in $K^2$) on T point \item {\bf wtbar}: temporal mean of w * T (in $K$) on T point \end{enumerate} \item[Associated script:] none \item[Remark]: a cdfmoyuv program also exists, but is obsolete and replaced by this one. \item[Author]: An\'elique Melet, ask for details. \end{description} \newpage \subsection*{\underline{cdfmoy\_freq:}} \addcontentsline{toc}{subsection}{cdfmoy\_freq} \index{cdfmoy\_freq} \begin{description} \item[Purpose:] Compute time mean just as cdfmoy, but this program is adapted to deal with forcing files. It is designed for instance to compute monthly mean from a 6-hour forcing file \item[Usage:] {\em cdfmou\_freq forcing\_file out\_frequency} \item[Input:] Forcing file is given as input, and out\_frequency can be either {\em daily}, {\em monthly} or {\em annual}. \item[Required mesh\_mask files or other files:] none \item[Output:] Output netcdf file is cdfmoy\_daily or cdfmoy\_monthly or cdfmoy\_annual depending on the required output frequemcy. It contains the same variables than the input file. \item[Remark/bugs :] \item[Associated scripts:] \end{description} \newpage \subsection*{\underline{cdfmean:}} \addcontentsline{toc}{subsection}{cdfmean} \index{cdfmean} \begin{description} \item[Purpose:] Compute the mean value of a field, weighted by the local metric. If the variable is a 3D variable, the mean value is given for each level, then the global mean is printed. The mean value can be computed on a limited domain, specified on the command line. \item[Usage:] {\em cdfmean nc\_files nc\_var $T | U | V | F | W$ [ imin imax jmin jmax kmin kmax ] } \item[Input:] nc\_file is the name of the netcdf file which hold the variable. nc\_var is the netcdf variable name for the mean computation. If a wrong or dummy variable is given, the program presents the list of available variables in the file, and ask for a choice. $ T | U | V | F | W $ : specify the point on the C-grid, corresponding to the variable nc\_var. imin imax jmin jmax kmin kmax : optional parameters. If used, all 6 must be specified. They indicate the limited area (in i,j,k coordinates) where the mean value will be computed. The user can specify 0 as input, which means that the corresponding coordinate will be considered for the whole extent; in this case the pair of coordinates must be set to 0. For instance: {\tt cdfmean ORCA025-G42\_y0010\_ANNUAL\_gridT.nc votemper T } will compute the mean temperature over the whole domain. {\tt cdfmean ORCA025-G42\_y0010\_ANNUAL\_gridT.nc xxx T } will ask a variable name from the list of variables contained in the file. Careful, the type of point (T U V or F ) is not asked interactively; this is not really a problem as in most of the OPA9 output, files are build for each type (gridT, gridU etc...). {\tt cdfmean ORCA025-G42\_y0010\_ANNUAL\_gridU.nc vozocrtx U 300 320 400 653 0 0 } will compute the mean U-component of the velocity on a horizontally limited area, for the whole water column. Other valid specifications for the limited area can be, for example : 0 0 400 600 1 15 : the mean will be computed for the upper 15 levels, for a whole zonal band starting at j=400 and ending at j=600. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] Results are printed on the standard output. For 3D fields, intermediate mean values for each level are also displayed. \item[Remark/bugs :] In this version, no special care has been taken to handle neither the periodic grids, nor the north folding conditions. This will be done in a future release. \item[Associated scripts:] {None. This program is more typically an interactive program. As it is written, it can handle grids as big as ORCA025 on a small Linux machine (with only 512 Mb of core memory).} \end{description} \newpage \subsection*{\underline{cdfmean-full:}} \addcontentsline{toc}{subsection}{cdfmean-full} \index{cdfmean-full} \begin{description} \item[Purpose:] Compute the mean value of a field, weighted by the local metric. If the variable is a 3D variable, the mean value is given for each level, then the global mean is printed. The mean value can be computed on a limited domain, specified on the command line. This is the -full version (full steps) of cdfmean. \item[Usage:] {\em cdfmean-full nc\_files nc\_var $T | U | V | F | W$ [ imin imax jmin jmax kmin kmax ] } \item[Input:] nc\_file is the name of the netcdf file which hold the variable. nc\_var is the netcdf variable name for the mean computation. If a wrong or dummy variable is given, the program presents the list of available variables in the file, and ask for a choice. $ T | U | V | F | W $ : specify the point on the C-grid, corresponding to the variable nc\_var. imin imax jmin jmax kmin kmax : optional parameters. If used, all 6 must be specified. They indicate the limited area (in i,j,k coordinates) where the mean value will be computed. The user can specify 0 as input, which means that the corresponding coordinate will be considered for the whole extent; in this case the pair of coordinates must be set to 0. For instance: {\tt cdfmean-full ORCA025-G42\_y0010\_ANNUAL\_gridT.nc votemper T } will compute the mean temperature over the whole domain. {\tt cdfmean-full ORCA025-G42\_y0010\_ANNUAL\_gridT.nc xxx T } will ask a variable name from the list of variables contained in the file. Careful, the type of point (T U V or F ) is not asked interactively; this is not really a problem as in most of the OPA9 output, files are build for each type (gridT, gridU etc...). {\tt cdfmean-full ORCA025-G42\_y0010\_ANNUAL\_gridU.nc vozocrtx U 300 320 400 653 0 0 } will compute the mean U-component of the velocity on a horizontally limited area, for the whole water column. Other valid specifications for the limited area can be, for example : 0 0 400 600 1 15 : the mean will be computed for the upper 15 levels, for a whole zonal band starting at j=400 and ending at j=600. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] Results are printed on the standard output. For 3D fields, intermediate mean values for each level are also displayed. \item[Remark/bugs :] In this version, no special care has been taken to handle neither the periodic grids, nor the north folding conditions. This will be done in a future release. \item[Associated scripts:] {None. This program is more typically an interactive program. As it is written, it can handle grids as big as ORCA025 on a small Linux machine (with only 512 Mb of core memory).} \end{description} \newpage \subsection*{\underline{cdfsum:}} \addcontentsline{toc}{subsection}{cdfsum} \index{cdfsum} \begin{description} \item[Purpose:] Compute the sum value of the field (3D, weighted). \item[Usage:] {\em cdfsum nc\_file nc\_var $T| U | V | F | W$ [imin imax jmin jmax kmin kmax] } \item[Input:] nc\_file is the name of the netcdf file which hold the variable. nc\_var is the netcdf variable name for the sum computation. $ T | U | V | F | W $ : specify the point on the C-grid, corresponding to the variable nc\_var. imin imax jmin jmax kmin kmax : optional parameters. If used, all 6 must be specified. They indicate the limited area (in i,j,k coordinates) where the sum value will be computed. The user can specify 0 as input, which means that the corresponding coordinate will be considered for the whole extent; in this case the pair of coordinates must be set to 0. \item[Required mesh\_mask files or other files:] iles mesh\_hgr.nc, mesh\_zgr.nc ,mask.nc \item[Output:] done on standard output \item[Remark/bugs :] This program can be used for computing inventory, for instance. \item[Associated scripts:] none \end{description} \newpage \newpage \subsection*{\underline{cdfzeromean:}} \addcontentsline{toc}{subsection}{cdfzeromean} \index{cdfzeromean} \begin{description} \item[Purpose:] Compute the mean value of a field, weighted by the local metric. If the variable is a 3D variable, the mean value is given for each level, then the global mean is printed. The mean value can be computed on a limited domain, specified on the command line. Then, the overall mean value is rested from the initial field, in order to produce a zero-mean field. \item[Usage:] {\em cdfzeromean nc\_files nc\_var $T | U | V | F | W$ [ imin imax jmin jmax kmin kmax ] } \item[Input:] nc\_file is the name of the netcdf file which hold the variable. nc\_var is the netcdf variable name for the mean computation. If a wrong or dummy variable is given, the program presents the list of available variables in the file, and ask for a choice. $ T | U | V | F | W $ : specify the point on the C-grid, corresponding to the variable nc\_var. imin imax jmin jmax kmin kmax : optional parameters. If used, all 6 must be specified. They indicate the limited area (in i,j,k coordinates) where the mean value will be computed. The user can specify 0 as input, which means that the corresponding coordinate will be considered for the whole extent; in this case the pair of coordinates must be set to 0. The mean value is computed on this local domain. It is rested from the whole domain in the output file. Other valid specifications for the limited area can be, for example : 0 0 400 600 1 15 : the mean will be computed for the upper 15 levels, for a whole zonal band starting at j=400 and ending at j=600. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] Results are printed on the standard output. For 3D fields, intermediate mean values for each level are also displayed. A netcdf file (zeromean.nc) is created with the zero-meaned variable, same name and attributes, except the long name which indicates that the variable has been modified. \item[Remark/bugs :] In this version, no special care has been taken to handle neither the periodic grids, nor the north folding conditions. This will be done in a future release. \item[Associated scripts:] {None. This program is more typically an interactive program. As it is written, it can handle grids as big as ORCA025 on a small Linux machine (with only 512 Mb of core memory).} \end{description} \newpage \subsection*{\underline{cdfvertmean:}} \addcontentsline{toc}{subsection}{cdfvertmean} \index{cdfvertmean} \begin{description} \item[Purpose:] Compute the vertical average of a scalar quantity between z layers \item[Usage:] {\em cdfvertmean nc\_file nc\_var $T | U | V | F | W$ z1 z2 } Partial steps. \item[Input:] nc\_file is the data file holding 3D variable nc\_var. The user must specify on which grid point type this variable is ( $T | U | V | F | W$ ) and the deptht (m) z1 and z2 limiting 2 horizontal layers used for the vertical mean. \item[Required mesh\_mask files or other files:] mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] The output is done on the file {\tt vertmean.nc} with the 2D variable (same unit as nc\_var) {\tt sovertmean} \item[Remark:] \end{description} \newpage \subsection*{\underline{cdfmeanvar:}} \addcontentsline{toc}{subsection}{cdfmeanvar} \index{cdfmeanvar} \begin{description} \item[Purpose:] This program is very similar to the previous in the list: It computes the mean value of a field, and its spatial variance, weighted by the local metric. If the variable is a 3D variable, the mean value and variance are given for each level, then the global mean/variance are printed. The mean/variance values can be computed on a limited domain, specified on the command line. \item[Usage:] {\em cdfmeanvar nc\_files nc\_var $T | U | V | F | W$ [ imin imax jmin jmax kmin kmax ] } \item[Input:] nc\_file is the name of the netcdf file which hold the variable. nc\_var is the netcdf variable name for the mean computation. If a wrong or dummy variable is given, the program presents the list of available variables in the file, and ask for a choice. $ T | U | V | F | W $ : specify the point on the C-grid, corresponding to the variable nc\_var. imin imax jmin jmax kmin kmax : optional parameters. If used, all 6 must be specified. They indicate the limited area (in i,j,k coordinates) where the mean value will be computed. The user can specify 0 as input, which means that the corresponding coordinate will be considered for the whole extent; in this case the pair of coordinates must be set to 0. For instance: {\tt cdfmeanvar ORCA025-G42\_y0010\_ANNUAL\_gridT.nc votemper T } will compute the mean temperature over the whole domain. {\tt cdfmeanvar ORCA025-G42\_y0010\_ANNUAL\_gridT.nc xxx T } will ask a variable name from the list of variables contained in the file. Careful, the type of point (T U V or F ) is not asked interactively; this is not really a problem as in most of the OPA9 output, files are build for each type (gridT, gridU etc...). {\tt cdfmeanvar ORCA025-G42\_y0010\_ANNUAL\_gridU.nc vozocrtx U 300 320 400 653 0 0 } will compute the mean U-component of the velocity on a horizontally limited area, for the whole water column. Other valid specifications for the limited area can be, for example : 0 0 400 600 1 15 : the mean will be computed for the upper 15 levels, for a whole zonal band starting at j=400 and ending at j=600. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] Results are printed on the standard output. For 3D fields, intermediate mean values for each level are also displayed. \item[Remark/bugs :] In this version, no special care has been taken to handle neither the periodic grids, nor the north folding conditions. This will be done in a future release. \item[Associated scripts:] {None. This program is more typically an interactive program. As it is written, it can handle grids as big as ORCA025 on a small Linux machine (with only 512 Mb of core memory).} \end{description} \newpage \subsection*{\underline{cdfheatc:}} \addcontentsline{toc}{subsection}{cdfheatc} \index{cdfheatc} \begin{description} \item[Purpose:] Compute the heat content for the ocean in a given 3D domain (or the whole domain). The heat content (Joules) is computed and given for each levels, then the global heat content (J) is printed, as well as the heat content per unit of volume (J/m3). A sub-domain can be specified on the command line. \item[Usage:] {\em cdfheatc gridTfiles [ imin imax jmin jmax kmin kmax ] } \item[Input:] gridTfile is the name of the netcdf file which holds $votemper$. \\ imin imax jmin jmax kmin kmax : optional parameters. If used, all 6 must be specified. They indicate the limited area (in i,j,k coordinates) where the mean value will be computed. The user can specify 0 as input, which means that the corresponding coordinate will be considered for the whole extent; in this case the pair of coordinates must be set to 0. For instance: {\tt cdfheatc ORCA025-G42\_y0010\_ANNUAL\_gridT.nc } will compute the heat content over the whole domain. {\tt cdfheatc ORCA025-G42\_y0010\_ANNUAL\_gridT.nc 300 320 400 653 0 0 } will compute the heat content on a horizontally limited area, for the whole water column. Other valid specifications for the limited area can be, for example : 0 0 400 600 1 15 : the heat content will be computed for the upper 15 levels, for a whole zonal band starting at j=400 and ending at j=600. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] Results are printed on the standard output. For 3D fields, intermediate values for each level are also displayed. \item[Remark/bugs :] In this version, no special care has been taken to handle neither the periodic grids, nor the north folding conditions. This will be done in a future release. \item[Associated scripts:] {None. This program is more typically an interactive program. As it is written, it can handle grids as big as ORCA025 on a small Linux machine (with only 512 Mb of core memory).} \end{description} \subsection*{\underline{cdfheatc-full:}} \addcontentsline{toc}{subsection}{cdfheatc-full} \index{cdfheatc-full} \begin{description} \item[Purpose:] Compute the heat content for the ocean in a given 3D domain (or the whole domain). The heat content (Joules) is computed and given for each levels, then the global heat content (J) is printed, as well as the heat content per unit of volume (J/m3). A sub-domain can be specified on the command line. This is the FULL STEP version \item[Usage:] {\em cdfheatc gridTfiles [ imin imax jmin jmax kmin kmax ] } \item[Input:] gridTfile is the name of the netcdf file which holds $votemper$. \\ imin imax jmin jmax kmin kmax : optional parameters. If used, all 6 must be specified. They indicate the limited area (in i,j,k coordinates) where the mean value will be computed. The user can specify 0 as input, which means that the corresponding coordinate will be considered for the whole extent; in this case the pair of coordinates must be set to 0. For instance: {\tt cdfheatc-full ORCA025-G04\_y0010\_ANNUAL\_gridT.nc } will compute the heat content over the whole domain. {\tt cdfheatc-full ORCA025-G04\_y0010\_ANNUAL\_gridT.nc 300 320 400 653 0 0 } will compute the heat content on a horizontally limited area, for the whole water column. Other valid specifications for the limited area can be, for example : 0 0 400 600 1 15 : the heat content will be computed for the upper 15 levels, for a whole zonal band starting at j=400 and ending at j=600. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] Results are printed on the standard output. For 3D fields, intermediate values for each level are also displayed. \item[Remark/bugs :] In this version, no special care has been taken to handle neither the periodic grids, nor the north folding conditions. This will be done in a future release. \item[Associated scripts:] {None. This program is more typically an interactive program. As it is written, it can handle grids as big as ORCA025 on a small Linux machine (with only 512 Mb of core memory).} \end{description} \newpage \subsection*{\underline{cdfmxlheatc-full:}} \addcontentsline{toc}{subsection}{cdfmxlheatc-full} \index{cdfmxlheatc-full} \begin{description} \item[Purpose:] Compute the heat content for the ocean in the mixed layer read in the gridT file, FULL STEP case. \item[Usage:] {\em cdfmxlheatc-full gridTfile } \item[Input:] gridTfile is the name of the netcdf file which holds $votemper$ and $somxl010$ \\ \item[Required mesh\_mask files or other files:] mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] Results are written in the netcdf file mxlheatc.nc, in the variable $somxlheatc$. Units are Joules/m2 \end{description} \subsection*{\underline{cdfmxlsaltc:}} \addcontentsline{toc}{subsection}{cdfmxlsaltc} \index{cdfmxlsaltc} \begin{description} \item[Purpose:] Compute the salt content for the ocean in the mixed layer read in the gridT file. \item[Usage:] {\em cdfmxlsaltc gridTfile } \item[Input:] gridTfile is the name of the netcdf file which holds $votemper$ and $somxl010$ \\ For instance: {\tt cdfmxlsaltc ORCA025-G42\_y0010\_m03d15\_gridT.nc } will compute the salt content in the mixed layer for this file. \item[Required mesh\_mask files or other files:] mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] Results are written in the netcdf file mxlsaltc.nc, in the variable $somxlsaltc$. Units are kg/m2 \item[Associated scripts:] {None.} \end{description} \subsection*{\underline{cdfmxlhcsc:}} \addcontentsline{toc}{subsection}{cdfmxlhcsc} \index{cdfmxlhcsc} \begin{description} \item[Purpose:] Compute the heat content and Salt content in the mixed layer. One can choose a temperature criteria or a density criteria for the mxl determination. The Heat/Salt content can be limited to a fraction of the MLD (for instance avoiding near surface layers). \item[Usage:] {\em cdfmxlhcsc gridTfile crit val [hmin] } \item[Input:] gridTfile is the name of the netcdf file which holds $votemper$ \\ crit can be 'density' or 'temperature' \\ val is tha value for the criteria (e.g. -0.2 for temp, 0.01 or 0.03 for density). \\ hmin is 0 by default. If another value is given, then the vertical integral is limited to [hmin,mld] \item[Required mesh\_mask files or other files:] mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] Results are written in the netcdf file mxlhcsc.nc. Variables are either \\ somxl010 (mld based on density criterium 0.01) \\ somxl030 (mld on density criterium 0.03) \\ somxlt02 (mld on temperature criterium -0.2) \\ Then always : somxlheatc and somxlsaltc \item[Associated scripts:] {None.} \end{description} \newpage \subsection*{\underline{cdfzonalmean:}} \addcontentsline{toc}{subsection}{cdfzonalmean} \index{cdfzonalmean} \begin{description} \item[Purpose:] Compute the zonal mean value for all the variables in the file given as argument. \item[Usage:] {\em cdfzonalmean nc\_files $T | U | V | F | W$ [ sub\_basin\_mask ]} \item[Input:] nc\_file is the name of the netcdf file which hold the variables. $ T | U | V | F | W $ : specify the point on the C-grid, corresponding to the variables in the file. sub\_basin\_mask: If given the program read this file to set a sub\_basin\_mask (for global configurations). If this argument is not given, then the zonal mean is assumed to be global, which is OK for a basin configuration, such as NATL4, for instance. For instance: {\tt cdfzonalmean ORCA025-G42\_y0010\_ANNUAL\_gridT.nc T } will compute the zonal mean temperature over the whole domain; the resulting variable is a 2D variable (latitude,depth). {\tt cdfzonalmean ORCA025-G42\_y0010\_ANNUAL\_gridT.nc T new\_maskglo} will compute the zonal mean of all the variables contained in the file. A zonal mean for each sub basin will be output. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] The program outputs as many variables as there are in the input file times the number of sub-basin (5) if the sub-basin mask is given. Variables name starts with 'zo' which replaces the 'vo' or 'so' of the input variable. The name of the sub basin is then appended to the variable name: For instance, zonal mean for votemper gives (in case of sub-basins) : $zotemper\_glo, zotemper\_atl zotemper\_inp, zotemper\_ind zotemper\_pac$. \item[Associated scripts:] {None} \end{description} \newpage \subsection*{\underline{cdfzonalsum:}} \addcontentsline{toc}{subsection}{cdfzonalsum} \index{cdfzonalsum} \begin{description} \item[Purpose:] Compute the zonal sum value for all the variables in the file given as argument. \item[Usage:] {\em cdfzonalsum nc\_files $T | U | V | F | W$ [ sub\_basin\_mask ]} \item[Input:] nc\_file is the name of the netcdf file which hold the variables. $ T | U | V | F | W $ : specify the point on the C-grid, corresponding to the variables in the file. sub\_basin\_mask: If given the program read this file to set a sub\_basin\_mask (for global configurations). If this argument is not given, then the zonal sum is assumed to be global, which is OK for a basin configuration, such as NATL4, for instance. For instance: {\tt cdfzonalsum ORCA025-G50\_y1958\_ANNUAL\_ptrcT.nc T } will compute the zonal sum of the variables over the whole domain; the resulting variable is a 2D variable (latitude,depth), or just a vector (latitude) if the input variable is already a 2D horizontal variable (inventory, for instance). \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc must be in the current directory. \item[Output:] The program outputs as many variables as there are in the input file times the number of sub-basin (5) if the sub-basin mask is given. Variables name starts with 'zo' which replaces the 'vo' or 'so' of the input variable. The name of the sub basin is then appended to the variable name: For instance, zonal sum for votemper gives (in case of sub-basins) : $zotemper\_glo, zotemper\_atl zotemper\_inp, zotemper\_ind zotemper\_pac$. \item[Associated scripts:] {see cdftrc.ll} \item[See also:] cdfzonalout : this a formatting tool to print ASCII results in a good shape for the 1D results produced as ncdf by cdfzonalsum. \end{description} \newpage \subsection*{\underline{cdfzonalout:}} \addcontentsline{toc}{subsection}{cdfzonalout} \index{cdfzonalout} \begin{description} \item[Purpose:] Produce a nice ASCII output for 1D variables resulting from cdfzonalsum, or cdfzonalmean \item[Usage:] {\em cdfzonalout zonalsum.nc } \item[Input:] zonalsum.nc is a netcdf file output from cdfzonalsum or cdfzonalmean \item[Output:] Output is done on stantard output (can be re-directed to a file via $>$) \item[Associated scripts:] {see cdftrc.ll} \end{description} \begin{verbatim} Number of 1D variables : 6 zoinvcfc_glo zoinvc14_glo zoqtrcfc_glo zoqtrc14_glo zoqintcfc_glo zoqintc14_glo npiglo= 1 npjglo= 1021 npk = 46 J LAT zoinvcfc_glo zoinvc14_glo 1021 89.8876 0.114485E-06 1639.13867 1020 89.9478 0.114504E-06 1660.38854 1019 89.8876 0.114485E-06 1639.13867 1018 89.7937 0.112609E-06 1521.98022 1017 89.6954 0.111228E-06 1462.95922 1016 89.5956 0.110859E-06 1355.69262 1015 89.4949 0.109885E-06 1315.38806 1014 89.3935 0.109691E-06 1265.77246 1013 89.2915 0.109644E-06 1211.48840 1012 89.1890 0.108149E-06 1163.96777 1011 89.0860 0.105885E-06 1132.33557 1010 88.9825 0.103872E-06 1096.84130 ..... \end{verbatim} \newpage \subsection*{\underline{cdfvT:}} \addcontentsline{toc}{subsection}{cdfvT} \index{cdfvT} \begin{description} \item[Purpose:] Compute the mean UT, US, VT, VS for transport computation. \item[Usage:] {\em cdfvT CONFIG 'list\_of\_tags' } \item[Input:] CONFIG is the valid config name ( e.g. ORCA025-G32, NATL4-B01, ORCA05-K18 ...). In general model output files are build as \$CONFIG\_\$tag\_grid?.nc. The tag part of the name is usually something like y0008m09d10 for instance, but virtually, it is the part of the name between \$CONFIG\_ and \_grid.\\ list\_of\_tags is just the succession of the tags that are to be used in the mean. \\ When using cdfvT, we assume that all the data files ( i.e. gridT, gridU and gridV files for the given CONFIG and tags) are in the current directory. For instance: cdfvT ORCA025-G32 y0010m10d01 y0010m10d06 y0010m10d11 will compute the mean UT etc fields for the 3 given tags. \item[Required mesh\_mask files or other files:] none \item[Output:] {\em vt.nc}. This file contains the four 3-D variables vozout, vozous, vomevt, vomevs. \item[Remark:] For the sake of simplicity, only one file is used as output, but one should remember that the U-transports (UT and US) are computed at the C-grid U-point, and that the V-transports (VT and VS) are computed at the C-grid V-point. In fact, temperature and salinity are interpolated on the corresponding velocity point, in order to respect mass conservation. \item[Associated script:] {\em cdfvT.ll}: This script is used in the DRAKKAR project to compute the monthly, quarterly and annual means for the UT US VT VS terms.\\ {\em cdfvT-inter}: This is a variant of the first script for inter-annual means. \end{description} \subsection*{\underline{cdfvsig:}} \addcontentsline{toc}{subsection}{cdfvsig} \index{cdfvsig} \begin{description} \item[Purpose:] Compute the mean u$.$sigma, v$.$sigma and w$.$sigma from tags given as arguments \item[Usage:] {\em cdfvsig CONFIG 'list\_of\_tags' } \item[Input:] CONFIG is the valid config name ( e.g. ORCA025-G32, NATL4-B01, ORCA05-K18 ...). \item[Required mesh\_mask files or other files:] none \item[Output:] {\em usig.nc, vsig.nc, wsig.nc}. Each of these files contains the variables (eg for u files) \\ vousig = 3D mean product u x sigma \\ vosigu = 3D mean density field at u-points \\ vozocrtx = 3D mean velocity computed exactly as the other fields \item[Remark:] All variables can be used to compute the eddy contribution. \item[Associated script:] {\em cdfvsig.ll}: \end{description} \newpage \subsection*{\underline{cdfeke:}} \addcontentsline{toc}{subsection}{cdfeke} \index{cdfeke} \begin{description} \item[Purpose:] Compute the Eddy Kinetic Energy (EKE). \item[Usage:] {\em cdfeke gridU gridU2 gridV gridV2 gridT} \item[Input:] gridU and gridU2 hold respectively the mean and quadratic mean for U-points. The same for gridV and gridV2. These files are produced by cdfmoy. They correspond to a certain period of time ( monthly, quarterly, annual or pluri annual means). The EKE is computed with respect to this period of time. \\ An extra gridT type file is given in argument, just for reading the T-grid, for the header of the output file. In fact, EKE is computed on the T-points.\\ For instance: cdfeke ORCA035-G32\_y0008-0010\_gridU.nc ORCA035-G32\_y0008-0010\_gridU2.nc \\ ORCA035-G32\_y0008-0010\_gridV.nc ORCA035-G32\_y0008-0010\_gridV2.nc ORCA035-G32\_y0008-0010\_gridT2.nc \\ will compute the EKE for the period y0008-0010. \item[Required mesh\_mask files or other files:] none \item[Output:] {\em eke.nc}. This file hold the variable voeke. \item[Remark:] EKE is computed at T-points. \item[Associated script:] {\em cdfeke.ll}: This script can be used to compute EKE. It is a good example on how to use cdfeke. Note that this script must be used after cdfmoy.ll, because it requires the mean and mean quadratic files to be already computed. \end{description} \newpage \subsection*{\underline{cdfrmsssh:}} \addcontentsline{toc}{subsection}{cdfrmsssh} \index{cdfrmsssh} \begin{description} \item[Purpose:] Compute the RMS of the SSH. \item[Usage:] {\em cdfrmsssh gridT gridT2 } \item[Input:] gridT and gridT2 hold respectively the mean and quadratic mean for T-points. These files are produced by cdfmoy. They correspond to a certain period of time ( monthly, quarterly, annual or pluri annual means). The RMS is computed with respect to this period of time. \\ For instance: cdfrmsssh ORCA035-G32\_y0008-0010\_gridT.nc ORCA035-G32\_y0008-0010\_gridT2.nc \\ will compute the RMS SSH for the period y0008-0010. \item[Required mesh\_mask files or other files:] none \item[Output:] {\em rmsssh.nc}. This file hold the variable sossheig\_rms. \item[Remark:] \item[Associated script:] {\em cdfrms.ll}: This scripts is use to compute both RMS ssh and the Stdev of W. \end{description} \newpage \subsection*{\underline{cdfstdevw:}} \addcontentsline{toc}{subsection}{cdfstdevw} \index{cdfstdevw} \begin{description} \item[Purpose:] Compute the standard deviation for W. \item[Usage:] {\em cdfstdevw gridW gridW2 } \item[Input:] gridW and gridW2 hold respectively the mean and quadratic mean for W-points. These files are produced by cdfmoy. They correspond to a certain period of time ( monthly, quarterly, annual or pluri annual means). The standard deviation is computed with respect to this period of time. \\ For instance: cdfstdevw ORCA035-G32\_y0008-0010\_gridW.nc ORCA035-G32\_y0008-0010\_gridW2.nc \\ will compute the standard deviation of W for the period y0008-0010. \item[Required mesh\_mask files or other files:] none \item[Output:] {\em rmsw.nc}. This file hold the variable vovecrtz\_rms. \item[Remark:] \item[Associated script:] {\em cdfrms.ll}: This scripts is use to compute both RMS ssh and the Stdev of W. \end{description} \newpage \subsection*{\underline{cdfstdevts:}} \addcontentsline{toc}{subsection}{cdfstdevts} \index{cdfstdevts} \begin{description} \item[Purpose:] Compute the standard deviation for temperature and salinity \item[Usage:] {\em cdfstdevts gridX gridX2 } \item[Input:] gridX and gridX2 hold respectively the mean and quadratic mean for T-points. These files are produced by cdfmoy\_sal2\_temp2. They correspond to a certain period of time ( monthly, quarterly, annual or pluri annual means). The standard deviation is computed with respect to this period of time. \\ For instance: cdfstdevts ORCA035-G32\_y0008-0010\_gridT.nc ORCA035-G32\_y0008-0010\_gridT2.nc \\ will compute the standard deviation of T and D for the period y0008-0010. \item[Required mesh\_mask files or other files:] none \item[Output:] {\em rmsts.nc}. This file hold the variables votemper\_rms and vosaline\_rms \item[Remark:] This quantity is not a very standard one. For this reason, we keep the standard cdfmoy, without saving the second order momentum for T and S and create a special tool cdfmoy\_sal2\_temp2 for this purpose. Remember that both T2 and S2 are 3D fields... \item[Associated script:] none. \end{description} \newpage \subsection*{\underline{cdfstd:}} \addcontentsline{toc}{subsection}{cdfstd} \index{cdfstd} \begin{description} \item[Purpose:] Compute the standard deviation for all the physical variables of the serie of files given as input \item[Usage:] {\em cdfstd list of files } \item[Input:] The input files are model output files, all holding the same variables. Each file can have more than 1 time frame in it. \item[Required mesh\_mask files or other files:] none \item[Output:] {\em cdfstd.nc}. This file hold the standard deviation of the variables,whose name will be {\tt varname\_std} \item[Associated script:] none. \item[Contributor:] Frederic Castruccio (Meom) \end{description} \newpage \subsection*{\underline{cdflinreg:}} \addcontentsline{toc}{subsection}{cdflinreg} \index{cdflinreg} \begin{description} \item[Purpose:] Compute the linear regression coeficients as well as the $r^2$ estimator of the fit, for all the variables being in the time series of files given on input. \item[Usage:] {\em cdflinreg list of files } \item[Input:] Input files are model files output that may hold one or more time frames. \item[Required mesh\_mask files or other files:] none \item[Method:] $y$ being the working variables, the program determines $a$ and $b$ such as the the right $\hat{y}=a.t+b$ corresponds to the best fit for the data. (Least squared sense). \\ $a=cov(t,y)/var(t)$ and $b=\bar{y} - a . \bar{t}$ \\ $r^2=a^2.var(t)/var(y)$ \item[Output:] {\em linreg.nc}. For each variable of the input files, there are 3 output variables, says $y\_areg$, $y\_breg$ and $y\_r2$. The time is taken from the input files (standard in seconds since the begining of the run), and converted in years (365 days). Therefore, when using the regression equation, take care of the time origin and units. \item[Associated script:] cdflinreg.ksh \end{description} \newpage \section{Transports} \subsection*{\underline{cdfmhst:}} \addcontentsline{toc}{subsection}{cdfmhst} \index{cdfmhst} \begin{description} \item[Purpose:] Compute the Meridional Heat and Salt Transport (Partial Step case). \item[Usage:] {\em cdfmhst VTfile [MST] } \item[Input:] VTfiles are the files produced by the cdfvT program.// MST is an optional keyword for saving also Meridional Salt Transport to a netcdf file.// They correspond to a certain period of time ( monthly, quarterly, annual or pluri annual means). For instance: cdfmhst ORCA025-G32\_y0010m01\_VT.nc will compute the meridional heat and salt transport for month 1 of year 0010 for the ORCA025-G32 experiment. Only the MHT will be saved to the netcdf file mhst.nc \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc ,mask.nc, new\_maskglo.nc \\ This latter file holds sub basin 2D masks; if it does'nt exist, only the global mask is taken into account, which is usefull for regional configs such as NATL4. \item[Output:] zonal\_heat\_trp.dat and zonal\_salt\_trp.dat which are ASCII files. It also writes the result on mhst.nc file, a netcdf file. If no MST option is given on the command line, only MHT is copied to the cdf file. The ASCII files remain the same. \\Example for zonal\_heat\_trp.dat \begin{scriptsize} \begin{verbatim} Zonal heat transport (integrated along I-model coordinate) (in Pw) J Global Atlantic Pacific Indian Mediterranean Austral ... 580 19.959 1.9821 19.959 1.0471 19.959 0.8080 19.959 0.1460 999.000 0.0000 999.000 0.0000 579 19.723 1.9769 19.724 1.0465 19.724 0.8108 19.724 0.1528 999.000 0.0000 999.000 0.0000 578 19.488 1.9650 19.488 1.0429 19.488 0.8054 19.488 0.1575 999.000 0.0000 999.000 0.0000 577 19.252 1.9512 19.252 1.0388 19.252 0.7975 19.252 0.1608 999.000 0.0000 999.000 0.0000 576 19.016 1.9334 19.016 1.0334 19.016 0.7840 19.016 0.1650 999.000 0.0000 999.000 0.0000 575 18.779 1.9103 18.779 1.0252 18.779 0.7615 18.779 0.1712 999.000 0.0000 999.000 0.0000 574 18.543 1.8792 18.543 1.0173 18.543 0.7235 18.543 0.1778 999.000 0.0000 999.000 0.0000 573 18.305 1.8406 18.305 1.0007 18.305 0.6837 18.305 0.1818 999.000 0.0000 999.000 0.0000 572 18.068 1.8064 18.068 0.9856 18.068 0.6455 18.068 0.1849 999.000 0.0000 999.000 0.0000 571 17.830 1.7768 17.830 0.9721 17.830 0.6171 17.830 0.1876 999.000 0.0000 999.000 0.0000 570 17.592 1.7494 17.592 0.9582 17.592 0.6000 17.592 0.1911 999.000 0.0000 999.000 0.0000 ... \end{verbatim} \end{scriptsize} First column indicates the corresponding J coordinate. Then pairs of column indicates the mean latitude and the transport. Heat transports are in Pw. Salt transports are in KT/s \item[Remark:] missing values are indicated by 999.000 \item[Associated script:] {\em cdfmhst.ll}. \end{description} \newpage \subsection*{\underline{cdfmhst-full:}} \addcontentsline{toc}{subsection}{cdfmhst-full} \index{cdfmhst-full} \begin{description} \item[Purpose:] Compute the Meridional Heat and Salt Transport (Full Step case). \item[Usage:] {\em cdfmhst-full VTfile [MST] } \item[Input:] VTfiles are the files produced by the cdfvT program.// MST is an optional keyword for saving also Meridional Salt Transport to a netcdf file.// They correspond to a certain period of time ( monthly, quarterly, annual or pluri annual means). For instance: cdfmhst-full ORCA025-G04\_y0010m01\_VT.nc will compute the meridional heat and salt transport for month 1 of year 0010 for the ORCA025-G04 experiment. Only the MHT will be saved to the netcdf file mhst.nc. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc ,mask.nc, new\_maskglo.nc \\ This latter file holds sub basin 2D masks. \item[Output:] zonal\_heat\_trp.dat and zonal\_salt\_trp.dat which are ASCII files. It also writes the result on mhst.nc file, a netcdf file. If no MST option is given on the command line, only MHT is copied to the cdf file. The ASCII files remain the same. \\Example for zonal\_heat\_trp.dat \begin{scriptsize} \begin{verbatim} Zonal heat transport (integrated alon I-model coordinate) (in Pw) J Global Atlantic Pacific Indian Mediterranean Austral ... 580 19.959 1.9821 19.959 1.0471 19.959 0.8080 19.959 0.1460 999.000 0.0000 999.000 0.0000 579 19.723 1.9769 19.724 1.0465 19.724 0.8108 19.724 0.1528 999.000 0.0000 999.000 0.0000 578 19.488 1.9650 19.488 1.0429 19.488 0.8054 19.488 0.1575 999.000 0.0000 999.000 0.0000 577 19.252 1.9512 19.252 1.0388 19.252 0.7975 19.252 0.1608 999.000 0.0000 999.000 0.0000 576 19.016 1.9334 19.016 1.0334 19.016 0.7840 19.016 0.1650 999.000 0.0000 999.000 0.0000 575 18.779 1.9103 18.779 1.0252 18.779 0.7615 18.779 0.1712 999.000 0.0000 999.000 0.0000 574 18.543 1.8792 18.543 1.0173 18.543 0.7235 18.543 0.1778 999.000 0.0000 999.000 0.0000 573 18.305 1.8406 18.305 1.0007 18.305 0.6837 18.305 0.1818 999.000 0.0000 999.000 0.0000 572 18.068 1.8064 18.068 0.9856 18.068 0.6455 18.068 0.1849 999.000 0.0000 999.000 0.0000 571 17.830 1.7768 17.830 0.9721 17.830 0.6171 17.830 0.1876 999.000 0.0000 999.000 0.0000 570 17.592 1.7494 17.592 0.9582 17.592 0.6000 17.592 0.1911 999.000 0.0000 999.000 0.0000 ... \end{verbatim} \end{scriptsize} First column indicates the corresponding J coordinate. Then pairs of column indicates the mean latitude and the transport. Heat transports are in Pw. Salt transports are in KT/s \item[Remark:] missing values are indicated by 999.000 \item[Associated script:] {\em cdfmhst-full.ll} \end{description} \newpage \subsection*{\underline{cdfhflx:}} \addcontentsline{toc}{subsection}{cdfhflx} \index{cdfhflx} \begin{description} \item[Purpose:] Compute the Meridional Heat Transport from the forcing fields \item[Usage:] {\em cdfhflx gridTfile } \item[Input:] gridTfile is a file which hold the flux variable $sohefldo$. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, new\_maskglo.nc \\ This latter file holds sub basin 2D masks; if it does'nt exist, only the global mask is taken into account, which is usefull for regional configs such as NATL4. \item[Output:] Results are displayed on the standard output, with columns corresponding to sub basins. \item[Remark:] This computation is relative to the starting point of the integration. Transports are assumed to vanish at the northern point of the domain. \item[Associated script:] none for the moment. \end{description} \subsection*{\underline{cdfwflx:}} \addcontentsline{toc}{subsection}{cdfwflx} \index{cdfwflx} \begin{description} \item[Purpose:] Compute the different components of the water flux. (evaporation, precipitation, runoff, sss damping, total water flux). \item[Usage:] {\em cdfwflx gridTfile runofffile} \item[Input:] gridTfile is a file which hold the flux variables.\\ runofffile is the file with the runoff variable $sorunoff$. \item[Required mesh\_mask files or other files:] none \item[Output:] Output is done on wflx.nc file. Variables are evap (mm/day), precip (mm/day), sssdmp (mm/day), runoff (mm/day), watnet (mm/day). The runoff is directly read from the file, as well as the sss damping. Evaporation is deduced from the latent heat flux, stored on the gridT file ($Evap=-Q_{lat}/L_v$). Precip is deduced from the balance $watnet=Evap -Precip -Runoff +sssdmp$. Therefore, precip also takes into account the snow storage/melting on frozen areas. \item[Remark:] \item[Associated script:] cdfwflx.ksh \end{description} \subsection*{\underline{cdfbuoyflx:}} \addcontentsline{toc}{subsection}{cdfbuoyflx} \index{cdfbuoyflx} \begin{description} \item[Purpose:] This is an extension of cdfwflx: It computes the different components of the water flux. (evaporation, precipitation, runoff, sss damping, total water flux. Additionally, it extracts the component of the heat flux (latent, sensible, long wave, short wave, net heat fluxes), and copy them, to the output file. Then it evaluates the respective component of the buoyancy flux (haline, thermal), and the total buoyancy flux ($10^{-6} kg/m^2/s$).\\ \[ F_{\rho} = - \rho \left [ \alpha F_T - \beta F_S \right ] \] \item[Usage:] {\em cdfbuoyflx gridTfile runofffile} \item[Input:] gridTfile is a file which hold the flux variables.\\ runofffile is the file with the runoff variable $sorunoff$. \item[Required mesh\_mask files or other files:] none \item[Output:] Output is done on buoyflx.nc file. Variables are evap (mm/day), precip (mm/day), sssdmp (mm/day), runoff (mm/day), watnet (mm/day). The runoff is directly read from the file, as well as the sss damping. Evaporation is deduced from the latent heat flux, stored on the gridT file ($Evap=-Q_{lat}/L_v$). Precip is deduced from the balance $watnet=Evap -Precip -Runoff +sssdmp$. Therefore, precip also takes into account the snow storage/melting on frozen areas. \\ Heat fluxes ($W/m^2$) are on variables $latent$, $sensible$, $longwave$, $solar$, $heatnet$. \\ Buoyancy fluxes uses the same names with the extension \_b ($10^{-6} kg/m^2/s$ ). The total buoyancy flux ($buoyancy\_fl$) is also given. $SSS$ and $SST$ are also stored on the output file in order to have then at hand when performing diags with these files. \item[Remark:] \item[Associated script:] cdfbuoyflx.ksh \end{description} \newpage \subsection*{\underline{cdfvhst:}} \addcontentsline{toc}{subsection}{cdfvhst} \index{cdfvhst} \begin{description} \item[Purpose:] Compute the Vertically Integrated Heat and Salt Transport (Partial Step case). \item[Usage:] {\em cdfvhst VTfile } \item[Input:] VTfiles are the files produced by the cdfvT program. They correspond to a certain period of time ( monthly, quarterly, annual or pluri annual means). For instance: cdfvhst ORCA025-G32\_y0010m01\_VT.nc will compute the vertically integrated heat and salt transport for month 1 of year 0010 for the ORCA025-G32 experiment. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \\ \item[Output:]trp.nc, variables somevt somevs sozout sozous \item[Remark:] for example:\\ \begin{equation} somevt(i,j)=\int_{-h}^{0}{vt(i,j)e_{1v}(i,j) e_3(i,j,z) dz} \\ \end{equation} \begin{equation} someut(i,j)=\int_{-h}^{0}{ut(i,j)e_{2u}(i,j) e_3(i,j,z) dz} \end{equation} \item[Associated script:] {\em cdfvhst.ll}. \end{description} \newpage \subsection*{\underline{cdfvhst-full:}} \addcontentsline{toc}{subsection}{cdfvhst-full} \index{cdfvhst-full} \begin{description} \item[Purpose:] Compute the Vertically Integrated Heat and Salt Transport (Full Step case). \item[Usage:] {\em cdfvhst-full VTfile } \item[Input:] VTfiles are the files produced by the cdfvT program. They correspond to a certain period of time ( monthly, quarterly, annual or pluri annual means). For instance: cdfvhst-full ORCA025-G04\_y0010m01\_VT.nc will compute the vertically integrated heat and salt transport for month 1 of year 0010 for the ORCA025-G04 experiment. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \\ \item[Output:]trp.nc, variables somevt somevs sozout sozous \item[Remark:] for example:\\ \begin{equation} somevt(i,j)=\int_{-h}^{0}{vt(i,j)e_{1v}(i,j) e_3(z) dz} \\ \end{equation} \begin{equation} someut(i,j)=\int_{-h}^{0}{ut(i,j)e_{2u}(i,j) e_3(z) dz} \end{equation} \item[Associated script:] {\em cdfvhst-full.ll}. \end{description} \newpage \subsection*{\underline{cdfpsi:}} \addcontentsline{toc}{subsection}{cdfpsi} \index{cdfpsi} \begin{description} \item[Purpose:] Compute the Barotropic Stream Function (Partial Step case). \item[Usage:] {\em cdfpsi Ufile Vfile [V]} \item[Input:] Ufile and Vfile are the files holding vozocrtx and vomecrty. They correspond to a certain period of time ( monthly, quarterly, annual or pluri annual means). \\ The optional [V] parameter, is used to indicate that we want to save the v-computed psi, instead of the default u-computed. This last option is usefull for basin such as NATL4. \\ For instance: cdfpsi ORCA025-G32\_y0010m01\_U.nc ORCA025-G32\_y0010m01\_V.nc will compute the BSF for month 1 of year 0010 for the ORCA025-G32 experiment. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc \\ \item[Output:]psi.nc, variables sobarstf, on the C-grid f-points, masked. \item[Remark:] This program is prepared to compute BSF either from the U field or the V field. To be in agreement with previous matlab programs, we choose to save only the result from the U field. The integration constant is set so that the BSF on Asia is 0. ( For Orca type simulations, point (jpiglo, jpjglo) is supposed to be in Asia). Discussion is open if it is better to save the mean value of the BSF derived from U field and V field. \item[Associated script:] {\em cdfpsi.ll}. \end{description} \newpage \subsection*{\underline{cdfpsi-full:}} \addcontentsline{toc}{subsection}{cdfpsi-full} \index{cdfpsi-full} \begin{description} \item[Purpose:] Compute the Barotropic Stream Function (Full Step case). \item[Usage:] {\em cdfpsi-full Ufile Vfile } \item[Input:] Ufile and Vfile are the files holding vozocrtx and vomecrty. They correspond to a certain period of time ( monthly, quarterly, annual or pluri annual means). For instance: cdfpsi-full ORCA025-G04\_y0010m01\_U.nc ORCA025-G04\_y0010m01\_V.nc will compute the BSF for month 1 of year 0010 for the ORCA025-G04 experiment. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc \\ \item[Output:]psi.nc, variables sobarstf, on the C-grid f-points, masked. \item[Remark:] This program is prepared to compute BSF either from the U field or the V field. To be in agreement with previous matlab programs, we choose to save only the result from the U field. The integration constant is set so that the BSF on Asia is 0. ( For Orca type simulations, point (jpiglo, jpjglo) is supposed to be in Asia). Discussion is open if it is better to save the mean value of the BSF derived from U field and V field. \item[Associated script:] {\em cdfpsi-full.ll}. \end{description} \newpage \subsection*{\underline{cdfpsi-open:}} \addcontentsline{toc}{subsection}{cdfpsi-open} \index{cdfpsi-open} \begin{description} \item[Purpose:] Compute the Barotropic Stream Function from an open domain output. \item[Usage:] {\em cdfpsi-open Ufile Vfile [-mask] [-moy] } \item[Input:] Ufile and Vfile are the files holding vozocrtx and vomecrty.\\ If -mask option is used, resulting sobarstf field is masked, else it is not masked. \\ If -moy option is used, the resulting field is the mean value between Ucomputation and Vcomputation. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc \\ \item[Output:]psi.nc, variables sobarstf, on the C-grid f-points. \item[Remark:] It is very likely, that this program should be edited by the end used to fit its own configuration. In particular, in the standard version, the upper left corner is arbitrarely set to 0. When editing, take care of the sign for integration! When applied to and extrated domain from a larger model, this program will not give exactly the same BSF, because of a different starting reference. A modified version suitable for SALOMON025 configuration is avaible in cdfpsi-open\_AM.f90. \\ Another version suitable for the Zapiola area is available in cdfpsi-open-zap.f90 \end{description} \newpage \subsection*{\underline{cdfvtrp:}} \addcontentsline{toc}{subsection}{cdfvtrp} \index{cdfvtrp} \begin{description} \item[Purpose:] Computes the vertically integrated transports at each grid cell \item[Usage:] {\em cdfvtrp Ufile Vfile } \item[Input:] netcdf gridU and gridV files. \item[Required mesh\_mask files or other files:] Files mesh\_hgr.nc, mesh\_zgr.nc ,mask.nc must be in te current directory \item[Output:] Output on trp.nc, variables somevtrp sozoutrp \item[Remark/bugs :] output fields are horizontal 2D. They are used as input to cdftrp\_bathy to compute transport accross isobaths. \item[Associated scripts:] \end{description} \subsection*{\underline{cdftrp\_bathy:}} \addcontentsline{toc}{subsection}{cdftrp\_bathy} \index{cdftrp\_bathy} \begin{description} \item[Purpose:] Compute transport compoenents along and across isobaths. \item[Usage:] {\em cdftrp\_bathy trp.nc } \item[Input:] trp.nc file given as input is produced by cdfvtrp program. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mask.nc and hdept.nc (this latter file is the extraction of variable $hdept$ from mesh\_zgr.nc; a link to mesh\_zgr.cd can be made). \item[Output:] output is done on {\em trpiso.nc} file, with 2 variables : $soualz$ and $sovacz$ for along isobath anf cross isobath component of the transport. \item[Remark:] This program is quite tricky to use. Be sure you to have a good understanding of what is computed, take care of the sign convention. \end{description} \newpage \subsection*{\underline{cdfmoc:}} \addcontentsline{toc}{subsection}{cdfmoc} \index{cdfmoc} \begin{description} \item[Purpose:] Compute the Meridional Overturning Circulation (partial step case), from the meridional velocity and a basin mask file. \item[Usage:] {\em cdfmoc Vfile } \item[Input:] Vfile is the files holding vomecrty. For instance: {\tt cdfmoc ORCA025-G32\_y0010\_ANNUAL\_gridV.nc } will compute the MOC for with ORCA025-G32 annual mean V field. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc, new\_maskglo.nc (if new\_maskglo.nc does'nt exist, it will work for the global basin; usefull for NATL4 like configs). \\ \item[Output:] The results are output on the file $moc.nc$. There are 5 variables concerning the MOC, one for each sub-basin. They are degenerated 3D variables with the i-dimension reduced to 1 : $zomsfglo$ for the GLObal ocean, $zomsfatl$ for the ATLantic ocean, $zomsfinp$ for the INdoPacific ocean, $zomsfind$ for the INDian ocean and finally $zomsfpac$ for the PACific ocean. Notice that the depth associated to the file corresponds to the W depth (gdepw). $nav\_lon$ is arbitrarly set to 0 ($nav\_lon(1,1:npjglo)$), and $nav\_lat$ is set to the latitude of the i-line going through the North Pole. \item[Remark:] The name Meridional Overturning is a facility of language, because in fact what is computed is the along-I integral of the V component (which is not {\em stricto sensus} meridional | it follows the J-coordinate |) \item[Associated script:] {\em cdfmoc.ll}. \end{description} \newpage \subsection*{\underline{cdfmocsig:}} \addcontentsline{toc}{subsection}{cdfmocsig} \index{cdfmocsig} \begin{description} \item[Purpose:] Compute the Meridional Overturning Circulation (partial step case) in function of $\sigma_1$ from the meridional velocity, a TS file and a basin mask file. \item[Usage:] {\em cdfmocsig Vfile TSfile} \item[Input:] Vfile is the files holding vomecrty, TSfile hold votemper, vosaline for density computation. For instance: {\tt cdfmocsig ORCA025-G32\_y0010\_ANNUAL\_gridV.nc ORCA025-G32\_y0010\_ANNUAL\_gridT.nc } will compute the MOC for with ORCA025-G32 annual mean V field. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc, new\_maskglo.nc \\ \item[Output:] The results are output on the file $mocsig.nc$. There are 5 variables concerning the MOC, one for each sub-basin. They are degenerated 3D variables with the i-dimension reduced to 1 : $zomsfglo$ for the GLObal ocean, $zomsfatl$ for the ATLantic ocean, $zomsfinp$ for the INdoPacific ocean, $zomsfind$ for the INDian ocean and finally $zomsfpac$ for the PACific ocean. Notice that the depth associated to the file corresponds to the W depth (gdepw). $nav\_lon$ is arbitrarly set to 0 ($nav\_lon(1,1:npjglo)$), and $nav\_lat$ is set to the latitude of the i-line going through the North Pole. \item[Remark:] The name Meridional Overturning is a facility of language, because in fact what is computed is the along-I integral of the V component (which is not {\em stricto sensus} meridional | it follows the J-coordinate |) \item[Associated script:] {\em cdfmocsig.ll}. \end{description} \newpage \subsection*{\underline{cdfmocsig-full:}} \addcontentsline{toc}{subsection}{cdfmocsig-full} \index{cdfmocsig-full} \begin{description} \item[Purpose:] Compute the Meridional Overturning Circulation (partial step case) in function of $\sigma_1$ from the meridional velocity, a TS file and a basin mask file. This is the full step version. \item[Usage:] {\em cdfmocsig-full Vfile TSfile} \item[Input:] Vfile is the files holding vomecrty, TSfile hold votemper, vosaline for density computation. For instance: {\tt cdfmocsig-full ORCA025-G32\_y0010\_ANNUAL\_gridV.nc ORCA025-G32\_y0010\_ANNUAL\_gridT.nc } will compute the MOC for with ORCA025-G32 annual mean V field. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc, new\_maskglo.nc \\ \item[Output:] The results are output on the file $mocsig.nc$. There are 5 variables concerning the MOC, one for each sub-basin. They are degenerated 3D variables with the i-dimension reduced to 1 : $zomsfglo$ for the GLObal ocean, $zomsfatl$ for the ATLantic ocean, $zomsfinp$ for the INdoPacific ocean, $zomsfind$ for the INDian ocean and finally $zomsfpac$ for the PACific ocean. Notice that the depth associated to the file corresponds to the W depth (gdepw). $nav\_lon$ is arbitrarly set to 0 ($nav\_lon(1,1:npjglo)$), and $nav\_lat$ is set to the latitude of the i-line going through the North Pole. \item[Remark:] The name Meridional Overturning is a facility of language, because in fact what is computed is the along-I integral of the V component (which is not {\em stricto sensus} meridional | it follows the J-coordinate |) \item[!!!CAUTION !!!:] THIS PROGRAM IS NOT FINISHED YET. DONT USE WITH FULL\_STEPS! \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfmoc-full:}} \addcontentsline{toc}{subsection}{cdfmoc-full} \index{cdfmoc-full} \begin{description} \item[Purpose:] Compute the Meridional Overturning Circulation (partial step case), from the meridional velocity and a basin mask file. \item[Usage:] {\em cdfmoc-full Vfile } \item[Input:] Vfile is the files holding vomecrty. For instance: {\tt cdfmoc-full ORCA025-G04\_y0010\_ANNUAL\_gridV.nc } will compute the MOC for with ORCA025-G04 annual mean V field. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc, new\_maskglo.nc \\ \item[Output:] The results are output on the file $moc.nc$. There are 5 variables concerning the MOC, one for each sub-basin. They are degenerated 3D variables with the i-dimension reduced to 1 : $zomsfglo$ for the GLObal ocean, $zomsfatl$ for the ATLantic ocean, $zomsfinp$ for the INdoPacific ocean, $zomsfind$ for the INDian ocean and finally $zomsfpac$ for the PACific ocean. Notice that the depth associated to the file corresponds to the W depth (gdepw). $nav\_lon$ is arbitrarly set to 0 ($nav\_lon(1,1:npjglo)$), and $nav\_lat$ is set to the latitude of the i-line going through the North Pole. \item[Remark:] The name Meridional Overturning is a facility of language, because in fact what is computed is the along-I integral of the V component (which is not {\em stricto sensus} meridional | it follows the J-coordinate |) \item[Associated script:] {\em cdfmoc-full.ll}. \end{description} \newpage \subsection*{\underline{cdfmocatl:}} \addcontentsline{toc}{subsection}{cdfmocatl} \index{cdfmocatl} \begin{description} \item[Purpose:] Compute the Meridional Overturning Circulation (partial step case), from the meridional velocity and a basin mask file. This program computes the MOC for one basin only. Useful for NATL4. It is now obsolete as cdfmoc does the same, if no new\_maskglo.nc are available. \item[Usage:] {\em cdfmoc Vfile } \item[Input:] Vfile is the files holding vomecrty. For instance: {\tt cdfmocatl NATL4-G07\_y0010\_ANNUAL\_gridV.nc } will compute the MOC for with NATL4-G07 annual mean V field. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, mask.nc \\ \item[Output:] The results are output on the file $moc.nc$. The variable concerning the MOC is adegenerated 3D variables with the i-dimension reduced to 1 : $zomsfatl$ for the ATLantic ocean Notice that the depth associated to the file corresponds to the W depth (gdepw). $nav\_lon$ is arbitrarly set to 0 ($nav\_lon(1,1:npjglo)$), and $nav\_lat$ is set to the latitude of the i-line going through the North Pole. \item[Remark:] The name Meridional Overturning is a facility of language, because in fact what is computed is the along-I integral of the V component (which is not {\em stricto sensus} meridional | it follows the J-coordinate |) \item[Associated script:] {\em cdfmocatl .ll}. ({\em to be written} ) \end{description} \newpage \subsection*{\underline{cdftransportiz:}} \addcontentsline{toc}{subsection}{cdftransportiz} \index{cdftransportiz} \begin{description} \item[Purpose:] Compute volume, heat and salt transport across a section, for depth classes. (Partial Step case ) \item[Usage:] {\em cdftransportiz [ -test u v ] VTfile gridUfile gridVfile 'limit of level' } \item[Input:] VTfiles are the files produced by the cdfvT program. \\ gridV U and gridV files are equivalent files (same period) for U and V. \\ 'limit of levels' are depth in meters where to set limits for depth classes. If no limits are given, the transport is computed for the whole water column. \\ Once the data files are read, the user is asked to give a section name (or 'EOF' for ending the program), followed by the geographical limits of a section (imin imax jmin jmax, in model coordinates). This user interaction can be done with an ascii file given as standard input. ( cdftransportiz ........ $<$ section.dat, for instance ). For instance: cdftransportiz ORCA025-G32\_y0010m01\_VT.nc ORCA025-G32\_y0010m01\_gridU.nc ORCA025-G32\_y0010m01\_gridV.nc 1500 3000 $<$ section .dat \\ will compute the transports across a section (given interactively) in three depth classes : from top to 1500 m, from 1500 m to 3000 m and from 3000 m to the bottom, for section described into section.dat file. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \item[Output:]section\_trp.dat and the standard output (for interactivity). \item[Remark:] The sign of the transport is somewhat tricky. It depends on the inclination of the section. As a rule of the thumb, the transport is $>0$ when going to the right hand side of the section, cruising the section from (imin,jmin) (imax, jmax). When the optional '-test u v ' arguments of the command line are given, the velocity field is assumed to be a constant field with both U and V taken as the arguments. This gives an easy way to check the sign of the transports for a given section. \item[Associated script:] {\em cdftransportiz.ll}. \end{description} \subsection*{\underline{cdftransportizpm:}} \addcontentsline{toc}{subsection}{cdftransportizpm} \index{cdftransportizpm} \begin{description} \item[Purpose:] Compute volume, heat and salt transport across a section, for depth classes. (Partial Step case ), just as cdftransportiz does, but also indicates for each section the Positive (plus) transport and the negative (minus) transport, separately. \item[Usage:] {\em cdftransportizpm [ -test u v ] VTfile gridUfile gridVfile 'limit of level' } \item[Input:] VTfiles are the files produced by the cdfvT program. \\ gridV U and gridV files are equivalent files (same period) for U and V. \\ 'limit of levels' are depth in meters where to set limits for depth classes. If no limits are given, the transport is computed for the whole water column. \\ Once the data files are read, the user is asked to give a section name (or 'EOF' for ending the program), followed by the geographical limits of a section (imin imax jmin jmax, in model coordinates). This user interaction can be done with an ascii file given as standard input. ( cdftransportizpm ........ $<$ section.dat, for instance ). For instance: cdftransportizpm ORCA025-G32\_y0010m01\_VT.nc ORCA025-G32\_y0010m01\_gridU.nc ORCA025-G32\_y0010m01\_gridV.nc 1500 3000 $<$ section .dat \\ will compute the transports across a section (given interactively) in three depth classes : from top to 1500 m, from 1500 m to 3000 m and from 3000 m to the bottom, for section described into section.dat file. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \item[Output:]section\_trp.dat and the standard output (for interactivity). \item[Remark:] The sign of the transport is somewhat tricky. It depends on the inclination of the section. As a rule of the thumb, the transport is $>0$ when going to the right hand side of the section, cruising the section from (imin,jmin) (imax, jmax). When the optional '-test u v ' arguments of the command line are given, the velocity field is assumed to be a constant field with both U and V taken as the arguments. This gives an easy way to check the sign of the transports for a given section. \item[Associated script:] none \end{description} \subsection*{\underline{cdftransportiz-full:}} \addcontentsline{toc}{subsection}{cdftransportiz-full} \index{cdftransportiz-full} \begin{description} \item[Purpose:] Compute volume, heat and salt transport across a section, for depth classes. (Full Step case ) \item[Usage:] {\em cdftransportiz-full [ -test u v ] VTfile gridUfile gridVfile 'limit of level' } \item[Input:] VTfiles are the files produced by the cdfvT program. \\ gridV U and gridV files are equivalent files (same period) for U and V. \\ 'limit of levels' are depth in meters where to set limits for depth classes. If no limits are given, the transport is computed for the whole water column. \\ Once the data files are read, the user is asked to give a section name (or 'EOF' for ending the program), followed by the geographical limits of a section (imin imax jmin jmax, in model coordinates). This user interaction can be done with an ascii file given as standard input. ( cdftransportiz-full ........ $<$ section.dat, for instance ). For instance: cdftransportiz-full ORCA025-G04\_y0010m01\_VT.nc ORCA025-G04\_y0010m01\_gridU.nc ORCA025-G04\_y0010m01\_gridV.nc 1500 3000 $<$ section .dat \\ will compute the transports across a section (given interactively) in three depth classes : from top to 1500 m, from 1500 m to 3000 m and from 3000 m to the bottom, for section described into section.dat file. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \item[Output:]section\_trp.dat and the standard output for interactivity. \item[Remark:] The sign of the transport is somewhat tricky. It depends on the inclination of the section. As a rule of the thumb, the transport is $>0$ when going to the right hand side of the section, cruising the section from (imin,jmin) (imax, jmax). When the optional '-test u v ' arguments of the command line are given, the velocity field is assumed to be a constant field with both U and V taken as the arguments. This gives an easy way to check the sign of the transports for a given section. \item[Associated script:] {\em cdftransportiz-full.ll}. \item[section.dat example:] for example, a {\em section.dat} file used in DRAKKAR, ORCA025 is given below. \begin{verbatim} 01_BERING 452 461 834 834 02_FRAM 1067 1107 941 941 03_BAFFIN 927 981 920 920 04_DENMARK_STRAIT 1025 1055 845 830 05_ICELAND_SCOTLAND 1084 1120 824 785 06_CUBA_FLORIDA 828 828 593 603 07_FLORIDA_BAHAMAS 829 836 610 610 08_DRAKE 880 890 235 142 09_AUS_AA 300 300 340 120 10_ITF 170 170 465 410 11_MOZAMBIQUE_CHANNEL 1309 1328 432 432 EOF \end{verbatim} \end{description} \subsection*{\underline{cdftransportiz\_noheat:}} \addcontentsline{toc}{subsection}{cdftransportiz\_noheat} \index{cdftransportiz\_noheat} \begin{description} \item[Purpose:] same as cdftransportiz but only for mass transport. Usefull when VT files are not available. \item[Usage:] {\em cdftransportiz\_noheat [ -test u v ] gridUfile gridVfile 'limit of level' } \item[Output:]section\_trp.dat and the standard output for interactivity. \end{description} \newpage \subsection*{\underline{cdfmasstrp:}} \addcontentsline{toc}{subsection}{cdfmasstrp} \index{cdfmasstrp} \begin{description} \item[Purpose:] Compute volume transport across a section, for depth classes. (Partial Step case ) \item[Usage:] {\em cdfmasstrp [ -test u v ] gridUfile gridVfile 'limit of level' } \item[Input:] gridV U and gridV files are simultaneous velocity component files. \\ 'limit of levels' are depth in meters where to set limits for depth classes. If no limits are given, the transport is computed for the whole water column. \\ Once the data files are read, the user is asked to give a section name (or 'EOF' for ending the program), followed by the geographical limits of a section (imin imax jmin jmax, in model coordinates). This user interaction can be done with an ascii file given as standard input. ( cdftransportiz ........ $<$ section.dat, for instance ). For instance: cdfmasstrp ORCA025-G32\_y0010m01\_gridU.nc ORCA025-G32\_y0010m01\_gridV.nc 1500 3000 $<$ section .dat \\ will compute the transports across a section (given interactively) in three depth classes : from top to 1500 m, from 1500 m to 3000 m and from 3000 m to the bottom, for section described into section.dat file. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \item[Output:]section\_trp.dat and standard output. .dat file is matlab ready. \item[Remark:] The sign of the transport is somewhat tricky. It depends on the inclination of the section. As a rule of the thumb, the transport is $>0$ when going to the right hand side of the section, cruising the section from (imin,jmin) (imax, jmax). When the optional '-test u v ' arguments of the command line are given, the velocity field is assumed to be a constant field with both U and V taken as the arguments. This gives an easy way to check the sign of the transports for a given section.\\ This program is a simplification of cdftransportiz where the heat and salt transport are not computed anymore. This tool is about the same than cdftransportiz\_noheat, and should be used in place of. The only difference is in that in this program there is no dummy heat/salt transport output. \end{description} \subsection*{\underline{cdfmasstrp-full:}} \addcontentsline{toc}{subsection}{cdfmasstrp-full} \index{cdfmasstrp-full} \begin{description} \item[Purpose:] Compute volume transport across a section, for depth classes. (Full Step case ) \item[Usage:] {\em cdfmass [ -test u v ] gridUfile gridVfile 'limit of level' } \item[Input:] gridV U and gridV files are simultaneous velocity component files. For more details, read the documentation for cdfmasstrp. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \item[Output:]section\_trp.dat and standard output. .dat file is matlab ready. \end{description} \newpage \subsection*{\underline{cdfsigtrp:}} \addcontentsline{toc}{subsection}{cdfsigtrp} \index{cdfsigtrp} \begin{description} \item[Purpose:] Compute density class transport (potential density $\sigma_0$) for either zonal or meridional section, (partial steps). \item[Usage:] {\em cdfsigtrp gridTfile gridUfile gridVfile sigma\_min sigma\_max nbins [options] } \item[Input:] T, U and V files are output file from the model.\\ {\em sigma\_min sigma\_max } gives the lower and upper limit for the density classes $\sigma_0$,\\ $nbins$ is the number of bins (density classes) to explore between $\sigma_{min}$ and $\sigma_{max}$. \\ The program needs an ascii file called {\tt dens\_section.dat} where the sections are described. An example of such a file is given below: \begin{scriptsize} \begin{verbatim} 01_Denmark_strait 1013 1056 832 832 02_Faoes_Bank_Channel 1106 1106 800 808 03_Gibraltar 1126 1126 651 655 EOF \end{verbatim} \end{scriptsize} Note the 'EOF' keyword in the file, which indicates the end of the file for the program. Also note that for this program sections are either zonal or meridional; they cannot be oblique, as it is the case in cdftransportiz.\\ For instance: \\ {\tt cdfsigtrp ORCA025-G50\_y1949\_ANNUAL\_gridT.nc ORCA025-G50\_y1949\_ANNUAL\_gridU.nc \ \\ ORCA025-G50\_y1949\_ANNUAL\_gridV.nc 26 30 80} \\ will compute the density class transport for 80 classes, between $\sigma_0=26$ and $\sigma_0=30$ for the sections described in the file dens\_section.dat \item[Options:] 2 options are available : \begin{itemize} \item[-print] : give extra informations on the standard output for the sections. These are 2D arrays for each section, giving a printed 'map' of density, depth, e3 in the ( distance,vertical) plane. There are also other 2D output for printed map of isopycnal depth, cumulated tansports, and bined transports in the (distance, density) plane. (Useful for short sections !! ) \item[-bimg] : Two bimg files are produced per section. (1) (x/y,depth) for T,S,$\sigma_0$,U (2) (x/y, $\sigma$) for hiso and class transport. It can be used whith sections of any size. It allows a more detailed description of the flow than the standard output of the program (integrated transport along the section). \end{itemize} \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, dens\_section.dat \item[Output:] This program outputs its results on an ASCII file called trpsig.txt which is multicolumns file with the first column giving the density, and other colums the density class transport (in sverdrup) for each section (1 column per section). For example (3 sections): \begin{scriptsize} \begin{verbatim} .../ 27.0000 -0.3498706E+05 0.0000000E+00 0.9302920E+04 27.0500 -0.2951592E+05 0.0000000E+00 0.2953659E+05 27.1000 -0.1460002E+05 0.0000000E+00 0.6516903E+04 27.1500 -0.1678582E+05 0.0000000E+00 0.6516903E+04 27.2000 -0.5445088E+04 0.0000000E+00 0.6516903E+04 27.2500 0.7251206E+04 -0.1140499E+06 0.6062048E+04 27.3000 -0.1079158E+03 -0.7521843E+05 0.5776318E+04 27.3500 0.2931429E+03 -0.7162286E+05 0.5776318E+04 27.4000 0.7215664E+03 -0.1958259E+06 0.5776318E+04 27.4500 0.1075893E+05 -0.2733888E+06 0.6497963E+05 .../ \end{verbatim} \end{scriptsize} First line of this example, indicates the transport for the density class [27.00,27.05[. ( line $k$ is the transport for the density class [$\sigma_k, \sigma_{k+1}$[ ). \item[Remark:] The sign of the transport is $>0$ for northward and eastward transports. \\ A slightly different version of this program, adapted by G. Hervieux is available as cdfsigtrp2.f90. In this version, some outputs were skipped and the cumulated transport is saved as well as the binned transport. (cdfsigtrp2 not maintained). \end{description} \subsection*{\underline{cdfsigitrp:}} \addcontentsline{toc}{subsection}{cdfsigitrp} \index{cdfsigitrp} \begin{description} \item[Purpose:] This program compute density class transport just as cdfsigtrp, but the potential density is refered to a given depth instead of the surface. \item[Usage:] {\em cdfsigitrp gridTfile gridUfile gridVfile sigma\_min sigma\_max nbins zref [options] } \\ Note that this is pretty similar to cdfsigtrp except the zref argument. \item[Input:] idem cdfsigtrp, except additional zref, giving the reference deptht in meters. \item[Required mesh\_mask files or other files:] as cdfsigtrp \item[Output:] as cdfsigtrp \end{description} \newpage \subsection*{\underline{cdfsigtrp-full:}} \addcontentsline{toc}{subsection}{cdfsigtrp-full} \index{cdfsigtrp-full} \begin{description} \item[Purpose:] Compute density class transport for either zonal or meridional section, (full steps). \item[Usage:] {\em cdfsigtrp-full gridTfile gridUfile gridVfile sigma\_min sigma\_max nbins [options] } \item[Input:] T, U and V files are output file from the model.\\ {\em sigma\_min sigma\_max } gives the lower and upper limit for the density classes $\sigma_0$,\\ $nbins$ is the number of bins (density classes) to explore between $\sigma_{min}$ and $\sigma_{max}$. \\ The program needs an ascii file called {\tt dens\_section.dat} where the sections are described. An example of such a file is given below: \begin{scriptsize} \begin{verbatim} 01_Denmark_strait 1013 1056 832 832 02_Faoes_Bank_Channel 1106 1106 800 808 03_Gibraltar 1126 1126 651 655 EOF \end{verbatim} \end{scriptsize} Note the 'EOF' keyword in the file, which indicates the end of the file for the program.\\ For instance: \\ {\tt cdfsigtrp-full ORCA025-G50\_y1949\_ANNUAL\_gridT.nc ORCA025-G50\_y1949\_ANNUAL\_gridU.nc \ \\ ORCA025-G50\_y1949\_ANNUAL\_gridV.nc 26 30 80} \\ will compute the density class tranport for 80 classes, between $\sigma_0=26$ and $\sigma_0=30$ for the sections described in the file dens\_section.dat \item[Options:] 2 options are available : \begin{itemize} \item[-print] : give extra informations on the standard output for the sections. These are 2D arrays for each section, giving a printed 'map' of density, depth, e3 in the ( distance,vertical) plane. There are also other 2D output for printed map of isopycnal depth, cumulated tansports, and bined transports in the (distance, density) plane. (Useful for short sections !! ) \item[-bimg] : Two bimg files are produced per section. (1) (x/y,depth) for T,S,$\sigma_0$,U (2) (x/y, $\sigma$) for hiso and class transport. It can be used whith sections of any size. It allows a more detailed description of the flow than the standard output of the program (integrated transport along the section). \end{itemize} \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc, dens\_section.dat \item[Output:] This program outputs its results on an ASCII file called trpsig.txt which is multicolumns file with the first column giving the density, and other colums the density class transport (in sverdrup) for each section (1 column per section). For example (3 sections): \begin{scriptsize} \begin{verbatim} .../ 27.0000 -0.3498706E+05 0.0000000E+00 0.9302920E+04 27.0500 -0.2951592E+05 0.0000000E+00 0.2953659E+05 27.1000 -0.1460002E+05 0.0000000E+00 0.6516903E+04 27.1500 -0.1678582E+05 0.0000000E+00 0.6516903E+04 27.2000 -0.5445088E+04 0.0000000E+00 0.6516903E+04 27.2500 0.7251206E+04 -0.1140499E+06 0.6062048E+04 27.3000 -0.1079158E+03 -0.7521843E+05 0.5776318E+04 .../ \end{verbatim} \end{scriptsize} First line of this example, indicates the transport for the density class [27.00,27.05[. ( line $k$ is the transport for the density class [$\sigma_k, \sigma_{k+1}$[ ). \item[Remark:] The sign of the transport is $>0$ for northward and eastward transports. \end{description} \newpage \subsection*{\underline{cdftemptrp-full:}} \addcontentsline{toc}{subsection}{cdftemptrp-full} \index{cdftemptrp-full} \begin{description} \item[Purpose:] Compute the transport between isotherms. \item[Usage:] {\em cdftemptrp-full gridTfile gridUfile gridVfile temp\_max temp\_min nbins [options] } \item[Input:] The syntax is almost the same than for cdfsigtrp. Working with temperatures instead of density. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc must be in the current directory. \item[Output:] Ascii file trptemp.txt. \item[Remark:] Contribution of Fred Castruccio. \end{description} \subsection*{\underline{cdftempvol-full:}} \addcontentsline{toc}{subsection}{cdftempvol-full} \index{cdftempvol-full} \begin{description} \item[Purpose:] Compute water volume in a given domain between isotherms. FULL STEPS version \item[Usage:] {\em cdftempvol-full gridTfile imin, imax, jmin, jmax temp\_max temp\_min nbins [options] } \item[Input:] The syntax is almost the same than for cdfsigtrp. Working with temperatures instead of density. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc must be in the current directory. \item[Output:] Ascii file voltemp.txt. \item[Remark:] Contribution of Fred Castruccio. \end{description} \newpage \section{Derived quantities} \subsection*{\underline{cdfsig0:}} \addcontentsline{toc}{subsection}{cdfsig0} \index{cdfsig0} \begin{description} \item[Purpose:] Compute the potential density ${\sigma}_0$. \item[Usage:] {\em cdfsig0 gridT } \item[Input:] gridT is a file holding variables votemper and vosaline. For instance: cdfsig0 ORCA035-G32\_y0008m01d10\_gridT.nc \\ will compute ${\sigma}_0$ for the given file. \item[Required mesh\_mask files or other files:] none \item[Output:] {\em sig0.nc}. This file hold the variable vosigma0. \item[Remark:] The non-linear equation of state of NEMO OPA9 is used. Therefore, one should be aware that ${\sigma}_0$ computed from mean temperature and salinity fields is not the same than the mean ${\sigma}_0$ computed from instantaneous temperature and salinity fields. This tools can take multi time frame input file. \item[Associated script:] {\em cdfsigma0.ll}. This script can be used to compute ${\sigma}_0$ for a run. It scan all the gridT file for a given year and CONFIG, and produce the corresponding sigma0 file. \end{description} \subsection*{\underline{cdfsigi:}} \addcontentsline{toc}{subsection}{cdfsigi} \index{cdfsigi} \begin{description} \item[Purpose:] Compute the potential density ${\sigma}_i$, refered to a particular depth. \item[Usage:] {\em cdfsigi gridT Reference\_depth} \item[Input:] gridT is a file holding variables votemper and vosaline.\\ Reference\_depth is the reference depth in meters. For instance:\\ cdfsigi ORCA035-G32\_y0008m01d10\_gridT.nc 2000 \\ will compute ${\sigma}_i$ for the given file, refered to 2000 m, {\it ie}, ${\sigma}_2$. \item[Required mesh\_mask files or other files:] none \item[Output:] {\em sigi.nc}. This file hold the variable vosigmai, reference depth is documented on the 'long name' attriute. \item[Remark:] The non-linear equation of state of NEMO OPA9 is used. Therefore, one should be aware that ${\sigma}_i$ computed from mean temperature and salinity fields is not the same than the mean ${\sigma}_i$ computed from instantaneous temperature and salinity fields. This tools can take multi time frame input file. \end{description} \subsection*{\underline{cdfsiginsitu:}} \addcontentsline{toc}{subsection}{cdfsiginsitu} \index{cdfsiginsitu} \begin{description} \item[Purpose:] Compute the insitu density ${\sigma}$. \item[Usage:] {\em cdfsiginsitu gridT } \item[Input:] gridT is a file holding variables votemper and vosaline.\\ Depths are taken from the input file. For instance:\\ cdfsiginsitu ORCA035-G32\_y0008m01d10\_gridT.nc \\ will compute ${\sigma}$ for the given file \item[Required mesh\_mask files or other files:] none \item[Output:] {\em siginsitu.nc}. This file hold the variable vosigmainsitu. \item[Remark:] The non-linear equation of state of NEMO OPA9 is used. Therefore, one should be aware that ${\sigma}$ computed from mean temperature and salinity fields is not the same than the mean ${\sigma}$ computed from instantaneous temperature and salinity fields. This tools can take multi time frame input file. \end{description} \newpage \subsection*{\underline{cdfbottomsig0:}} \addcontentsline{toc}{subsection}{cdfbottomsig0} \index{cdfbottomsig0} \begin{description} \item[Purpose:] Compute the bottom potential density ${\sigma}_{0bot}$ (2D variable). \item[Usage:] {\em cdfbottomsig0 gridT } \item[Input:] gridT is a file holding variables votemper and vosaline. For instance: {\tt cdfbottomsig0 ORCA035-G32\_y0008m01d10\_gridT.nc } will compute ${\sigma}_{0bot}$ for the given tag. \item[Required mesh\_mask files or other files:] none \item[Output:] {\em botsig0.nc}. This file hold the variable sobotsig0. \item[Remark:] The non-linear equation of state of NEMO OPA9 is used. Therefore, one should be aware that ${\sigma}_0$ computed from mean temperature and salinity fields is not the same than the mean ${\sigma}_0$ computed from instantaneous temperature and salinity fields. A companion of this program is cdfbottom. \item[Associated script:] {\em cdfbotsig0.ll}. This script can be used to compute ${\sigma}_{0bot}$ for a run. It scan all the gridT file for a given year and CONFIG, and produce the corresponding botsig0 file. \end{description} \newpage \subsection*{\underline{cdfbottomsigi:}} \addcontentsline{toc}{subsection}{cdfbottomsigi} \index{cdfbottomsigi} \begin{description} \item[Purpose:] Compute the bottom potential density ${\sigma}_{ibot}$ (2D variable), refered to the given depth. \item[Usage:] {\em cdfbottomsigi gridT Reference depth} \item[Input:] gridT is a file holding variables votemper and vosaline. For instance: {\tt cdfbottomsigi ORCA035-G32\_y0008m01d10\_gridT.nc 2000 } will compute ${\sigma}_{2bot}$ for the given tag. \item[Required mesh\_mask files or other files:] none \item[Output:] {\em botsigi.nc}. This file hold the variable sobotsigi. \item[Remark:] The non-linear equation of state of NEMO OPA9 is used. Therefore, one should be aware that ${\sigma}_i$ computed from mean temperature and salinity fields is not the same than the mean ${\sigma}_i$ computed from instantaneous temperature and salinity fields. A companion of this program is cdfbottom. \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfbottom:}} \addcontentsline{toc}{subsection}{cdfbottom} \index{cdfbottom} \begin{description} \item[Purpose:] Extract the bottom values for the 3D variables contained in the file given as argument. Bottom values are the values for the last point of the water column before land. \item[Usage:] {\em cdfbottom nc\_file [ $T~|~U~|~V~|~F$ ] } If the point type is specified, look for the corresponding mask in mask.nc file. \item[Input:] Any netcdf file from NEMO output (or diagnosed from NEMO) , containing 3D fields. For instance: {\tt cdfbottom ORCA035-G32\_y0008m01d10\_gridT.nc} will produce a file with the 2D variables {\tt votemper} and {\tt vosaline} corresponding the their bottom value. {\tt cdfbottom ORCA035-G32\_y0008m01d10\_gridU.nc U } will produce a file with the 2D variable vozocrtx, corresponding the the bottom value, the umask being read on the mask.nc file. \item[Required mesh\_mask files or other files:] Eventually mask.nc file if the type point of the C grid is specified. \item[Output:] {\em bottom.nc}. This file hold the variable(s) having the same name than the 3D variables of the input file. \item[Remark:] For the sake of simplicity, and for compatibility with other cdftools, we keep the same variable name in the output file than in the input file, though the output variables are 2D and should 'logically' start with 'so'... \item[Associated script:] {\em cdfbottom.ll}. This script can be used to compute bottom value for a run. \end{description} \newpage \subsection*{\underline{cdfrhoproj:}} \addcontentsline{toc}{subsection}{cdfrhoproj} \index{cdfrhoproj} \begin{description} \item[Purpose:] Project a variable of a netcdf file on an isopycnal surface either specified by a $\sigma_0$ on the command line, or taken from an input file. \item[Usage:] {\em cdfrhoproj [-s0 sigma0] cvar nc\_rhofile nc\_file(*) [ $T~|~U~|~V~|~F$ ] } If the value of $\sigma_0$ for the iso surface is given on the command line, then only this surface is calculated. In other cases, the values for $\sigma_0$ are taken from the local {\em rho\_lev} file, which is a very simple ascii file, with the number of surfaces given on the first line, followed by lines with the required $\sigma_0$ values. CAUTION: these values must increase in the file. \item[Input:] nc\_rhofile already contains the density, cvar is the name of the variable that will be projected on the isopycnal, taken from file nc\_file. Various files can be specified. In order to handle the NEMO C-Grid, and as far as $\sigma_0$ is computed on a T-point, it is possible to specify the grid point type corresponding to the file. (If nothing specified, 'T' is assumed.). In any case, the resulting value are computed on the T-Point. For instance:\\ {\tt cdfrhoproj vozocrtx CONFIG-CASE\_SIGMA0.nc CONFIG-CASE\_gridU.nc U} \\ will project the zonal velocity on the isopycnal defined in {\em rho\_lev} at the T-Points. \\ {\tt cdfrhoproj -s0 27.8 vosaline CONFIG-CASE\_SIGMA0.nc CONFIG-CASE\_gridT.nc } \\ will project the salinity on the 27.8 isopycnal. \item[Required mesh\_mask files or other files:] rho\_lev (if the option -s0 is not given). \item[Output:] {\em nc\_file.nc.interp}. The suffix {\tt .interp} is appended to the input file to produce the output file. The variable name is the same, and an additional variable {\tt vodepiso} is provided; it gives the depth of the isopycnal surfaces. In the output file, the dimension {\tt deptht} is still used, but now represent the rho levels. \item[Remark:] none \item[Associated script:] not done already \end{description} \subsection*{\underline{cdfsigintegr:}} \addcontentsline{toc}{subsection}{cdfsigintegr} \index{cdfsigintegr} \begin{description} \item[Purpose:] This program is used to integrate quantities between isopycnals. \item[Usage:] {\em cdfsigintegr cvar nc\_rhofile nc\_file(*) [ $T~|~U~|~V~|~F$ ] } cvar is the variable to be integrated. It belongs to nc\_file. nc\_rhofile is the file with vosigma0, the potential density refered to surface. Chosen isopycnals are given in a simple ascii file, just the same as in cdfrhoproj: {\em rho\_lev} file, with the number of surfaces given on the first line, followed by lines with the required $\sigma_0$ values. CAUTION: these values must increase in the file. \item[Input:] nc\_rhofile already contains the density, cvar is the name of the variable that will be projected on the isopycnal, taken from file nc\_file. Various files can be specified. In order to handle the NEMO C-Grid, and as far as $\sigma_0$ is computed on a T-point, it is possible to specify the grid point type corresponding to the file. (If nothing specified, 'T' is assumed.). In any case, the resulting value are computed on the T-Point. For instance:\\ {\tt cdfsigintegr cfc11 rhofile.nc ptrcT.nc T }\\ will integrate the CFC11 concentration between isopycnals. (in other word this is the inventory of CFC11 in the density layer). \item[Required mesh\_mask files or other files:] rho\_lev, mesh\_zgr.nc \item[Output:] {\em nc\_file.nc.integr}. The suffix {\tt .integr} is appended to the input file to produce the output file. There are 3 variables in the output file: {\tt inv} (for inventory) which is the targeted integral, {\tt isothick} giving the thickness of the density layers. {\tt vodepiso} which is the depth of individual isopycnal surfaces.\\ Note that both {\tt inv} and {\tt isothick} have a 'vertical' dimension corresponding to density layers, {\it ie} 1 less than the number of isopycanal surfaces given in rho\_lev. In the output file, the dimension {\tt deptht} is still used, but now represent the rho levels. \item[Remark:] none \item[Associated script:] not done already \end{description} \subsection*{\underline{cdfisopycdep:}} \addcontentsline{toc}{subsection}{cdfisopycdep} \index{cdfisopycdep} \begin{description} \item[Purpose:] This program is used to determine the depth of isopycnal. \item[Usage:] {\em cdfisopycdep [-s sigma] nc\_rhofile cdfsigmavar nc\_file(*) } If the value of $\sigma$ for the iso surface is given on the command line, then only this surface is calculated. In other cases, the values for $\sigma$ are taken from the local {\em rho\_lev} file, which is a very simple ascii file, with the number of surfaces given on the first line, followed by lines with the required $\sigma$ values. CAUTION: these values must increase in the file. \item[Input:] nc\_rhofile already contains the density (it can be any kind of density, {\it eg} $\sigma_2$ or in situ $\sigma$), cdfsigmavar is the name of the variable holding the density field. For instance:\\ {\tt cdfisopycdep -s 34.2 CONFIG-CASE\_SIGMA.nc vosigma2 } \\ will compute the $\sigma_2$=34.2 isopycanl depth. \item[Required mesh\_mask files or other files:] rho\_lev (if the option -s0 is not given). \item[Output:] {\em isopycdep.nc}, with one variable {\tt vodepiso}. This variable has a 'vertical' dimension corresponding to the chosen isopycnal surfaces. However, the 'vertical' dimension is still named 'deptht'. \item[Remark:] none \item[Associated script:] not done already \end{description} \newpage \subsection*{\underline{cdfbn2:}} \addcontentsline{toc}{subsection}{cdfbn2} \index{cdfbn2} \begin{description} \item[Purpose:] Compute the Brunt Vaissala frequency. \item[Usage:] {\em cdfbn2 gridT } \item[Input:] gridT is a file holding variables votemper and vosaline. For instance: cdfbn2 ORCA035-G32\_y0008m01d10\_gridT.nc \\ will compute $N^2$ for the given tag. \item[Required mesh\_mask files or other files:]mesh\_zgr.nc, mesh\_hgr.nc \item[Output:] {\em bn2.nc}. This file hold the variable vobn2. Note that this variable is located on T-point. (The intermediate computation is done on w points, but final results are interpolated on T-points. \item[Remark:] This program uses the eosbn2 routine of the NEMO OPA9 code. It is based on an approximation formula given by Mc Dougall et al. ( ). \item[Associated script:] {\em cdfbn2.ll}. This script can be used to compute $N^2$ for a run. It scan all the gridT file for a given year and CONFIG, and produce the corresponding $N^2$ file. \end{description} \subsection*{\underline{cdfbn2-full:}} \addcontentsline{toc}{subsection}{cdfbn2-full} \index{cdfbn2-full} \begin{description} \item[Purpose:] Compute the Brunt Vaissala frequency. (Full step case). \item[Usage:] {\em cdfbn2 gridT } \item[Input:] gridT is a file holding variables votemper and vosaline. For instance: cdfbn2 ORCA035-G04\_y0008m01d10\_gridT.nc \\ will compute $N^2$ for the given tag. \item[Required mesh\_mask files or other files:]mesh\_zgr.nc, mesh\_hgr.nc \item[Output:] {\em bn2.nc}. This file hold the variable vobn2. Note that this variable is located on T-point. (The intermediate computation is done on w points, but final results are interpolated on T-points. \item[Remark:] This program uses the eosbn2 routine of the NEMO OPA9 code. It is based on an approximation formula given by Mc Dougall et al. ( ). \item[Associated script:] {\em cdfbn2-full.ll}. This script can be used to compute $N^2$ for a run. It scan all the gridT file for a given year and CONFIG, and produce the corresponding $N^2$ file. \end{description} \newpage \subsection*{\underline{cdfets:}} \addcontentsline{toc}{subsection}{cdfets} \index{cdfets} \begin{description} \item[Purpose:] Compute the Eddy Time Scale, and Rossby Radius. \item[Usage:] {\em cdfets gridT } \item[Input:] gridT is a file holding variables votemper and vosaline. For instance: cdfets ORCA035-G32\_y0008m01d10\_gridT.nc \\ will compute the eddy time scale and the $1^{st}$ rossby radius for the given tag. \item[Required mesh\_mask files or other files:]mesh\_zgr.nc, mesh\_hgr.nc \item[Output:] {\em ets.nc}. This file hold two variables voets and sorosrad. \item[Remark:] This routine is based on papers from Stammer et al ( ). See Julien.LeSommer@hmg.inpg.fr for more details. \item[Associated script:] {\em cdfets.ll}. \end{description} \newpage \subsection*{\underline{cdfcurl:}} \addcontentsline{toc}{subsection}{cdfcurl} \index{cdfcurl} \begin{description} \item[Purpose:] Compute the curl of a vector field. \item[Usage:] {\em cdfcurl gridU gridV nameU nameV level }\\ If level is different from 0, the 2D curl at level 'level' will be computed. If level is $<=$ 0, then the full 3D curl is computed instead. \item[Input:] gridU, gridV are the cdf files holding the U and V component of the vector, nameU and nameV the cdf name of the variables corresponding to these components. level in the model level where to compute the curl (if $<=$ 0 the 3D curl is computed instead). For instance: cdfcurl ORCA025-G32\_y0008m01d10\_gridU.nc ORCA025-G32\_y0008m01d10\_gridV.nc vozocrtx vomecrty 6 \\ will compute the curl (relative vorticity) at level 6 for the flow field at the given tag. \\ cdfcurl ORCA025-G32\_y0008m01d10\_gridU.nc ORCA025-G32\_y0008m01d10\_gridV.nc sozotaux sometauy 1 \\ will compute the wind-stress curl from the file. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc \item[Output:] {\em curl.nc}. The variable name is socurl(2D) or vocurl (3D case). \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfpv:}} \addcontentsline{toc}{subsection}{cdfpv} \index{cdfpv} \begin{description} \item[Purpose:] Compute the full potential vorticity ( computed at W-point of the C-grid) taking T S U V as input. \item[Usage:] {\em cdfpv gridT gridU gridV }\\ \item[Input:] gridT, gridU, gridV are the cdf files holding the temperature and salinity (gridT) and the U and V components of the velocity. Variables names are assumed to be as in OPA9, respectively {\em votemper, vosaline, vozocrtx, vomecrty}.\\ For instance: cdfpv ORCA025-G70\_y2000m01d05\_gridT.nc ORCA025-G70\_y2000m01d05\_gridU.nc ORCA025-G70\_y2000m01d05\_gridV.nc will compute the potential vorticity. \\ \item[Method:] The potential vorticity is evaluated using the following formula :\\ $ PV = \frac{1}{\rho_0}(f+\zeta)\frac{\partial\sigma_0}{\partial z} $ \\ where $\rho_0 $ takes the constant value of 1020 $kg/m^3$, f is the coriolis parameter ($2\Omega sin(\phi)$), $\zeta$ is the relative vorticity (or the curl) of the flow (as computed by cdfcurl). This program assumes that the model grid is a C-grid. PV is computed at W points, which is the natural point to compute $\frac{\partial\sigma_0}{\partial z} $. $\zeta$ is computed at f-points, u-v level. Therefore, in order to estimate $\zeta$ at W points, a 4-point horizontal average is required (to get $\zeta$ at T-points) followed by a 2-point vertical average to get it at W-points. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr \item[Output:] {\em pv.nc}. The variable name is vopv. Units are $s^{-1}m^{-1}\times10.^{11}$ \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfpvor:}} \addcontentsline{toc}{subsection}{cdfpvor} \index{cdfpvor} \begin{description} \item[Purpose:] Compute the different component of the Ertel potential vorticity. \item[Usage:] {\em cdfpvor gridT gridU gridV }\\ \item[Input:] gridT, gridU, gridV are the cdf files holding the temperature and salinity (gridT) and the U and V components of the velocity. Variables names are assumed to be as in OPA9, respectively {\em votemper, vosaline, vozocrtx, vomecrty}.\\ For instance: cdfpvor ORCA025-G70\_y2000m01d05\_gridT.nc ORCA025-G70\_y2000m01d05\_gridU.nc ORCA025-G70\_y2000m01d05\_gridV.nc will compute the potential vorticity. \\ \item[Method:] The total potential vorticity is evaluated as the sum of the relative vorticity and the stretching. $ PV = (f+\zeta_t)\frac{\partial\sigma_0}{\partial z} $ \\ $ f = 2 \Omega sin ( \phi_t \pi / 180. ) $ \\ $ \zeta_f= \frac{\partial u}{\partial y} - \frac{\partial v}{\partial x} $ \\ and $\zeta_t$ is the mean value of the 4 corners of the grid cell. \\ $ \frac{\partial\sigma_0}{\partial z} $ is deduced from the Brunt-Vaissala frequency, using the code equation of state (McDougall,1987). \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr \item[Output:] {\em pvor.nc}. The variables names are vorelvor, vostrvor and vototvor. Units are $kg\cdot m^{-4}\cdot s^{-1}\times10.^{7}$ \item[Associated script:] none \item[Remark:] This tools is provided by Anne-Marie Treguier. It computes almost the same thing than cdfpv, but using different algorithm. \end{description} \subsection*{\underline{cdflspv:}} \addcontentsline{toc}{subsection}{cdflspv} \index{cdflspv} \begin{description} \item[Purpose:] Compute the large scale potential vorticity. \item[Usage:] {\em cdfpvor gridT }\\ \item[Input:] gridT, holds the temperature and salinity (gridT). Variables names are assumed to be as in OPA9, respectively {\em votemper, vosaline}.\\ For instance: cdfpvor ORCA025-G70\_y2000m01d05\_gridT.nc will compute the large scale potential vorticity. \\ \item[Method:] The large scale potential vorticity is evaluated as the sum of the relative vorticity and the stretching. $ PV = (f)\frac{\partial\sigma_0}{\partial z} $ \\ $ f = 2 \Omega sin ( \phi_t \pi / 180. ) $ \\ $ \frac{\partial\sigma_0}{\partial z} $ is directly computed from $ \sigma_0 $, at W point. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr \item[Output:] {\em lspv.nc}. The variables name is volspv. Units are $kg\cdot m^{-4}\cdot s^{-1}\times10.^{7}$ \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfw:}} \addcontentsline{toc}{subsection}{cdfw} \index{cdfw} \begin{description} \item[Purpose:] Compute the vertical velocity field from the continuity equation and the horizontal flow field. \\ This is for partials steps. \item[Usage:] {\em cdfw gridU gridV [nameU nameV ] }\\ \item[Input:] gridU, gridV are the cdf files holding the U and V component of the vector, nameU and nameV the cdf name of the variables corresponding to these components. If they are not given, we assume that these names are respectively vozocrtx, and vomecrty. For instance: cdfw ORCA025-G32\_y0008m01d10\_gridU.nc ORCA025-G32\_y0008m01d10\_gridV.nc \\ will compute the wn (vertical velocity) for the flow field at the given tag. \\ cdfw vitU.nc vitV.nc uzonal vmeridional \\ will compute wn from vitU.nc and vitV.nc files. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \item[Output:] {\em w.nc}. The variable name is vovecrtz. \item[Associated script:] none \item[Remark:] Comparison of wn computed by the model and wn computed by this program shows small differences ($O(10^{-10})$ ) due to truncature on the flow field. \end{description} \newpage \subsection*{\underline{cdfgeo-uv:}} \addcontentsline{toc}{subsection}{cdfgeo-uv} \index{cdfgeo-uv} \begin{description} \item[Purpose:] Compute the geostrophic velocity from the SSH field. This is for partials steps. \item[Usage:] {\em cdfgeo-uv gridT }\\ \item[Input:] gridT is the file with the SSH named sossheig. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \item[Output:] {\em ugeo.nc, vgeo.nc }. 2 netcdf files with respectively the U geostrophic component (ugeo), and the V geostrophic component (variable vgeo). Note that in the actual version (to be changed ?) ugeo.nc is computed at the V point of the C-grid, vgeo.nc is computed at the U point of the C-grid. \item[Associated script:] none \item[Author]: This is a contribution by Don Julian Juanno del rinc\`on del pedregal, Cisese, Ensenada, MX. \end{description} \newpage \subsection*{\underline{cdfmxl:}} \addcontentsline{toc}{subsection}{cdfmxl} \index{cdfmxl} \begin{description} \item[Purpose:] Compute the mixed layer depth based on 3 different criteria: density criterion with $\rho_{crit}=0.01~kg.m^{-3}$, density criterion with $\rho_{crit}=0.03~kg.m^{-3}$ and temperature criteria with $ |T_{crit}|=0.2^\circ C $. PARTIAL STEP version. \item[Usage:] {\em cdfmxl gridT }\\ \item[Input:] The only file on input is the gridT type file where the program will look for temperature as {\tt votemper}, and salinity as {\tt vosaline}. For instance: {\tt cdfmxl ORCA025-G42\_y0008m01d10\_gridT.nc } will compute the mixed layer depth based on the 3 criteria. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \item[Output:] {\em mxl.nc}. The variable names are somxl010, somxl030 and somxlt02. \item[Associated script:] cdfmxl.ll is a script which computes the mixed layer for each gridT file in a directory. \item[Remark:] There is a recent climatology of the somxlt02 variable [de Boyer Montegut \etal (2004)], which is built from observations of temperature profiles. \end{description} \subsection*{\underline{cdfmxl-full:}} \addcontentsline{toc}{subsection}{cdfmxl-full} \index{cdfmxl-full} \begin{description} \item[Purpose:] Compute the mixed layer depth based on 3 different criteria: density criterion with $\rho_{crit}=0.01~kg.m^{-3}$, density criterion with $\rho_{crit}=0.03~kg.m^{-3}$ and temperature criteria with $ |T_{crit}|=0.2^\circ C $. FULL STEP version \item[Usage:] {\em cdfmxl-full gridT }\\ \item[Input:] The only file on input is the gridT type file where the program will look for temperature as {\tt votemper}, and salinity as {\tt vosaline}. For instance: {\tt cdfmxl ORCA025-G03\_y0008m01d10\_gridT.nc } will compute the mixed layer depth based on the 3 criteria. \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \item[Output:] {\em mxl.nc}. The variable names are somxl010, somxl030 and somxlt02. \item[Associated script:] cdfmxl-full.ll is a script which computes the mixed layer for each gridT file in a directory. \item[Remark:] There is a recent climatology of the somxlt02 variable [de Boyer Montegut \etal (2004)], which is built from observations of temperature profiles. \end{description} \newpage \subsection*{\underline{cdficediags:}} \addcontentsline{toc}{subsection}{cdficediags} \index{cdficediags} \begin{description} \item[Purpose:] Compute ice volume, area and extend (defined as the area where the ice concentration $> 0.15$ ) for both hemisphere. \item[Usage:] {\em cdficediags icemodfile }\\ \item[Input:] ncdf file for icemod output \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mask.nc \item[Output:] The output is done on the standard output. (see below). \item[Associated script:] cdficediags.ll is used for monitoring the ice in ORCA025-G50 \item[Remark:] The ice volume is $\sum thickness * area * fraction $ \end{description} Example of output : \begin{verbatim} Northern Hemisphere NVolume (10^9 m3) 35268.1868656639999 NArea (10^9 m2) 13113.4348328960004 NExtend (10^9 m2) 13062.9962301439991 Southern Hemisphere SVolume (10^9 m3) 4879.33240934399964 SArea (10^9 m2) 3477.76693043200021 SExtend (10^9 m2) 3394.26987212799986 \end{verbatim} \newpage \subsection*{\underline{cdfcensus:}} \addcontentsline{toc}{subsection}{cdfcensus} \index{cdfcensus} \begin{description} \item[Purpose:] Compute the water mass census for a given TS file, with eventual limitation to a specified area. \item[Usage:] {\em cdfcensus gridTfile nlog [-zoom imin imax jmin jmax] [ -klim kmin kmax] [-bimg] }\\ The program computes the water mass census as the T,S binned volume for the whole area or a restricted area specified by the line options. The output is given as an array (S,T) where the value of the array is the volume in the corresponding T,S bin. Additionally, $\sigma_0(S,T), \sigma_1(S,T), \sigma_4(S,T),$ are given computed from the EOS. (Plotting purposes). \\ nlog is an integer number $>=0$ which is used to distort the output: in fact some water masses are extremely dominant in the ocean, with volumes many order of magnitudes above other interesting waters. In order to rescale the output, we apply the following lines of code, as soon as nlog $>0$: \begin{verbatim} ! use a distortion function ( n x log ) to reduce extrema in the output file. DO ji=1,ns DO jj=1,nt dump(ji,jj)=rcensus(ji,jj) DO ilog=1,nlog dump(ji,jj)=ALOG10(1+dump(ji,jj)) END DO END DO END DO \end{verbatim} If option -bimg specified, a bimg file is output instead of a netcdf file. \item[Input:] ncdf file for gridT \item[Required mesh\_mask files or other files:] mesh\_hgr.nc, mesh\_zgr.nc \item[Output:] Output is done on census.nc (variables volcensus,sigma0,sigma2,sigma4). The unit of volcensus is somewhat tricky, depending on the number of log rescaling that where used. A bimg output file is also available if option -bimg given. \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfpendep:}} \addcontentsline{toc}{subsection}{cdfpendep} \index{cdfpendep} \begin{description} \item[Purpose:] Computes penetration depth for passive tracer output. This is the ratio between inventory and surface concentration (2D) field \item[Usage:] {\em cdfpendep TRCfile [-inv inventory\_name -trc trc\_name ] } \item[Input:] TRC file contains the passive tracer outputs. By default, the program assumes that the inventory variable name is {\tt invcfc} and the concentration variable name is {\tt cfc11}. If it is not the case, respective inventory and concentration names must be specified on the command line with -inv and -trc options. \item[Output:] Outpout is done on the {\tt pendep.nc} cdf file with variable {\tt pendep}, units meters. \item[Required mesh\_mask files or other files:] none \item[Associated script:] : none \end{description} \newpage \subsection*{\underline{cdfbci:}} \addcontentsline{toc}{subsection}{cdfbci} \index{cdfbci} \begin{description} \item[Purpose:] Compute the term of energetic transfert for the baroclinic instability \item[Usage:] {\em cdfbci file } \item[Input:] file is produced by a companion tools cdfmoyuvwt which produces the required momentum for the BCI/BTI computation. \item[Output:] bci.nc file contains 5 variables : \begin{enumerate} \item {\bf dTdx}: zonal derivate of Tbar on T point (x1000) \item {\bf dTdy}: meridional derivate of Tbar on T point (x1000) \item {\bf uT}: anomaly of u times anomaly of T on T point \item {\bf vT}: anomaly of v times anomaly of T on T point \item {\bf bci}: transfert of energy for the baroclinic instability (x1000) \end{enumerate} \item[Required mesh\_mask files or other files:] mesh\_hgr.nc \item[Associated script:] : none \item[Author:] Ang\'elique Melet. Ask for details. \end{description} \subsection*{\underline{cdfbti:}} \addcontentsline{toc}{subsection}{cdfbti} \index{cdfbti} \begin{description} \item[Purpose:] Compute the term of energetic transfert for the barotropic instability \item[Usage:] {\em cdfbti file } \item[Input:] file is produced by a companion tools cdfmoyuvwt which produces the required momentum for the BCI/BTI computation. \item[Output:] bti.nc file contains 8 variables : \begin{enumerate} \item {\bf dudx}: zonal derivate of u on T point \item {\bf dvdx}: zonal derivate of v on T point \item {\bf dudy}: meridional derivate of u on T point \item {\bf dvdy}: meridional derivate of v on T point \item {\bf anousqrt}: temporal mean of the square of the zonal speed anomaly \item {\bf anovsqrt}: temporal mean of the square of the meridional speed anomaly \item {\bf anouv}: temporal mean of the Reynolds term \item {\bf bti}: transfert of energy for the barotropic instability \end{enumerate} \item[Required mesh\_mask files or other files:] mesh\_hgr.nc \item[Associated script:] : none \item[Author:] Ang\'elique Melet. Ask for details. \end{description} \subsection*{\underline{cdfkempemekeepe:}} \addcontentsline{toc}{subsection}{cdfkempemekeepe} \index{cdfkempemekeepe} \begin{description} \item[Purpose:] Compute the term of energetic transfert from mean kinetic energy to mean potential energy (T1) and from eddy potential energy to eddy kinetic energy (T3) \item[Usage:] {\em cdfkempemekeepe file } (pronounciation is as read.) \item[Input:] file is produced by a companion tools cdfmoyuvwt which produces the required momentum for the BCI/BTI computation. \item[Output:] transfertst1t3.nc file contains 2 variables : \begin{enumerate} \item {\bf wT}: temporal mean of w times temporal mean of T on T point (*1000) \item {\bf anoW}: temporal mean of anomaly of w times ano of T on T point (*1000) \end{enumerate} \item[Required mesh\_mask files or other files:] none \item[Associated script:] : none \item[Author:] Ang\'elique Melet. Ask for details. \end{description} \subsection*{\underline{cdfnrjcomp:}} \addcontentsline{toc}{subsection}{cdfnrjcomp} \index{cdfnrjcomp} \begin{description} \item[Purpose:] Compute the terms for energy components (Mean Kinetic Energy, Eddy Kinetic Energy, Mean Potential Energy, Eddy Potential Energy ) compute : tbar,ubar,vbar,anotsqrt,anousqrt,anovsqrt \item[Usage:] {\em cdfnrjcomp file } \item[Input:] file is produced by a companion tools cdfmoyuvwt which produces the required momentum for the BCI/BTI computation. \item[Output:] nrjcomp.nc file contains 6 variables : \begin{enumerate} \item {\bf tbar} : temporal mean of the temperature on T point \item {\bf ubar}: temporal mean of the zonal velocity on T point \item {\bf vbar}: temporal mean of the meridional velocity on T point \item {\bf anotsqrt}: temporal mean of the square of the temperature anomaly on T point (*1000) \item {\bf anousqrt}: temporal mean of the square of the zonal speed anomaly on T point (*1000) \item {\bf anovsqrt}: temporal mean of the square of the meridional speed anomaly on T point (*1000) \end{enumerate} \item[Required mesh\_mask files or other files:] none \item[Associated script:] : none \item[Author:] Ang\'elique Melet. Ask for details. \end{description} \newpage \section{Extracting and information tools} \subsection*{\underline{cdfprofile:}} \addcontentsline{toc}{subsection}{cdfprofile} \index{cdfprofile} \begin{description} \item[Purpose:] Extract a vertical profile for a given variable in a given file at a given I J \item[Usage:] {\em cdfprofile I J file\_name var\_name } \item[Input:] I J : i, j position where to look at the profile \\ file\_name : name of the file \\ var\_name : name of the variable \\ For instance: cdfprofile 32 45 ORCA035-G32\_y0008m01d10\_gridT.nc votemper \\ \item[Required mesh\_mask files or other files:] none \item[Output:] output is done on standard output \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfprobe:}} \addcontentsline{toc}{subsection}{cdfprobe} \index{cdfprobe} \begin{description} \item[Purpose:]Display a 2 columns output time(d) value \item[Usage:] {\em cdfprobe cdf\_file I J cdfvar [level]} \item[Input:] cdf\_file = name of the file \\ I J : position where to look at cdfvar : name of the cdf variable \\ level : (optional) : Level where to look at example: cdfprobe u10.nc 300 350 u10 \\ example: cdfprobe alltag\_gridT.nc 240 234 votemper 30 \item[Required mesh\_mask files or other files:] none \item[Output:] output is done on standard output \item[Associated script:] none \end{description} \subsection*{\underline{cdfwhereij:}} \addcontentsline{toc}{subsection}{cdfwhereij} \index{cdfwhereij} \begin{description} \item[Purpose:] Give the longitude and latitude of the (i,j) points from a coordinate file. \item[Usage:] {\em cdfwhereij imin imax jmin jmax coordinate\_file point\_type } \item[Input:] imin, imax, jmin, jmax : zoom in i,j coordinates \\ coordinate\_file : either a coordinate or a mesh\_hgr file \\ point\_type : either T, U, V or F in upper or lower case \\ For instance: cdfwhereij 32 45 123 432 coordinate\_orca025.nc f \\ will give the zoom position in longitude latitude coordinates, for the f points \item[Required mesh\_mask files or other files:] either coordinates or mesh\_hgr files. \item[Output:] output is done on standard output \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdffindij:}} \addcontentsline{toc}{subsection}{cdffindij} \index{cdffindij} \begin{description} \item[Purpose:] Give the i,j corresponding to longitude and latitude given as arguments. \item[Usage:] {\em cdffindij xmin xmax ymin ymax [coordinate\_file] [point\_type] } \item[Input:] xmin, xmax, ymin, ymax : zoom in geographical coordinates \\ coordinate\_file : either a coordinate or a mesh\_hgr file. If not given, assumes $coordinates.nc$ \\ point\_type : either T, U, V or F in upper or lower case. If not given assumes $F$ \\ For instance: cdffindij -30 0 -20 40 coordinate\_orca025.nc f \\ will give the zoom position imin imax jmin jmax for the given configuration, for nearest f-points. \\ {\tt cdffindij -180 0 -20 25 coordinates\_ORCA\_R025\_lombok+ombai.nc F} \\ gives: \begin{verbatim} rdis = 0.1316580027 rdis = 0.1287123561 430 1149 417 602 -179.88 -0.12 -19.96 25.03 \end{verbatim} rdis is a raw estimation (in Deg.) of the distance between the given position, and the real position. In some cases, the search algorithm fails (zoom across boundaries or in very distorted regions), and an error message is displayed. \item[Required mesh\_mask files or other files:] either coordinates or mesh\_hgr files. \item[Output:] output is done on standard output \item[Remark:] The arguments must be in the proper order. In particular, if the user needs to specify the point\_type it is necessary to also specify the name of the coordinate file. \item[Associated script:] none \end{description} \subsection*{\underline{cdfcofdis:}} \addcontentsline{toc}{subsection}{cdfcofdis} \index{cdfcofdis} \begin{description} \item[Purpose:] Compute the distance from the coast at the surface of the ocean, and write it to a netcdf file, just as the cofdis routine of OPA does. This is therefore the off-line version of cofdis. Remember that the on-line version is not mpp compliant! The given distance corresponds to T points. \item[Usage:] {\em cdfcofdis mesh\_hgr.nc mask.nc gridT.nc } \item[Input:] the mesh\_zgr and mask files are given on input (with arbitrary names), together with a gridT file, used only for size and depth references. \item[Required mesh\_mask files or other files:] given as argument \item[Output:] The output file is named dist.coast, with variable name $Tcoast$. Despites its name it is a netcdf file. Name is kept as in NEMO. \end{description} \newpage \subsection*{\underline{cdfweight:}} \addcontentsline{toc}{subsection}{cdfweight} \index{cdfweight} \begin{description} \item[Purpose:] Return a binary weight file to be used by cdfcoloc. \item[Usage:] {\em cdfweight Greg\_File [coord\_file] [point\_type]} \item[Input:] Greg\_file = Like G. Holloway file : asci file iyxz.txt (is a station id). \\ coordinate\_file : either a coordinate or a mesh\_hgr file. If not given, assumes $coordinates.nc$ \\ point\_type : either T, U, V or F in upper or lower case. If not given assumes $F$ \\ produce a weight file called weight\_point\_type.bin \\ For instance: cdfweight iyxz7904.txt coordinate\_ORCA025.nc T \\ will produce weight\_T.bin file. \item[Required mesh\_mask files or other files:] either coordinates or mesh\_hgr files, mesh\_zgr.nc \item[Output:] weight file. This file is an unformatted binary fortran file, suitable for cdfcoloc. It contains as many records as stations in the input ascii file. Each record consists of :\\ ID ymin xmin idep imin jmin kmin iquadran hN alpha beta gamma (read the code for more details).\\ \item[Remark:] The arguments must be in the proper order. In particular, if the user needs to specify the point\_type it is necessary to also specify the name of the coordinate file. \item[Associated script:] none \end{description} \subsection*{\underline{cdfcoloc:}} \addcontentsline{toc}{subsection}{cdfcoloc} \index{cdfcoloc} \begin{description} \item[Purpose:] Return an ascii file with colocalized U V Sx Sy and H from a weight file given as input. \item[Usage:] {\em cdfcoloc weight\_root gridT gridU gridV } \item[Input:] weight\_root is the begining of the weight file name (excluding \_T.bin, \_U.bin or \_V.bin ) \\ grid T gridU gridV are the model outputfile from which we take the velocities to be colocalized. \item[Required mesh\_mask files or other files:] either coordinates or mesh\_hgr files, mesh\_zgr.nc and mask.nc \item[Output:] produced a default izUVSxSyH.txt ASCII file, formed with 7 columns of data and one line per station. \\ i, z : station ID and depth (as on the Greg file). \\ U V : E-W and N-S (geographic) velocity component.(cm/s) \\ Sx, Sy : e-W and N-S (geographic) bottom slope (\%)\\ H: bottom topography (m) \\ All these values are computed with a trilinear interpolation at the station location. \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfweight2D:}} \addcontentsline{toc}{subsection}{cdfweight2D} \index{cdfweight} \begin{description} \item[Purpose:] Return a binary weight file to be used by cdfcoloc. \item[Usage:] {\em cdfweight track.iyxz [pseudo\_coord\_file] [point\_type]} \item[Input:] track.iyxz: is a survey bathymetric track file, taken from GEODAS web site, for instance (file.xyz), modified in order to have i lat lon bathy in this order. A script is provided to change file.xyz into file.iyxz (see below) \\ pseudo\_coordinate\_file : either a coordinate or a mesh\_hgr file. If not given, assumes $coordinates.nc$ \\ point\_type : either T, U, V or F in upper or lower case. If not given assumes $F$ \\ produce a weight file called weight\_point\_type.bin \\ For instance: cdfweight iyxz.txt pseudo\_coordinates\_zapiola\_etopo1.nc T \\ will produce weight\_T.bin file. \item[Required mesh\_mask files or other files:] either coordinates or mesh\_hgr files, mesh\_zgr.nc \item[Output:] weight file. This file is an unformatted binary fortran file, suitable for cdfcoloc. It contains as many records as stations in the input ascii file. Each record consists of :\\ ID ymin xmin idep imin jmin kmin iquadran hN alpha beta gamma (read the code for more details).\\ \item[Remark:] This program is a downgrade of cdfweight. Produced weight files will be used by cdfcoloc2d. It is suitable to treat bathymetric files, for instance (etopo1, GEBCO etc...), in order to colocate hydrographic tracks. \item[Associated script:] xyz2iyxz.ksh to convert GEODAS xyz file into input file for cdfweight2D \end{description} \subsection*{\underline{cdfcoloc2D:}} \addcontentsline{toc}{subsection}{cdfcoloc2D} \index{cdfcoloc2D} \begin{description} \item[Purpose:] Return an ascii file with colocalized H from a weight file given as input. \item[Usage:] {\em cdfcoloc2D weight\_root BATHYFILE } \item[Input:] weight\_root is the begining of the weight file name (excluding \_T.bin) \\ BATHYFILE is a bathymetric file such as ETOPO1 or GEBCO1 for instance. \item[Required mesh\_mask files or other files:] either coordinates or mesh\_hgr files \item[Output:] produced a default izb.txt ASCII file, formed with 3 columns of data and one line per station. \\ i, z : station ID and depth (as on the Greg file). \\ H: bottom topography (m) \\ All these values are computed with a bilinear interpolation at the station location. \item[Remark:] mesh\_hgr.nc file is in this case a pseudo\_coordinates.nc file, computed fron the lon,lat input file by mkcoor.f90 \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfclip:}} \addcontentsline{toc}{subsection}{cdfclip} \index{cdfclip} \begin{description} \item[Purpose:] Extract a subzone of a netcdf file. \item[Usage:] {\em cdfclip -f file -zoom imin imax jmin jmax [kmin kmax ]} \item[Input:] file is the netcdf file to clip \\ imin imax jmin jmax are the limit in (I,J) space to clip. If optional kmin and kmax are given, cdfclip also clip in the vertical direction. Otherwise, it clips the whole depth of the file. For instance: cdfclip -f coordinates.nc -zoom 100 300 250 400 \item[Required mesh\_mask files or other files:] none \item[Output:] output is done on {\tt cdfclip.nc} with same variables name as original. \item[Remark:] Still to be done : limit to specified variables, clip on the vertical. \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfmaxmoc:}} \addcontentsline{toc}{subsection}{cdfmaxmoc} \index{cdfmaxmoc} \begin{description} \item[Purpose:] Give the max and min intensity of the MOC, previously computed with cdfmoc. \item[Usage:] {\em cdfmaxmoc moc\_file basin latmin latmax depmin depmax } \item[Input:] moc\_file is the netcdf file computed with $cdfmoc$ or $cdfmoc-full$ \\ basin is an indicator for the required basin. Can either atl, inp, ind, pac or glo. \\ latmin, latmax, depmin, depmax is the window (lat,dep) where the extrema are searched. For instance: cdfmaxmoc ORCA025-G42\_y0010\_MOC.nc atl -30 70 200 5000 \\ will indicates the max/min of the overturning and their respective location, for year 10 of the run ORCA025-G42, for Atlantic basin, limited to 30S-70N, between 200 m and 5000 m depth. \item[Required mesh\_mask files or other files:] none \item[Output:] output is done on standard output \item[Remark:] depmin and depmax are given as positive. \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfzoom:}} \addcontentsline{toc}{subsection}{cdfzoom} \index{cdfzoom} \begin{description} \item[Purpose:] Shows an ASCII representation of a 2D (x-y, x-z or y-z) slab of any variable from an output file \item[Usage:] {\em cdfzoom -f ncfile -zoom imin imax jmin jmax [-lev kmin kmax] [-fact scale\_factor] [-var cdfvarname] } \item[Input:] ncfile is the name of the file to look at. \\ imin,imax,jmin,jmax are the limits for the horizontal zoom. \\ kmin, kmax are the limits for the vertical zoom. If kmin $=$ kmax, then the x-y slab is shown at level kmin. If kmax $>$ kmin, then either a x-z or y-z slab will be shown, but in this case, either imin$=$imax, or jmin$=$jmax, otherwise the program will stop. \\ scale\_factor is an optional dividing scale factor used to adjust the output values to the fortran format (f12.4) \\ cdfvarname is the name of the variable you want to look at. If not given, or wrong name, the program will propose the list of available variables. \\ For instance: cdfzoom -f ORCA05-G50\_y1949m01d30\_gridT.nc -lev 1 43 -zoom 470 482 175 175 -var votemper \\ will show the vertical slab (x-z) of the temperature field, at J=175, for I between 470 and 482, K from 1 to 43 \item[Required mesh\_mask files or other files:] none \item[Output:] output is done on standard output \item[Associated script:] none \end{description} \newpage \subsection*{\underline{cdfbathy:}} \addcontentsline{toc}{subsection}{cdfbathy} \index{cdfbathy} \begin{description} \item[Purpose:] Modify a bathymetric file for NEMO, in many different ways. \item[Usage:] {\em cdfbathy -f bathy\_file -zoom imin imax jmin jmax -fillzone -fullstep depmin -replace 'file' -dumpzone 'file' -a -o } \\ -file (or -f ) : name of bathy file \\ -zoom (or -z ) : sub area of the bathy file to work with (imin imax jmin jmax) \\ -fillzone (or -fz ) : sub area will be filled with 0 up to the first coast line \\ -raz\_zone (or -raz ) : sub area will be filled with 0 up \\ -raz\_below (or -rb ) depmin : bathy set to 0 in the area when bathy <= depmin \\ -fullstep (or -fs ) depmin : sub area will be reshaped as full-step, below depmin \\ requires the presence of the file zgr\_bat.txt (from ocean.output, eg ) \\ -dumpzone (or -d ): sub area will be output to an ascii file, which can be used by -replace \\ after manual editing \\ -nicedumpzone (or -nd ): sub area will be output to an ascii file (nice output) \\ -replace (or -r ) : sub area defined by the file will replace the original bathy \\ -append (or -a ) : fortran log file (log.f90) will be append with actual modif \\ Standard behaviour is to overwrite/create log file \\ -overwrite (or -o ): input bathy file will be used as output. \\ Standard behaviour is to use a work copy of the original file \\ (indexed from 01 to 99 if necessary ) \item[Input:] This program allows a short syntax for option, and a longer, more mnemonic. \\ Basically, this program works on a copy of the input file, indexed from 01 to 99 if necessary. You can work directly on the input file with the option -overwrite ( or -o), but take care that original data will be modified. \\ The second important point is that all actions specified through the options apply to the sub-area indicated by the zoom option, given in the (I,J) space. \\ Specific actions are then controled by the options :\\ \begin{description} \item[information]: just create an ascii file with a formatted copy of the sub-area \\ -dumpzone (-d) 'file.txt' \\ -nicedumpzone (-nd) 'file.txt', same as -d but with a different format. \item[modification]: For these king of action, a log file (log.f90) is maintained. It records the different modification in a fortran 90 file, that can be used afterward to replace the original bathy. Changes can be append to the log file if -append (-a) option is given. The possible modifications are :\\ -fillzone (-fz) : Fill a subarea between the edge of the domain and the 1rst coast line point. Usefull to fill the Pacific, for instance, in a NATL4 configuration, extracted from ORCA025.\\ -raz\_zone (-raz) : the sub-area is set to 0. \\ -replace (-r) 'file.txt' : replace the 'patch' of bathymetry given by file.txt in the input file. The file.txt is typically created from a previous call with -dumpzone option, and manually edited to fix some details of the topography. \\ -fullstep (-fs) : the bathy defined in the sub-area will be z-step like bathymetry. This option requires, an ASCII file describing the vertical discretization of the model. This file ( {\tt zgr\_bat.txt} ) is made from a copy of {\tt ocean.output} \end{description} \item[Required mesh\_mask files or other files:] {\tt zgr\_bat.txt} for -fs option. ( Should be replace by mesh\_zgr.nc) \item[Output:] Output file is 'input\_file'.nn where nn is a 2 digit integer incremented as necessary not to overwrite existing file. \item[Associated script:] none \item[Remark:] This program was written for helping the user to tune a bathymetric file. Its dump/replace capability as well as the log file maintenance is very much appreciated. It can be improved or extended with new options, if necessary. However, it is not intended to replace the OPABAT package, which well performs initial interpolation and filtering. \item[Example:] none \end{description} \newpage \subsection*{\underline{cdfvar:}} \addcontentsline{toc}{subsection}{cdfvar} \index{cdfvar} \begin{description} \item[Purpose:] Extension to any variable of a file of cdfbathy (see cdfbathy for details). \item[Usage:] {\em -f file -v var -zoom imin imax jmin jmax klev jtime -fillzone -fullstep depmin -replace 'file' -dumpzone 'file' -a -o} \item[Input:] same as cdfbathy. In addition, you specify the variable name to work with, and the level in the zoom option \item[Required mesh\_mask files or other files:] \item[Output:] as cdfbathy \item[Remark/bugs :] This program requires some cleaning as some options are not relevant for a variable different than bathymetry ... For instance, do not use options such as -fullstep with temperature or salinity ... this may lead to stupid results ! \item[Associated scripts:] none \end{description} \newpage \subsection*{\underline{cdfmax:}} \addcontentsline{toc}{subsection}{cdfmax} \index{cdfmax} \begin{description} \item[Purpose:] Display min/max of a variable in a file, and their respective location. A sub area can be specified either horizontally or vertically. \item[Usage:] {\em cdfmax -f ncfile [-var cdfvarname] [-zoom imin imax jmin jmax] [-lev kmin kmax] [-fact scale\_factor] [-xy]} \item[Input:] ncfile is the name of the file to look at. \\ cdfvarname is the name of the variable you want to look at. If not given, or wrong name, the program will propose the list of available variables. \\ imin,imax,jmin,jmax are the limits for the horizontal zoom. \\ kmin, kmax are the limits for the vertical zoom. \\ A vertical slab can thus be specified, playing around with the limits. \\ scale\_factor is an optional multiplying scale factor usefull for units change. \\ If -xy option is used, cdfmax is forced to work on an horizontal slab, whatever the limits are. For instance: \\ \scriptsize{ \begin{verbatim} cdfmax -f ORCA05-G60_y1968m12d26_gridT.nc -zoom 500 500 300 500 -var votemper votemper with multiplying factor of 1.000000000 i-slab MAX: i long j lat k dep MaxValue MIN: i long j lat k dep MinValue 500 500 -37.75 300 24.24 8 63.88 0.24313E+02 500 -88.71 499 82.95 1 3.05 -0.17027E+01 \end{verbatim} } will show the min/max temperature over the vertical slab (y-z) at I=500, for J between 300 and 500. \scriptsize{ \begin{verbatim} cdfmax -f ORCA05-G60_y1968m12d26_gridT.nc -fact 100 -var sossheig sossheig with multiplying factor of 100.0000000 level dep MAX: i long j lat MaxValue MIN: i long j lat MinValue 1 3.05 56 100.25 277 13.38 0.15471E+03 566 -4.75 92 -61.73 -0.13513E+03 \end{verbatim} } will show the min/max SSH in cm. \item[Required mesh\_mask files or other files:] none \item[Output:] output is done on standard output \item[Associated script:] none \item[Remark:] In the CDFTOOLS directory, the attentive reader will find a {\em cdfmax-test} version of this program. It is a beta version where the input file may have more than one time step in it. It requires modification in cdfio, and it is not working in the standard distribution. Wait for next one ! \end{description} \newpage \subsection*{\underline{cdfmax\_sp:}} \addcontentsline{toc}{subsection}{cdfmax\_sp} \index{cdfmax\_sp} \begin{description} \item[Purpose:] Display min/max of a variable in a file, and their respective location. A sub area can be specified either horizontally or vertically. This is very similar to cdfmax, except that it takes into account the 'missing\_value' attribute for variables. \item[Usage:] {\em cdfmax\_sp -f ncfile [-var cdfvarname] [-zoom imin imax jmin jmax] [-lev kmin kmax] [-fact scale\_factor] [-xy] } \item[Input:] ncfile is the name of the file to look at. \\ cdfvarname is the name of the variable you want to look at. If not given, or wrong name, the program will propose the list of available variables. \\ imin,imax,jmin,jmax are the limits for the horizontal zoom. \\ kmin, kmax are the limits for the vertical zoom. \\ A vertical slab can thus be specified, playing around with the limits. \\ scale\_factor is an optional multiplying scale factor usefull for units change. \\ If -xy is specified, the program is forced to work on an horizontal slab, even if 1 direction is degenerated. \item[Required mesh\_mask files or other files:] none \item[Output:] output is done on standard output \item[Associated script:] none \item[Remark:] In the CDFTOOLS directory, the attentive reader will find a {\em cdfmax-test} version of this program. It is a beta version where the input file may have more than one time step in it. It requires modification in cdfio, and it is not working in the standard distribution. Wait for next one ! \end{description} \newpage \subsection*{\underline{cdf16bit:}} \addcontentsline{toc}{subsection}{cdf16bit} \index{cdf16bit} \begin{description} \item[Purpose:] Convert a 32 bit (real*4, or float) model output file into a 16 bit (integer*2 or short) outputfile. The program scans the variables of the file given as input, and if the variables name's is within a pre-defined list (see below), then a \SF and an \ao values are determined to re-map the float onto a short. Used \SF and \ao are written to the file as an attribute of the given variable. These attributes are now recognized by many Netcdf tools and if they exist in the file they are used as soon as the file is read. Defaut values are respectively 1 and 0. Additional capability is provided for variables with a great range of values, for which the scaling results in a big loss in precision: The log10 of the field is taken before the scaling. This works only for positive values. The save\_log10 attribute is associated to this capability. It can take the value 0 (default, no log10 taken) or 1 ( log10 transform before scaling). \item[Usage:] {\em cdf16bit 32\-bit\_ncfile [-check] [-verbose] } \item[Input:] 32\-bit\_ncfile is the data file.\\ -check : This option enables a checking of the scaling : a warning is emitted if the scaling results in an overflow for short variable. The min and max values of the corresponding field is indicated, and a suggestion is made for changing \SF and \ao. \\ -verbose : this implicitely activates -check. It gives the same kind of information but in case of 3D variables, details are given foreach level. \\ For instance: cdf16bit ORCA025-G70\_y2004m02\_gridT.nc -check \\ will produce a cdf16bit file with the same variable name as in the input file. \item[Required mesh\_mask files or other files:] none \item[Output:] output is done on cdf16bit.nc file. \item[Comments:] A DRAKKAR rule is to rename this file as the original 32 bits file, but with nc16 extension. The -check option is encouraged at least when initiating the conversion. If the \SF ansd \ao are not adequate, the only way is to get the code and change the values, which are hard coded (in fact, what is hard coded are the min and max value for a given variable; \SF and \ao are deduced from them). \item[Details:] The standard variables of model output are automatically recognize. Variables not in the list are kept in float. At present, only the vertical diffusivity (votkeavt) is saved using log10. \begin{small} \begin{verbatim} votemper ! Potential temperature (Deg C) vosaline ! Salinity (PSU) sossheig ! Sea Surface Heigh (m) somxl010 ! Mixed layer depth (m) sohefldo ! Total Heat flux Down (W/m2) soshfldo ! Solar Heat flux Down (W/m2) sowaflup ! Evaporation - Precipitation Up ( kg/m2/s) sowafldp ! SSS damping term Up (kg/m2/s ) iowaflup ! ??? sowaflcd ! Concentration Dilution water flux (kg/m2/s) solhflup ! Latent Heat Flux Up (W/m2) solwfldo ! Long Wave radiation Heat flux Down (W/m2) sosbhfup ! Sensible Heat Flux Up (W/m2) vozocrtx ! Zonal Velocity U (m/s) sozotaux ! Zonal Wind Stress (N/m2) vomecrty ! Meridional Velocity V (m/s) sometauy ! Meridional Wind Stress (N/m2) vovecrtz ! Vertical Velocity W (m/s) votkeavt ! Vertical mixing coef log(avt) log(m2/s) : USE SAVE_LOG10 isnowthi ! Snow Thickness (m) iicethic ! Ice Thickness (m) iiceprod ! Ice Production (m/kt) (step ice) ileadfra ! Ice Lead Fraction (%) (In fact, ice concentration) iicetemp ! Ice Temperature (Deg C ) ioceflxb ! Ocean Ice flux (W/m2) iicevelu ! Zonal Ice Velocity (m/s) (at U point) iicevelv ! Meridional Ice Velocity (m/s) (at V point) isstempe ! Sea Surface Temperature (Deg C) isssalin ! Sea Surface Salinity (PSU) iocetflx ! Total Flux at Ocean Surface (W/m2) iocesflx ! Solar Flux at Ocean Surface (W/m2) iocwnsfl ! Non Solar Flux at Ocean surface (W/m2) iocesafl ! Salt Flux at Ocean Surface (kg/m2/kt) iocestru ! Zonal Ice Ocean Stress (N/m2) iocestrv ! Meridional Ice Ocean Stress (N/m2) iicesflx ! Solar FLux at ice/ocean Surface (W/m2) iicenflx ! Non Solar FLux at ice/ocean Surface (W/m2) isnowpre ! Snow Precipitation (kg/day) \end{verbatim} \end{small} A more flexible way to operate will be imagined soon ! Let float being the physical value and short the stored value, then the following formula applies \\ $ float = short \times \SF + \ao $ \item[Associated script:] cdf16bit.ll \end{description} \subsection*{\underline{cdfconvert:}} \addcontentsline{toc}{subsection}{cdfconvert} \index{cdfconvert} \begin{description} \item[Purpose:] Convert a set of dimgfile (Clipper like) to a set of CDF files (Drakkar like ) \item[Usage:] {\em cdfconvert 'Clipper tag ' 'CLIPPER confcase'} \item[Input:] Clipper tag is the tag of the dimg clipper file. \\ CLIPPER confcase is for instance ATL6-V6 \item[Required mesh\_mask files or other files:] mesh\_hgr.nc and mesh\_zgr.nc. There are 2 programs (coordinates2hgr.f90 and coordinates2zgr.f90) which do the job! They require a coordinates.diags and an ASCII bathy file, {\it a la clipper}. Although they are not built as cdftools, the are provided in the cdftools distribution for convenience. \item[Output:] {\tt CONFCASE\_TAG\_grid[TUV].nc,CONFCASE\_TAG\_PSI.nc } with the standard name for variables. \item[Associated script:] convclipper2nc.ksh \item[Remark:] As you can see in the associated script, for a given tag, the full bunch of clipper files must be located in the current directory. ({\it ie} \_U\_, \_V\_, \_T\_, \_S\_, \_2D\_ and eventually \_SSH\_. \_UU\_ and \_VV\_ ) \end{description} \newpage \subsection*{\underline{cdfflxconv:}} \addcontentsline{toc}{subsection}{cdfflxconv} \index{cdfflxconv} \begin{description} \item[Purpose:] Convert a set of fluxes dimgfile (Clipper like) to a set of CDF files (Drakkar like ) \item[Usage:] {\em cdfflxconv YEAR CONFIG } \item[Input:] YEAR is the year on 4 digits, CONFIG, is the CLIPPER config name ({\it eg} ATL3 \item[Required mesh\_mask files or other files:] clipper coordinates.diags file. \item[Output:] This program creates 6 netcdf file with the standard NEMO name for forced simulation:\\ \begin{verbatim} ECMWF_emp_1d_${year}.${config}.nc ECMWF_qnet_1d_${year}.${config}.nc ECMWF_qsr_1d_${year}.${config}.nc ECMWF_sst_1d_${year}.${config}.nc ECMWF_taux_1d_${year}.${config}.nc ECMWF_tauy_1d_${year}.${config}.nc \end{verbatim} \item[Associated script:] cdfflxconv.ll \item[Remark:] \end{description} \newpage \subsection*{\underline{cdfsstconv:}} \addcontentsline{toc}{subsection}{cdfsstconv} \index{cdfsstconv} \begin{description} \item[Purpose:] Convert a set of SST dimgfile (Clipper like) to a set of CDF files (Drakkar like ) \item[Usage:] {\em cdfsstconv YEAR CONFIG } \item[Input:] YEAR is the year on 4 digits, CONFIG, is the CLIPPER config name ({\it eg} ATL3 \item[Required mesh\_mask files or other files:] clipper coordinates.diags file. \item[Output:] This program creates 6 netcdf file with the standard NEMO name for forced simulation:\\ \begin{verbatim} ECMWF_sst_1d_${year}.${config}.nc \end{verbatim} \item[Associated script:] cdfsstconv.ll \item[Remark:] This is in fact a subset of cdfflxconv, limited to SST by ugly goto: :( \end{description} \subsection*{\underline{cdfstrconv:}} \addcontentsline{toc}{subsection}{cdfstrconv} \index{cdfstrconv} \begin{description} \item[Purpose:] Convert a set of STRESS dimgfile (Clipper like) to a set of CDF files (Drakkar like ) \item[Usage:] {\em cdfstrconv YEAR CONFIG } \item[Input:] YEAR is the year on 4 digits, CONFIG, is the CLIPPER config name ({\it eg} ATL3 \item[Required mesh\_mask files or other files:] clipper coordinates.diags file. \item[Output:] This program creates 6 netcdf file with the standard NEMO name for forced simulation:\\ \begin{verbatim} ECMWF_taux_1d_${year}.${config}.nc ECMWF_tauy_1d_${year}.${config}.nc \end{verbatim} \item[Associated script:] cdfstrconv.ll \item[Remark:] This is in fact a subset of cdfflxconv, limited to STRESS by ugly goto: :( \end{description} \newpage \subsection*{\underline{cdfmltmask:}} \addcontentsline{toc}{subsection}{cdfmltmask} \index{cdfmltmask} \begin{description} \item[Purpose:] Mask a given variable of the input file with the appropriate mask read in mask file. \item[Usage:] {\em cdfmltmask Input\_file mask\_file cdf\_var point\_type\_on\_Cgrid} \item[Input:] Input\_file : file to be masked \\ mask\_file : mask file \\ cdf\_var: variable to be masked \\ point\_type\_on\_Cgrid : either T U V or F \item[Required mesh\_mask files or other files:] none, the mask name is given on command line. \item[Output:] output is done on Input\_file\_masked. \item[Associated script:] none \item[Contributor:] M\'elanie Juza. \item[Remark:] This program perform the multiplication of the input field with the mask. It can be easily taken as first base for a more complex operation on files. \end{description} \subsection*{\underline{cdfmsk:}} \addcontentsline{toc}{subsection}{cdfmsk} \index{cdfmsk} \begin{description} \item[Purpose:] Compute the number of sea grid points from a mask file given on input \item[Usage:] {\em cdfmsk maskfile} \item[Input:] ncfile is the name of the mask file to look at. \item[Required mesh\_mask files or other files:] none, except the mask given as input. \item[Output:] output is done on standard output. \item[Associated script:] none \item[Remark:] The interest of this program is limited; it provides a very stable info for a given config ... \end{description} \newpage \subsection*{\underline{cdfmsksal:}} \addcontentsline{toc}{subsection}{cdfmsksal} \index{cdfmsksal} \begin{description} \item[Purpose:] Compute a bimg (chart compliant) mask file for the surface of the model, from the salinity field. \item[Usage:] {\em cdfmsksal gridT\_file} \item[Input:] any file holding a vosaline field \item[Required mesh\_mask files or other files:] none. \item[Output:] Output is done on a bimg file, called tmask.bimg \item[Associated script:] none \item[Remark:] The output is specifically dedicated to the chart plotting program. It is usefull for masking ({\it e.g.} forcing files) on the fly. Purely netcdf/Ferret acros may skip this one ! \end{description} \subsection*{\underline{cdfmkmask:}} \addcontentsline{toc}{subsection}{cdfmkmask} \index{cdfmkmask} \begin{description} \item[Purpose:] Compute a full 3D byte\_mask file (tmask, umask, vmask, fmask) from salinity field in input file. \item[Usage:] {\em cdfmkmask gridT\_file} \item[Input:] any file holding a vosaline field \item[Required mesh\_mask files or other files:] none. \item[Output:] Netcdf file mask\_sal.nc with tmask umask vmask and fmask variables, short integer. \item[Associated script:] none \item[Remark:] Caution on fmask that may differ from the one produced online by the code, because of local particular settings. \end{description} \subsection*{\underline{cdfmkmask-zone:}} \addcontentsline{toc}{subsection}{cdfmkmask-zone} \index{cdfmkmask-zone} \begin{description} \item[Purpose:] Compute a full 3D byte\_mask file (tmask, umask, vmask, fmask) from salinity field in input file, limited to a given zone. \item[Usage:] {\em cdfmkmask gridT\_file lonmin lonmax latmin latmax output\_file} \item[Input:] gridT is any file holding a vosaline field, lonmin, lonmax, latmin, latmax are the window coordinates where the the mask is build. Outside this window, the mask is set to 0 (as on land). \item[Required mesh\_mask files or other files:] none. \item[Output:] Netcdf outputfile whose name is given as arguments, with tmask umask vmask and fmask variables, short integer. \item[Associated script:] none \item[Remark:] Caution on fmask that may differ from the one produced online by the code, because of local particular settings. \end{description} \newpage \subsection*{\underline{cdfvita:}} \addcontentsline{toc}{subsection}{cdfvita} \index{cdfvita} \begin{description} \item[Purpose:] Compute surface velocity components on the A-grid (T-point), from the C-grid opa output. It also computes the module of the velocity on the A-grid. \item[Usage:] {\em cdfvita gridU gridV } \item[Input:] gridU, gridV: files holding the variables vozocrtx and vomecrty on the C-grid \item[Required mesh\_mask files or other files:] none. \item[Output:] Output file is vita.nc, with the variables sovitua, sovitva , sovitmod \item[Associated script:] none \item[Remark:] This program is practically ready to treat the full 3D case, if necessary \end{description} \subsection*{\underline{cdfspeed:}} \addcontentsline{toc}{subsection}{cdfspeed} \index{cdfspeed} \begin{description} \item[Purpose:] Compute the module of a velocity field \item[Usage:] {\em cdfspeed gridU gridV varU varV } \item[Input:] gridU, gridV: files holding the velocity components \\ varU, varV the name of the variables for zonal and meridional components \item[Required mesh\_mask files or other files:] none. \item[Output:] Output file is speed.nc, with the variable U. \item[Associated script:] none \item[Remark:] This program assume that the velocity components are on the A-grid (tracer points). Which is fine for forcing fields, but not correct for model output. cdfvita may be used as a pre-processor to translate model velocities on the A-grid. \end{description} \newpage \subsection*{\underline{cdfimprovechk:}} \addcontentsline{toc}{subsection}{cdfimprovechk} \index{cdfimprovechk} \begin{description} \item[Purpose:] Given a file with gridded 'observed' or 'sea-truth' value ({\it e.g} Levitus files), and a reference model output for the same quantity as the observation, this program tests a $3^{rd}$ file (model output), giving an estimate of the improvement of the test, with respect to the reference. \item[Usage:] {\em cdfimprovechk cdfvariable obs.nc ref.nc test.nc } \item[Input:] cdfvariable = variable name used for checking. Must be in all 3 files. \\ obs.nc : observation file ('sea truth') \\ ref.nc : reference file ('model base run') \\ test.nc : test file (' model sensitivity experiment') \item[Required mesh\_mask files or other files:] none. \item[Output:] chk.nc, same variable (but not same sense!)\\ Better than a long speech, the improvement estimates is given by: \\ $ chk = (reference - test ) / ( reference - observation) \cdot mask $ \\ Where this value is $< 1$ and $ > 0$, the test is better than the reference (with respect to the working variable). Where it is greater than 1 it indicates a degradation of the test. Where the value is $< 0$, it denotes an over-shoot of the correction. Where the value is $< -1$, the overshoot gives a worse solution than the reference. \item[Associated script:] none \item[Example:] In particular, it was written for the tunning of TKE parameter and impact on the summer mixed layer depth. The observations files comes from the de Boyer Montaigu climatology; the reference case was with a standard TKE scheme. Different test cases where with the new improved tke scheme. The results are interesting but not necessarly easy to undestand or interpret. \end{description} \newpage \subsection*{\underline{cdfcsp:}} \addcontentsline{toc}{subsection}{cdfcsp} \index{cdfcsp} \begin{description} \item[Purpose:] Change missing value to 0. \item[Usage:] {\em cdfcsp 'list of files' } \item[Input:] input file are typically files from OPA8.2, with a missing value of 1.e20. It can take multi time-frame files on input. \item[Required mesh\_mask files or other files:] none. \item[Output:] CAUTION: The input file is rewritten with the correction on the missing value. \end{description} \newpage \subsection*{\underline{cdfpolymask:}} \addcontentsline{toc}{subsection}{cdfpolymask} \index{cdfpolymask} \begin{description} \item[Purpose:] Build a mask file (0/1) with polygon shape. Set mask to 1 in the polygon. \item[Usage:] {\em cdfpolymask 'polygon file' 'reference file' } \item[Input:] polygon file : This is an ASCII file describing each polygons that are to be used for masking. For each polygon, there is a corresponding block of lines: \\ -- first line is the name of the polygon (for easy navigation in the file) \\ -- second line gives the number of vertices for the polygon, and a flag set to 1 if the polygon crosses the date line (+/- 180 deg) (0 either). \\ -- next as many lines as vertices with x, y position of each vertex. \\ reference file: a reference netcdf file for headers. \item[Required mesh\_mask files or other files:] none. \item[Output:] results is on polymask.nc file, in the polymask variable (2D variable). \item[Remark:] This cdftools uses a new module called modpoly.f90 which is described in the programmer manual. \end{description} \subsection*{\underline{cdfsmooth:}} \addcontentsline{toc}{subsection}{cdfsmooth} \index{cdfsmooth} \begin{description} \item[Purpose:] Perform a spatial filtering on input file. Various filters are availble (list to be completed), Lanczos, Hanning, shapiro etc ... \item[Usage:] {\em cdfsmooth 'filename' 'n' [filter type] } \item[Input:] filename hold the input data. \\ n is the number of grid step to filter. \\ filter type can be either Lanczos (L,l) or Hanning (H, h) or Shapiro (S,s) or Box (B,b) \item[Required mesh\_mask files or other files:] none. \item[Output:] Output is done on 'filename'.smooth'n' where smooth is one of L H s B etc ... \end{description} \subsection*{\underline{cdfstatcoord:}} \addcontentsline{toc}{subsection}{cdfstatcoord} \index{cdfstatcoord} \begin{description} \item[Purpose:] Compute statistics about the grid metric versus latitude \item[Usage:] {\em cdfstatcoord coordinate-file mask [mask variable name] } \item[Input:] coordinate-file is where horizontal metrics can be found (e1t, e2t) \\ mask is the mask file; the statistics will be computed only for non masked points. \\ mask variable is by default tmask. It can be changed with this option. \item[Required mesh\_mask files or other files:] given as input. \item[Output:] Standard output as a zonal mean of e1t e2t, binned by 2 degrees latitude bands. \end{description} \newpage \tableofcontents \printindex \end{document} cdftools-3.0/DOC/template.tex0000644000175000017500000000044512241227304017265 0ustar amckinstryamckinstry\newpage \subsection*{\underline{XXX:}} \addcontentsline{toc}{subsection}{XXX} \index{XXX} \begin{description} \item[Purpose:] \item[Usage:] {\em } \item[Input:] \item[Required mesh\_mask files or other files:] \item[Output:] \item[Remark/bugs :] \item[Associated scripts:] \end{description} cdftools-3.0/DOC/chkguide.ksh0000755000175000017500000000224712241227304017227 0ustar amckinstryamckinstry#!/bin/ksh # $Rev$ # $Date$ CDFTOOLS=../ grep subsection cdftools_prog.tex | grep -v addcontent | grep underline | sed -e 's@\\subsection\*{\\underline{@@' -e 's/}}//' \ -e 's/\\//g' | sed -e 's/^ //' | sed -e 's/^.*F/F/' | sed -e 's/^.*S/S/' | sort > list_man here=$(pwd) cd $CDFTOOLS grep FUNCTION cdfio.f90 | grep -v END | grep -v -e '!' | sed -e 's/^.*F/F/' | sort > tttmp grep FUNCTION eos.f90 | grep -v END | grep -v -e '!' | sed -e 's/^.*F/F/' | sort >> tttmp grep SUBROUTINE cdfio.f90 | grep -v END | grep -v -e '!' | sed -e 's/^.*S/S/' | sort >> tttmp grep SUBROUTINE eos.f90 | grep -v END | grep -v -e '!' | sed -e 's/^.*S/S/' | sort >> tttmp cat tttmp | sort > $here/list_prog ; \rm tttmp cd $here cat list_prog n=01 for f in $( cat list_prog | awk '{ print $0 }' ); do echo $f # g=$( echo $f | awk '{print $2}' ) #echo $g # grep -q $g list_man # if [ $? == 1 ] ; then # printf "\n %02d %s \t %s \n " $n $f 'missing in manual' # n=$(( n + 1 )) # fi done printf "\n" exit for f in $( cat list_man ); do grep -q $f list_prog if [ $? == 1 ] ; then printf "%s \t %s \n \n" $f 'missing in CDFTOOLS ??' fi done \rm -f list_prog list_man cdftools-3.0/DOC/cdftools_prog.tex0000644000175000017500000010564212241227304020323 0ustar amckinstryamckinstry\documentclass[a4paper,11pt]{article} \usepackage[latin1]{inputenc} \usepackage{makeidx} \makeindex % to use index, after a first compilation, run makeindex *.idx file % then command \printindex will incorporate the index in the latex file. %Check if we are compiling under latex or pdflatex \ifx\pdftexversion\undefined \usepackage[dvips]{graphicx} \else \usepackage[pdftex]{graphicx} \fi \setlength{\textwidth}{16.5 cm} \setlength{\textheight}{23.5 cm} \topmargin 0 pt \oddsidemargin 0 pt \evensidemargin 0 pt % \begin{document} \newcommand{\etal}{{\it et al.}} \newcommand{\DegN}{$^{\circ}$N} \newcommand{\DegW}{$^{\circ}$W} \newcommand{\DegE}{$^{\circ}$E} \newcommand{\DegS}{$^{\circ}$S} \newcommand{\Deg}{$^{\circ}$} \newcommand{\DegC}{$^{\circ}$C} \newcommand{\DS}{ \renewcommand{\baselinestretch}{1.8} \tiny \normalsize} \newcommand{\ST}{ \renewcommand{\baselinestretch}{1.2} \tiny \normalsize} \newcommand{\ao}{add\_offset} \newcommand{\SF}{scale\_factor} \title{CDFTOOLS: a fortran 90 package of programs and libraries for diagnostic of the DRAKKAR OPA9 output.\\ Part II : Programmer guide} \author{J.M. Molines \thanks{Laboratoire des Ecoulements G\'eophysiques et Industriels, CNRS UMR 5519, Grenoble, France}\ } \date{Last update: $ $Rev$ $ $ $Date$ $ } \maketitle \section*{Introduction} This document is a technical description of the different functions and subroutines which belong to cdfio.f90 and eos.f90 fortran 90 modules. They are used basically in the core of the cdftools program either to perform the Netcdf I/O or to compute the equation of state for sea water. \section{ cdfio module} \subsection*{\underline{ TYPE variable}} \addcontentsline{toc}{subsection}{TYPE variable} \index{TYPE variable} \begin{description} \item[Structure:] We defined a derived type for managing the variables attribute. It is defined as follow: \begin{small} \begin{verbatim} TYPE, PUBLIC :: variable character(LEN=80):: name character(LEN=80):: units real(kind=4) :: missing_value real(kind=4) :: valid_min real(kind=4) :: valid_max real(kind=4) :: scale_factor=1. real(kind=4) :: add_offset=0. real(kind=4) :: savelog10=0. character(LEN=80):: long_name character(LEN=80):: short_name character(LEN=80):: online_operation character(LEN=80):: axis character(LEN=80):: precision='r4' ! possible values are i2, r4, r8 END TYPE variable \end{verbatim} \end{small} \item[Purpose:] This is used in the cdftools to avoid the former 'att.txt' file which held the variable attributes. Now, each program needing variables output in a netcdf file, must use a structure (or an array of structure) defining the name and attributes of the variable. This structure or array of structure is passed as argument to the following functions: {\tt createvar, putatt, getvarname} \item[Example:] Self explaining example from cdfpvor.f90: \begin{small} \begin{verbatim} .... TYPE(variable), DIMENSION(3) :: typvar !: structure for attribute .... ! define variable name and attribute typvar(1)%name= 'vorelvor' ; typvar(2)%name= 'vostrvor'; typvar(3)%name= 'vototvor' typvar%units='kg.m-4.s-1' ; typvar%missing_value=0. typvar%valid_min= -1000. ; typvar%valid_max= 1000. typvar(1)%long_name='Relative_component_of_Ertel_PV' typvar(2)%long_name='Stretching_component_of_Ertel_PV' typvar(3)%long_name='Ertel_potential_vorticity' typvar(1)%short_name='vorelvor'; typvar(2)%short_name='vostrvor' typvar(3)%short_name='vototvor' typvar%online_operation='N/A'; typvar%axis='TZYX' ncout =create(cfileout, cfilet, npiglo,npjglo,npk) ierr= createvar (ncout ,typvar,3, ipk,id_varout ) ierr= putheadervar(ncout, cfilet,npiglo,npjglo,npk) .... \end{verbatim} \end{small} \end{description} \newpage \subsection*{\underline{ INTERFACE putvar}} \addcontentsline{toc}{subsection}{INTERFACE putvar} \index{INTERFACE putvar} \begin{description} \item[Generic interface] \begin{small} \begin{verbatim} INTERFACE putvar MODULE PROCEDURE putvarr4, putvari2, putvarzo END INTERFACE \end{verbatim} \end{small} \item[Purpose:] This generic interface re-direct putvar call to either putvarr4 for real*4 input array, putvari2 for integer*2 input array, or to putvarzo for degenerated 3D-2D arrays corresponding to zonal integration. It also redirect putvar to the reputvarr4 function, which allows to rewrite a variable in an already existing file. \item[Example:] ierr = putvar(ncout, id\_varout(jvar) ,i2d, jk, npiglo, npjglo) \\ ... \\ ierr = putvar(ncout, id\_varout(jvar) ,sal, jk, npiglo, npjglo) \\ Example for reputvarr4 \\ istatus=putvar(cfile,'Bathymetry',jk,npiglo,npjglo, kimin=imin, kjmin=jmin, ptab) \end{description} \subsection*{\underline{ FUNCTION closeout(kout )}} \addcontentsline{toc}{subsection}{closeout} \index{closeout} \begin{description} \item[Arguments:] INTEGER, INTENT(in) :: kout. Netcdf ID of the file to be closed. \item[Purpose:] Close an open netcdf file, specified by its ID \item[Example:] istatus = closeout(ncout) \end{description} \subsection*{\underline{ FUNCTION ncopen(cdfile) }} \addcontentsline{toc}{subsection}{ncopen} \index{ncopen} \begin{description} \item[Arguments:] CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name \\ INTEGER :: ncopen ! return status \item[Purpose:] open file cdfile and return file ID \item[Example:] ncid=ncopen('ORCA025-G70\_y1956m05d16\_gridU.nc') \item[Remark:] This function is usefull for editing an existing file. The return ncid can be used as the first argument of put var, for instance. \end{description} \subsection*{\underline{ FUNCTION copyatt(cdvar, kidvar, kcin, kcout )}} \addcontentsline{toc}{subsection}{copyatt} \index{copyatt} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdvar !: Name of the variable \\ INTEGER,INTENT(in) :: kidvar !: var id of variable cdvar \\ INTEGER,INTENT(in) :: kcin !: ncid of the file where to read the attributes \\ INTEGER,INTENT(in) :: kcout !: ncid of the output file. INTEGER :: copyout !: function return value: return an error status. \item[Purpose:] Copy all the attributes for one variable, taking the example from another file, specified by its ncid. Return the status of the function. If $\neq$ 0, indicates an error. \item[Example:] \ \\ \begin{verbatim} istatus = NF90\_DEF\_VAR(icout,'nav\_lon',NF90\_FLOAT,nvdim(1:2),id\_lon) istatus = copyatt('nav\_lon',id\_lon,ncid,icout) \end{verbatim} \item[Remark:] This function is used internally to cdfio, in the function create. \end{description} \newpage \subsection*{\underline{ FUNCTION create(cdfile, cdfilref ,kx,ky,kz, cdep) }} \addcontentsline{toc}{subsection}{create} \index{create} \begin{description} \item[Arguments:]\ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile !: name of file to create \\ CHARACTER(LEN=*), INTENT(in) :: cdfilef !: name of file used as reference for attributes \\ INTEGER,INTENT(in) :: kx, ky, kz !: value of the dimensions x, y and z (depth) \\ CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep !: name of depth variable if differs from cdfile\\ INTEGER :: create !: function return value : the ncid of created variable. \item[Purpose:] Create a netcdf file (IOIPSL type) and copy attributes for nav\_lon, nav\_lat, depth and time\_counter from the reference file given in argument. It is supposed that the reference file is also IOIPSL compliant. For historical reason, there many different names for the depth dimension and variable. If we want to create the new data set with a depth name that differs from the reference file, the cdep optional argument can be used. The return value of the fuction is the ncid of the file just created. \item[Example:] \ \\ \begin{verbatim} ! create output fileset cfileout='cdfmoy.nc' cfileout2='cdfmoy2.nc' ! create output file taking the sizes in cfile ncout =create(cfileout, cfile,npiglo,npjglo,npk) ncout2=create(cfileout2,cfile,npiglo,npjglo,npk) \end{verbatim} or \begin{verbatim} ! create output fileset cfileout='w.nc' ! create output file taking the sizes in cfile ncout =create(cfileout, cdfile,npiglo,npjglo,npk,'depthw') \end{verbatim} \end{description} \newpage \subsection*{\underline{ FUNCTION createvar (kout,ptyvar,kvar,kpk, kidvo) }} \addcontentsline{toc}{subsection}{createvar} \index{createvar} \begin{description} \item[Arguments:] \ \\ \begin{small} \begin{verbatim} ! * Arguments INTEGER, INTENT(in) :: kout, kvar INTEGER, DIMENSION(kvar), INTENT(in) :: kpk INTEGER, DIMENSION(kvar), INTENT(out) :: kidvo INTEGER :: createvar TYPE (variable), DIMENSION(kvar) ,INTENT(in) :: ptyvar \end{verbatim} \end{small} \item[Purpose:] Creates the kvar variables defined by the ptyvar and kpk arrays. Save the varid's in kidvo. \item[Example:] \ \\ \begin{verbatim} ncout =create(cfileout, cfile,npiglo,npjglo,npk) ncout2=create(cfileout2,cfile,npiglo,npjglo,npk) ierr= createvar(ncout ,typvar, nvars, ipk, id_varout ) ierr= createvar(ncout2, typvar2, nvars, ipk, id_varout2) \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION getatt(cdfile,cdvar,cdatt) }} \addcontentsline{toc}{subsection}{getatt} \index{getatt} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdatt, \& ! attribute name to look for\\ \& cdfile, \& ! file to look at\\ \& cdvar\\ REAL(KIND=4) :: getatt \item[Purpose:] Return a REAL value with the values of the attribute cdatt for all the variable cdvar in cdfile \item[Example:] \ \\ \begin{verbatim} ! get missing_value attribute spval = getatt( cfile,'votemper','missing_value') \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION getvaratt(cdfile,cdvar,cdunits, pmissing\_value, cdlong\_name, cdshort\_name) }} \addcontentsline{toc}{subsection}{getvaratt} \index{getvaratt} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=80), INTENT(in) :: cdfile, cdvar \\ CHARACTER(LEN=80), INTENT(out) :: cdunits, cdlong\_name, cdshort\_name \\ REAL(KIND=4), INTENT(out) :: pmissing\_value \item[Purpose:] Read standard units, longname. missing\_value and short name atribute for a given variable of a cdf file. \item[Example:] \ \\ \begin{verbatim} ! get variable standard attribute ierr = getvaratt( cfile,'votemper',cunit, spval, clongname, cshortname) \end{verbatim} \end{description} \subsection*{\underline{FUNCTION getspval (cdfile,cdvar) }} \addcontentsline{toc}{subsection}{getspval} \index{getspval} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile , \& ! File name to look at \& cdvar ! variable name REAL(KIND=4) :: getspval ! the missing value for cdvar \item[Purpose:] Return the SPVAL value of the variable cdvar in cdfile \item[Example:] \ \\ \begin{verbatim} ! get variable standard attribute spval = getspval( cfile,'votemper') \end{verbatim} \end{description} \subsection*{\underline{FUNCTION cvaratt(cdfile,cdvar,cdunits, pmissing\_value, cdlong\_name, cdshort\_name) }} \addcontentsline{toc}{subsection}{cvaratt} \index{cvaratt} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=80), INTENT(in) :: cdfile, cdvar \\ CHARACTER(LEN=80), INTENT(in) :: cdunits, cdlong\_name, cdshort\_name \\ INTEGER :: cvaratt \\ REAL(KIND=4) :: pmissing\_value \item[Purpose:] Change standard units, longname. missing\_value and short name atribute for a given variable of a cdf file. \item[Example:] \ \\ \begin{verbatim} ! get variable standard attribute ierr = cvaratt( cfile,'votemper',cunit, spval, clongname, cshortname) \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION getdim (cdfile,cdim\_name,cdtrue,kstatus) }} \addcontentsline{toc}{subsection}{getdim} \index{getdim} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile , \& ! File name to look at \\ \& cdim\_name ! dimension name to look at \\ CHARACTER(LEN=80),OPTIONAL, INTENT(out) :: cdtrue ! full name of the read dimension \\ INTEGER, OPTIONAL, INTENT(out) :: kstatus ! status of the nf inquire \\ INTEGER :: getdim ! the value for dim cdim\_name, in file cdfile \item[Purpose:] Return the INTEGER value of the dimension identified with cdim\_name in cdfile \item[Example:]\ \\ \begin{verbatim} npiglo= getdim (cfile,'x') npjglo= getdim (cfile,'y') npk = getdim (cfile,'depth',kstatus=istatus) .... idum=getdim(cdfilref,'depth',cldep) ! return in cldep the name of the dim ! whose 'depth' is used as proxy \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION getvdim (cdfile,cdvar) }} \addcontentsline{toc}{subsection}{getvdim} \index{getvdim} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile ! File name to look at \\ CHARACTER(LEN=*), INTENT(inout) :: cdvar ! variable name to look at. \\ INTEGER :: getvdim ! number of dim for cdvar \\ \item[Purpose:] Return the number of dimension for variable cdvar in cdfile. If $cdvar$ is not found in $cdfile$, then a list a available variables is displayed and the user is asked to choose the required one. In this case, $cdvar$ is updated to the choosen variable name, and is made available to the calling program. This function is intended to be used with prognostic variables of the model, which are defined in the file either as [TZXY] (3D variable) or as [TXY] (2D variable). The time dimension is not considered. Erroneous results are produced if the variables is [ZXY] or [XY]. \item[Example:]\ \begin{verbatim} ... cvar='variablex' nvdim = getvdim(cfilev,cvar) IF (nvdim == 2 ) nvpk = 1 ! 2D variable ==> 1 level IF (nvdim == 3 ) nvpk = npk ! 3D variable ==> npk levels PRINT *, TRIM(cvar),' has ', nvdim,' dimensions ... \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION getipk (cdfile,knvars,cdep) }} \addcontentsline{toc}{subsection}{getipk} \index{getipk} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile ! File to look at\\ INTEGER, INTENT(in) :: knvars ! Number of variables in cdfile\\ CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep ! optional depth dim name\\ INTEGER, DIMENSION(knvars) :: getipk ! array (variables ) of levels \item[Purpose:]return the number of levels for all the variables in cdfile. Return 0 if the variable in a vector. \\ returns npk when 4D variables ( x,y,z,t ) \\ returns 1 when 3D variables ( x,y, t ) \\ returns 0 when other ( vectors ) \\ If cdep argument is present, use it as the depth dimension name (instead of default 'dep') \item[Example:]\ \\ \begin{verbatim} ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk (cfile,nvars) ... ipk(:) = getipk (cisofile, nvars, cdep=sigmalevel) \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION getnvar (cdfile) }} \addcontentsline{toc}{subsection}{getnvar} \index{getnvar} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile ! file to look at \\ INTEGER :: getnvar ! return the number of variables \\ \item[Purpose:] Return the number of variables in cdfile \item[Example:]\ \\ \begin{verbatim} nvars = getnvar(cfile) PRINT *,' nvars =', nvars \end{verbatim} \end{description} \subsection*{\underline{ FUNCTION getvarid( cdfile, knvars ) }} \addcontentsline{toc}{subsection}{getvarid} \index{getvarid} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile \\ INTEGER, INTENT(in) :: knvars ! Number of variables in cdfile\\ INTEGER, DIMENSION(knvars) :: getvarid \item[Purpose:] return a real array with the nvar variable id \item[Example:]\ \\ \begin{verbatim} ... nvars = getnvar(cfile) varid(1:nvars)=getvarid(cfile,nvars) ... \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION getvar (cdfile,cdvar,klev,kpi,kpj,kimin,kjmin,ktime) }} \addcontentsline{toc}{subsection}{getvar} \index{getvar} \begin{description} \item[Arguments:]\ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile, \& ! file name to work with \\ \& cdvar ! variable name to work with \\ INTEGER, INTENT(in) :: kpi,kpj ! horizontal size of the 2D variable \\ INTEGER, OPTIONAL, INTENT(in) :: klev ! Optional variable. If missing 1 is assumed \\ INTEGER, OPTIONAL, INTENT(in) :: kimin,kjmin ! Optional : set initial point to get \\ INTEGER, OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed \\ REAL(KIND=4), DIMENSION(kpi,kpj) :: getvar ! 2D REAL 4 holding variable field at klev \item[Purpose:] Return the 2D REAL variable cdvar, from cdfile at level klev. \\ kpi,kpj are the horizontal size of the 2D variable \item[Example:]\ \\ \begin{verbatim} v2d(:,:)= getvar(cfile, cvarname(jvar), jk ,npiglo, npjglo ) ... jt=25 v2d(:,:)= getvar(cfile, cvarname(jvar), jk ,npiglo, npjglo ,ktime=jt) \end{verbatim} \item[Remark:] The optional keyword ktime is {\bf NOT YET} to be used. ( working on it). \end{description} \newpage \subsection*{\underline{FUNCTION getvarxz (cdfile,cdvar,kj,kpi,kpz,kimin,kkmin,ktime) }} \addcontentsline{toc}{subsection}{getvarxz} \index{getvarxz} \begin{description} \item[Arguments:]\ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile, \& ! file name to work with \\ \& cdvar ! variable name to work with \\ INTEGER, INTENT(in) :: kpi,kpz ! size of the 2D variable \\ INTEGER, INTENT(in) :: kj ! Optional variable. If missing 1 is assumed \\ INTEGER, OPTIONAL, INTENT(in) :: kimin,kkmin ! Optional set initial point to get \\ INTEGER, OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed \\ REAL(KIND=4), DIMENSION(kpi,kpz) :: getvarxz ! 2D REAL 4 holding variable x-z slab at kj \\ \item[Purpose:] Return the 2D REAL variable x-z slab cvar, from cdfile at j=kj \\ kpi,kpz are the size of the 2D variable. The time frame can be specified using the optional argument ktime. \item[Example:]\ \\ \begin{verbatim} v2d(:,:)= getvarxz(cfile, cvarname(jvar), jj ,npiglo,npk, imin, kmin ) ... v2d(:,:)= getvarxz(cfile, cvarname(jvar), jj ,npiglo,npk, imin, kmin, ktime=jt) \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION getvaryz (cdfile,cdvar,ki,kpj,kpz,kjmin,kkmin,ktime) }} \addcontentsline{toc}{subsection}{getvaryz} \index{getvaryz} \begin{description} \item[Arguments:]\ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile, \& ! file name to work with \\ \& cdvar ! variable name to work with \\ INTEGER, INTENT(in) :: kpj,kpz ! size of the 2D variable \\ INTEGER, INTENT(in) :: ki ! Optional variable. If missing 1 is assumed \\ INTEGER, OPTIONAL, INTENT(in) :: kjmin,kkmin ! Optional set initial point to get \\ INTEGER, OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed REAL(KIND=4), DIMENSION(kpj,kpz) :: getvaryz ! 2D REAL 4 holding variable x-z slab at kj \\ \item[Purpose:] Return the 2D REAL variable y-z slab cvar, from cdfile at i=ki \\ kpj,kpz are the size of the 2D variable. The time frame can be specified using the optional argument ktime. \item[Example:]\ \\ \begin{verbatim} v2d(:,:)= getvaryz(cfile, cvarname(jvar), ji ,npjglo,npk,jmin,kmin ) ... v2d(:,:)= getvaryz(cfile, cvarname(jvar), ji ,npjglo,npk,jmin,kmin, ktime=jt ) \end{verbatim} \end{description} \newpage \subsection*{\underline{SUBROUTINE gettimeseries (cdfile, cdvar, kilook, kjlook,klev) }} \addcontentsline{toc}{subsection}{gettimeseries} \index{gettimeseries} \begin{description} \item[Arguments:]\ \\ IMPLICIT NONE \\ CHARACTER(LEN=*),INTENT(in) :: cdfile, cdvar \\ INTEGER,INTENT(in) :: kilook,kjlook \\ INTEGER, OPTIONAL, INTENT(in) :: klev \item[Purpose:] Display a 2 column output ( time, variable) for a given variable of a given file at a given point. \item[Example:]\ \\ \begin{verbatim} CALL gettimeseries(cfile,cvar,ilook,jlook,klev=ilevel) ... CALL gettimeseries(cfile,cvar,ilook,jlook) \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION getvar1d (cdfile,cdvar,kk,kstatus) }} \addcontentsline{toc}{subsection}{getvar1d} \index{getvar1d} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile, \& ! file name to work with \\ \& cdvar ! variable name to work with \\ INTEGER, INTENT(in) :: kk ! size of 1D vector to be returned \\ INTEGER, OPTIONAL, INTENT(out) :: kstatus ! return status concerning the variable existence \\ REAL(KIND=4), DIMENSION(kk) :: getvar1d ! real returned vector \\ \item[Purpose:] Return 1D variable cdvar from cdfile, of size kk \item[Example:]\ \\ \begin{verbatim} tim=getvar1d(cfile,'time_counter',1) .... z1d=getvar1d(cdfile,'deptht',kpk,idept) IF ( idept /= NF90_NOERR ) THEN z1d=getvar1d(cdfile,'depthu',kpk,idepu) IF ( idepu /= NF90_NOERR ) THEN z1d=getvar1d(cdfile,'depthv',kpk,idepv) IF ( idepv /= NF90_NOERR ) THEN z1d=getvar1d(cdfile,'depthw',kpk,idepv) IF ( idepw /= NF90_NOERR ) THEN PRINT *,' No depth variable found in ', TRIM(cdfile) STOP ENDIF ENDIF ENDIF ENDIF \end{verbatim} This last example shows how to use the optional argument kstatus in order to figure out which is the real name of the depth variable. \end{description} \newpage \subsection*{\underline{FUNCTION getvare3 (cdfile,cdvar,kk) }} \addcontentsline{toc}{subsection}{getvare3} \index{getvare3} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile, \& ! file name to work with \\ \& cdvar ! variable name to work with \\ INTEGER, INTENT(in) :: kk ! size of 1D vector to be returned \\ REAL(KIND=4), DIMENSION(kk) :: getvare3 ! return e3 variable form the coordinate file \item[Purpose:] Special routine for e3, which in fact is a 1D variable but defined as e3 (1,1,npk,1) in coordinates.nc (!!) \item[Example:]\ \\ \begin{verbatim} gdepw(:) = getvare3(coordzgr, 'gdepw',npk) e3t(:) = getvare3(coordzgr, 'e3t', npk ) \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION getvarname (cdfile, knvars,ptypvar) }} \addcontentsline{toc}{subsection}{getvarname} \index{getvarname} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile ! name of file to work with \\ INTEGER, INTENT(in) :: knvars ! Number of variables in cdfile \\ TYPE (variable), DIMENSION (knvars) :: ptypvar ! Retrieve variables attributes CHARACTER(LEN=80), DIMENSION(knvars) :: getvarname ! return an array with the names of the variables \item[Purpose:] Return a character array with the knvars variable names, and the ptypvar structure array filled with the attribute read in cdfile \item[Example:]\ \\ \begin{verbatim} cvarname(:)=getvarname(cfile,nvars,typvar) ! typvar is output from getvarname \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION putatt (tyvar,kout,kid) }} \addcontentsline{toc}{subsection}{putatt} \index{putatt} \begin{description} \item[Arguments:] \ \\ TYPE (variable) ,INTENT(in) :: tyvar INTEGER, INTENT(in) :: kout ! ncid of the output file \\ INTEGER, INTENT(in) :: kid ! variable id \\ INTEGER :: putatt ! return variable : error code. \item[Purpose:] Uses the structure tyvar for setting the variable attributes for kid and write them in file id kout. \item[Example:]\ \\ \begin{verbatim} ! add attributes istatus = putatt(ptyvar(jv), kout,kidvo(jv)) \end{verbatim} \item[Remark:] This is almost an internal routine called by createvar. \end{description} \newpage \subsection*{\underline{FUNCTION putheadervar(kout, cdfile, kpi,kpj,kpk,pnavlon, pnavlat,pdep,cdep ) }} \addcontentsline{toc}{subsection}{putheadervar} \index{putheadervar} \begin{description} \item[Arguments:] \ \\ INTEGER, INTENT(in) :: kout ! ncid of the outputfile (already open ) \\ CHARACTER(LEN=*), INTENT(in) :: cdfile ! file from where the headers will be copied \\ INTEGER, INTENT(in) :: kpi,kpj,kpk ! dimension of nav\_lon,nav\_lat (kpi,kpj), and depht(kpk) \\ REAL(KIND=4), OPTIONAL, DIMENSION(kpi,kpj) :: pnavlon, pnavlat ! to get rid of nav\_lon , nav\_lat of cdfile \\ REAL(KIND=4), OPTIONAL,DIMENSION(kpk), INTENT(in) :: pdep ! dep array if not on cdfile \\ CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep ! optional name of vertical variable \\ INTEGER :: putheadervar ! return status \item[Purpose:] Copy header variables from cdfile to the already open ncfile (ncid=kout)\\ If the 2 first optional arguments are given, they are taken for nav\_lon and nav\_lat, instead of those read in file cdfile. This is usefull for f-points results whne no basic ''gridF'' files exist. If the third optional argument is given, it is taken as the depht(:) array in place of the the depth read in cdfile. If all 3 optional arguments are used, cdfile will not be used and a dummy argument can be passed to the function instead. If optional argument cdep is used, it is then used as the name for the variable associated with the vertical dimension. \item[Example:]\ \\ \begin{verbatim} ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk) ierr= putheadervar(ncout2, cfile, npiglo, npjglo, npk) \end{verbatim} or \begin{verbatim} ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk, glamf, gphif ) \end{verbatim} or \begin{verbatim} ierr= putheadervar(ncout , 'dummy', npiglo, npjglo, npk, glamt, gphit, gdepw ) \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION putvar(kout, kid,ptab, klev, kpi, kpj) }} \addcontentsline{toc}{subsection}{putvar} \index{putvar} \begin{description} \item[Arguments:] \ \\ INTEGER, INTENT(in) :: kout , \& ! ncid of output file \\ \& kid ! varid of output variable \\ REAL(KIND=4), DIMENSION(kpi,kpj),INTENT(in) :: ptab ! 2D array to write in file \\ INTEGER, INTENT(in) :: klev ! level at which ptab will be written \\ INTEGER, INTENT(in) :: kpi,kpj ! dimension of ptab \\ INTEGER :: putvar ! return status \item[Purpose:] copy a 2D level of ptab in already open file kout, using variable kid \item[Example:]\ \\ \begin{verbatim} ierr = putvar(ncout, id_varout(jvar) ,rmean, jk, npiglo, npjglo) \end{verbatim} \item[Remark:] Putvar is a generic interface, as explained above. For the interface with reputvar, the syntax is shown below. \end{description} \subsection*{\underline{FUNCTION reputvarr4 (cdfile,cdvar,klev,kpi,kpj,kimin,kjmin, ktime,ptab) }} \addcontentsline{toc}{subsection}{reputvarr4} \index{reputvarr4} \begin{description} \item[Arguments:] \ \\ CHARACTER(LEN=*), INTENT(in) :: cdfile, \& ! file name to work with \\ \& cdvar ! variable name to work with \\ INTEGER, INTENT(in) :: kpi,kpj ! horizontal size of the 2D variable \\ INTEGER, OPTIONAL, INTENT(in) :: klev ! Optional variable. If missing 1 is assumed \\ INTEGER, OPTIONAL, INTENT(in) :: kimin,kjmin ! Optional variable. If missing 1 is assumed \\ INTEGER, OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed \\ REAL(KIND=4), DIMENSION(kpi,kpj) :: ptab ! 2D REAL 4 holding variable field at klev \item[Purpose:] Change an existing variable in inputfile \item[Example:]\ \\ \begin{verbatim} ierr = putvar(cfile, 'votemper', 4, npiglo,npjglo, kimin=10, kjmin=200, temperature) \end{verbatim} \item[Remark:] With this function, the input file is modified ! \end{description} \newpage \subsection*{\underline{FUNCTION putvar1d(kout,ptab,kk,cdtype) }} \addcontentsline{toc}{subsection}{putvar1d} \index{putvar1d} \begin{description} \item[Arguments:] \ \\ INTEGER, INTENT(in) :: kout ! ncid of output file \\ REAL(KIND=4), DIMENSION(kk),INTENT(in) :: ptab ! 1D array to write in file \\ INTEGER, INTENT(in) :: kk ! number of elements in ptab \\ CHARACTER(LEN=1), INTENT(in) :: cdtype ! either T or D (for time or depth) \\ INTEGER :: putvar1d ! return status \item[Purpose:] Copy 1D variable (size kk) hold in ptab, with id kid, into file id kout \item[Example:]\ \\ \begin{verbatim} ierr=putvar1d(ncout,timean,1,'T') ierr=putvar1d(ncout2,timean,1,'T') ... istatus = putvar1d(kout,depw(:),kpk,'D') \end{verbatim} \end{description} \newpage \subsection*{\underline{SUBROUTINE ERR\_HDL(kstatus) }} \addcontentsline{toc}{subsection}{ERR\_HDL} \index{ERR\_HDL} \begin{description} \item[Arguments:] \ \\ INTEGER, INTENT(in) :: kstatus \item[Purpose:] Error handler for NetCDF routine. Stop if kstatus indicates error conditions. Else indicate the error message. \item[Example:]\ \\ \begin{verbatim} CALL ERR_HDL(istatus) \end{verbatim} \end{description} \newpage \section{ eos module} % FUNCTION eos % FUNCTION eosbn2 \subsection*{\underline{FUNCTION sigma0 ( ptem, psal, kpi,kpj) }} \addcontentsline{toc}{subsection}{sigma0} \index{sigma0} \begin{description} \item[Arguments:] \ \\ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal ! Temperature and Salinity arrays \\ INTEGER,INTENT(in) :: kpi,kpj !: dimension of 2D arrays \\ REAL(KIND=8), DIMENSION(kpi,kpj) :: sigma0 ! Potential density \item[Purpose:] Compute the potential volumic mass (Kg/m3) from potential temperature and salinity fields \item[Example:]\ \\ \begin{verbatim} \end{verbatim} \end{description} \subsection*{\underline{FUNCTION sigmai( ptem, psal, pref, kpi,kpj) }} \addcontentsline{toc}{subsection}{sigmai} \index{sigmai} \begin{description} \item[Arguments:] \ \\ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal ! Temperature and Salinity arrays \\ REAL(KIND=4), INTENT(in) :: pref !: reference pressure (dbar) \\ INTEGER,INTENT(in) :: kpi,kpj !: dimension of 2D arrays \\ REAL(KIND=8), DIMENSION(kpi,kpj) :: sigmai ! Potential density a level pref \item[Purpose:] Compute the potential volumic mass (Kg/m3) from potential temperature and salinity fields at reference level specified by $pref$. \item[Example:]\ \\ \begin{verbatim} \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION eosbn2 ( ptem, psal, pdep,pe3w, kpi,kpj,kup,kdown )}} \addcontentsline{toc}{subsection}{eosbn2} \index{eosbn2} \begin{description} \item[Arguments:] \ \\ REAL(KIND=4), DIMENSION(kpi,kpj,2), INTENT(in) :: ptem, psal ! temperature and salinity arrays \\ ! (2 levels, only ) \\ REAL(KIND=4) :: pdep ! depthw (W points) \\ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: pe3w ! vertical scale factor at W points \\ INTEGER, INTENT(in) :: kpi,kpj ! horizontal size of the grid \\ INTEGER, INTENT(in) :: kup,kdown ! index cdfmeannd lower layer \\ ! for the actual level \\ REAL(KIND=4), DIMENSION(kpi,kpj) :: eosbn2 ! result interpolated at T levels \item[Purpose:] Compute the local Brunt-Vaisala frequency \item[Example:]\ \\ \begin{verbatim} DO jk = npk-1, 2, -1 PRINT *,'level ',jk zmask(:,:)=1. ztemp(:,:,iup)= getvar(cfilet, 'votemper', jk-1 ,npiglo, npjglo) WHERE(ztemp(:,:,idown) == 0 ) zmask = 0 zsal(:,:,iup) = getvar(cfilet, 'vosaline', jk-1 ,npiglo,npjglo) gdepw(:,:) = getvar(coordzgr, 'gdepw', jk, 1, 1) e3w(:,:) = getvar(coordzgr, 'e3w_ps', jk,1, 1 ) zwk(:,:,iup) = eosbn2 ( ztemp,zsal,gdepw(1,1),e3w, npiglo,npjglo , & iup,idown)* zmask(:,:) ! now put zn2 at T level (k ) WHERE ( zwk(:,:,idown) == 0 ) zn2(:,:) = zwk(:,:,iup) ELSEWHERE zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * zmask(:,:) END WHERE ierr = putvar(ncout, id_varout(1) ,zn2, jk, npiglo, npjglo ) itmp = idown ; idown = iup ; iup = itmp END DO ! loop to next level \end{verbatim} \end{description} \newpage \subsection*{\underline{FUNCTION albet ( ptem, psal, pdep, kpi,kpj )}} \addcontentsline{toc}{subsection}{albet} \index{albet} \begin{description} \item[Arguments:] \ \\ REAL(KIND=4), DIMENSION(kpi,kpj,2), INTENT(in) :: ptem, psal ! temperature and salinity arrays \\ ! (2 levels, only ) \\ REAL(KIND=4) :: pdep ! depthw (W points) \\ INTEGER, INTENT(in) :: kpi,kpj ! horizontal size of the grid \\ ! for the actual level \\ REAL(KIND=4), DIMENSION(kpi,kpj) :: albet ! result interpolated at T levels \item[Purpose:] Compute the ratio alpha/beta \item[Method:] Use the equation of the OPA code (Mc Dougall, 1987) \item[Remark:] This is a function that may be used together with beta for computing the buoyancy flux, from forcing fields. \end{description} \subsection*{\underline{FUNCTION beta ( ptem, psal, pdep, kpi,kpj )}} \addcontentsline{toc}{subsection}{beta} \index{beta} \begin{description} \item[Arguments:] \ \\ REAL(KIND=4), DIMENSION(kpi,kpj,2), INTENT(in) :: ptem, psal ! temperature and salinity arrays \\ ! (2 levels, only ) \\ REAL(KIND=4) :: pdep ! depthw (W points) \\ INTEGER, INTENT(in) :: kpi,kpj ! horizontal size of the grid \\ ! for the actual level \\ REAL(KIND=4), DIMENSION(kpi,kpj) :: beta ! result interpolated at T levels \item[Purpose:] Compute the beta coefficient \item[Method:] Use the equation of the OPA code (Mc Dougall, 1987) \item[Remark:] This is a function that may be used together with albet for computing the buoyancy flux, from forcing fields. \end{description} \newpage \tableofcontents \printindex \end{document} cdftools-3.0/DOC/Makefile0000644000175000017500000000166512241227304016375 0ustar amckinstryamckinstry# $Rev$ # $Id$ # $Date$ #----------------------------------------------------------- TEX=latex CDFTOOLS=cdftools CDFTOOLSDIR=CDFTOOLS_2.1 all: $(CDFTOOLS)_prog.dvi $(CDFTOOLS)_user.dvi index $(CDFTOOLS).dvi: $(CDFTOOLS).tex index: $(CDFTOOLS)_prog.dvi $(CDFTOOLS)_user.dvi makeindex $(CDFTOOLS)_user.idx makeindex $(CDFTOOLS)_prog.idx #pdf: $(CDFTOOLS)_user.pdf $(CDFTOOLS)_prog.pdf pdf: $(CDFTOOLS)_user.tex $(CDFTOOLS)_prog.tex pdflatex $(CDFTOOLS)_user.tex pdflatex $(CDFTOOLS)_prog.tex # to force recompilation of tex file when index is updated touch: touch *.tex clean: \rm -f *.dvi *.log *.aux *~ *.idx *.ind *.ilg *.toc commit: svn ci web: pdf hevea $(CDFTOOLS)_user.tex scp $(CDFTOOLS)_user.html molines@meolipc:/var/www/web/CDFTOOLS/cdftools-2.1.html scp $(CDFTOOLS)_user.hind molines@meolipc:/var/www/web/CDFTOOLS/cdftools-2.1.hind scp $(CDFTOOLS)_user.pdf molines@meolipc:/var/www/web/CDFTOOLS/cdftools-2.1.pdf cdftools-3.0/DOC/chkuserdone.ksh0000755000175000017500000000132012241227304017745 0ustar amckinstryamckinstry#!/bin/ksh # $Rev$ # $Date$ # suppose that we run this script in $CDFTOOLS/DOC CDFTOOLS=../ grep subsection cdftools_user.tex | grep -v addcontent | grep underline | sed -e 's@\\subsection\*{\\underline{@@' -e 's/:}}//' \ -e 's/\\//g' | sort > list_man here=$(pwd) cd $CDFTOOLS ls -1 *90 | sed -e 's/.f90//' | sort > $here/list_prog cd $here n=01 for f in $( cat list_prog ); do grep -q $f list_man if [ $? == 1 ] ; then printf "\n %02d %s \t %s \n " $n $f 'missing in manual' n=$(( n + 1 )) fi done printf "\n" for f in $( cat list_man ); do grep -q $f list_prog if [ $? == 1 ] ; then printf "%s \t %s \n \n" $f 'missing in CDFTOOLS ??' fi done \rm -f list_prog list_man cdftools-3.0/cdfmltmask.f900000644000175000017500000001564212241227304016775 0ustar amckinstryamckinstryPROGRAM cdfmltmask !!====================================================================== !! *** PROGRAM cdfmltmask *** !!===================================================================== !! ** Purpose : multiplication of file by a mask (0,1) !! !! History : 2.1 : 06/2007 : M. Juza : Original code !! : 2.1 : 06/2007 : P. Mathiot : add forcing capabilities !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvpk ! vertical levels in working variable INTEGER(KIND=4) :: npkmask ! vertical levels in mask file REAL(KIND=4) :: zspval ! missing value attribute REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zv ! cv_in at jk level REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask at jk level REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvmask ! masked cv_in at jk level CHARACTER(LEN=256) :: cunits ! units attribute CHARACTER(LEN=256) :: clname ! long_name attribute CHARACTER(LEN=256) :: csname ! short_name attribute CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cf_msk ! input mask file name CHARACTER(LEN=256) :: cv_in ! cdf variable name CHARACTER(LEN=256) :: cvartype ! variable position on Cgrid CHARACTER(LEN=256) :: cv_dep ! depth dim name CHARACTER(LEN=256) :: ctmp ! dummy string CHARACTER(LEN=20) :: cv_msk ! mask variable name !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmltmask IN-file MSK-file IN-var T| U | V | F | W | P' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Multiply IN-var of IN-file by the mask corresponding to the' PRINT *,' C-grid point position given as last argument.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : input netcdf file.' PRINT *,' MSK-file : input netcdf mask file.' PRINT *,' IN-var : input variable name.' PRINT *,' T| U | V | F | W | P : C-grid position of IN-var' PRINT *,' P indicate a polygon mask created by cdfpoly.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none, all are given as arguments.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' The output file is a copy of the input file with only' PRINT *,' the requested variable masked.' PRINT *,' netcdf file : IN-file_masked' PRINT *,' variables : IN-var (same as input).' STOP ENDIF CALL getarg (1, cf_in ) CALL getarg (2, cf_msk ) CALL getarg (3, cv_in ) CALL getarg (4, cvartype ) IF ( chkfile (cf_in) .OR. chkfile(cf_msk) ) STOP ! missing files ! append _masked to input file name and copy initial file to new file, which will be modified ! using dd more efficient than cp for big files ctmp = TRIM(cf_in)//'_masked' CALL system(' dd bs=10000000 if='//TRIM(cf_in)//' of='//TRIM(ctmp) ) cf_in = ctmp PRINT *,' Working on copy : ', TRIM(cf_in) npiglo = getdim (cf_in,cn_x) npjglo = getdim (cf_in,cn_y) npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in, 'z', cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in, 'sigma', cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in, 'nav_lev', cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF ENDIF npkmask = getdim (cf_msk, cn_z, cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npkmask = getdim (cf_msk, 'z', cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN npkmask = getdim (cf_msk, 'nav_lev', cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npkmask=0 ENDIF ENDIF ENDIF npt = getdim (cf_in, cn_t ) nvpk = getvdim(cf_in, cv_in) IF (nvpk == 2 ) nvpk = 1 IF (nvpk == 3 ) nvpk = npk PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt PRINT *, 'nvpk = ', nvpk IF (npk==0) npk=1 ! Allocate arrays ALLOCATE( zmask(npiglo,npjglo) ) ALLOCATE( zv (npiglo,npjglo) ) ALLOCATE(zvmask(npiglo,npjglo) ) SELECT CASE (TRIM(cvartype)) CASE ( 'T' ) cv_msk='tmask' CASE ( 'U' ) cv_msk='umask' CASE ( 'V' ) cv_msk='vmask' CASE ( 'F' ) cv_msk='fmask' CASE ( 'W' ) cv_msk='tmask' CASE ( 'P' ) ! for polymask cv_msk='polymask' CASE DEFAULT PRINT *, 'this type of variable is not known :', TRIM(cvartype) STOP END SELECT IF ( npkmask <= 1 ) THEN zmask(:,:) = getvar(cf_msk, cv_msk, 1, npiglo, npjglo) ENDIF DO jt = 1, npt IF (MOD(jt,100)==0) PRINT *, jt,'/', npt DO jk = 1,nvpk ! Read cv_in zv(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt) IF ( npkmask > 1 ) THEN ! Read mask zmask(:,:) = getvar(cf_msk, cv_msk, jk, npiglo, npjglo) ENDIF ! Multiplication of cv_in by mask at level jk zvmask = zv * zmask ! Writing on the copy of original file ierr = putvar(cf_in, cv_in, jk, npiglo, npjglo, 1, 1, ktime=jt, ptab=zvmask) END DO END DO ! set missing value attribute for cv_in as 0. ierr = getvaratt (cf_in, cv_in, cunits, zspval, clname, csname) ierr = cvaratt (cf_in, cv_in, cunits, 0., clname, csname) END PROGRAM cdfmltmask cdftools-3.0/cdfw.f900000644000175000017500000002216312241227304015567 0ustar amckinstryamckinstryPROGRAM cdfw !!====================================================================== !! *** PROGRAM cdfw *** !!===================================================================== !! ** Purpose : Compute the 3D w for given gridU gridV files !! and variables !! !! ** Method : Use the equation on continuity: Integrate the !! horizontal divergence from bottom to the top. !! ( Use the same routines than in the NEMO code ) !! !! History : 2.1 : 06/2005 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: itop = 1 ! top array index INTEGER(KIND=4) :: ibot = 2 ! bottom array index INTEGER(KIND=4) :: itmp ! working integer for level swap INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vars REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: wn ! vertical velocity on the top ! ! and bottom of a cell. ! ! wn(top) is computed REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t ! horizontal T metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e2u ! horizontal V and U metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3u, e3v, e3t ! vertical metrics (partial steps) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamt, gphit ! T longitude latitude REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn ! horizontal velocity component REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: hdivn ! horizontal divergence REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of W points REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics ( full step) CHARACTER(LEN=256) :: cf_ufil ! U file name CHARACTER(LEN=256) :: cf_vfil ! V file name CHARACTER(LEN=256) :: cf_out='w.nc' ! W file name ( output) CHARACTER(LEN=256) :: cldum ! dummy string TYPE(variable), DIMENSION(1) :: stypvar ! output attributes LOGICAL :: lchk ! missing files flag LOGICAL :: lfull=.FALSE. ! full step flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg < 2 ) THEN PRINT *,' usage : cdfw U-file V-file [ U-var V-var ] [ -full]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the vertical velocity from the vertical integration of' PRINT *,' of the horizontal divergence of the velocity.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' U-file : netcdf file with the zonal velocity component.' PRINT *,' V-file : netcdf file with the meridional velocity component.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ U-var V-var ] : names of the zonal and meridional velocity ' PRINT *,' components. Default are ', TRIM(cn_vozocrtx),' and ', TRIM(cn_vomecrty) PRINT *,' [ -full ] : in case of full step configuration. Default is partial step.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cn_vovecrtz),' (m/s)' STOP ENDIF ijarg = 1 CALL getarg(ijarg, cf_ufil) ; ijarg = ijarg + 1 CALL getarg(ijarg, cf_vfil) ; ijarg = ijarg + 1 DO WHILE (ijarg <= narg ) CALL getarg(ijarg, cldum) SELECT CASE ( cldum ) CASE ( '-full' ) lfull = .TRUE. ijarg = ijarg + 1 CASE DEFAULT CALL getarg(ijarg, cn_vozocrtx) ; ijarg = ijarg + 1 CALL getarg(ijarg, cn_vomecrty) ; ijarg = ijarg + 1 END SELECT END DO lchk = chkfile (cn_fhgr) lchk = chkfile (cn_fzgr) .OR. lchk lchk = chkfile (cf_ufil) .OR. lchk lchk = chkfile (cf_vfil) .OR. lchk IF ( lchk ) STOP ! missing files npiglo = getdim(cf_ufil,cn_x) npjglo = getdim(cf_ufil,cn_y) npk = getdim(cf_ufil,cn_z) npt = getdim(cf_ufil,cn_t) ! define new variables for output ipk(1) = npk stypvar(1)%cname = TRIM(cn_vovecrtz) stypvar(1)%cunits = 'm/s' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -1. stypvar(1)%valid_max = 1. stypvar(1)%clong_name = 'Vertical_Velocity' stypvar(1)%cshort_name = TRIM(cn_vovecrtz) stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' ! Allocate the memory ALLOCATE ( e1v(npiglo,npjglo), e2u(npiglo,npjglo) ) ALLOCATE ( e1t(npiglo,npjglo), e2t(npiglo,npjglo) ) ALLOCATE ( e3u(npiglo,npjglo), e3v(npiglo,npjglo), e3t(npiglo,npjglo) ) ALLOCATE ( glamt(npiglo,npjglo), gphit(npiglo,npjglo) ) ALLOCATE ( un(npiglo,npjglo), vn(npiglo,npjglo), hdivn(npiglo,npjglo) ) ALLOCATE ( wn(npiglo,npjglo,2) ) ALLOCATE ( gdepw(npk), tim(npt) ) IF ( lfull ) ALLOCATE ( e31d (npk) ) ! Read the metrics from the mesh_hgr file e2u = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo) e1v = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo) e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) ! and the coordinates from the mesh_hgr file glamt = getvar(cn_fhgr, cn_glamt, 1, npiglo, npjglo) gphit = getvar(cn_fhgr, cn_gphit, 1, npiglo, npjglo) ! Read the depth of the w points (in the file, it is not a vector but a 1x1xnpk array) gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk) IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk) ! create output fileset ncout = create (cf_out, cf_ufil, npiglo, npjglo, npk, cdep=cn_vdepthw ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, 'dummy', npiglo, npjglo, npk, glamt, gphit, gdepw ) tim = getvar1d(cf_ufil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jt = 1, npt wn(:,:,:) = 0. ! Main level loop from bottom to top DO jk = npk-1, 1, -1 PRINT *,'jt = ', jt,' jk = ', jk ! velocities at level jk un(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jt) vn(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt) IF ( lfull ) THEN e3u(:,:) = e31d(jk) e3v(:,:) = e31d(jk) e3t(:,:) = e31d(jk) ELSE ! e3 metrics at level jk ( Partial steps) e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.) e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.) e3t(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF ! Compute divergence : DO jj = 2, npjglo -1 DO ji = 2, npiglo -1 hdivn(ji,jj) = & & ( e2u(ji,jj)*e3u(ji,jj) * un(ji,jj) - e2u(ji-1,jj )*e3u(ji-1,jj ) * un(ji-1,jj ) & & + e1v(ji,jj)*e3v(ji,jj) * vn(ji,jj) - e1v(ji ,jj-1)*e3v(ji ,jj-1) * vn(ji ,jj-1) ) & & / ( e1t(ji,jj)*e2t(ji,jj) * e3t(ji,jj) ) END DO END DO ! Computation from the bottom wn(:,:,itop) = wn(:,:,ibot) - e3t(:,:) * hdivn(:,:) ! write wn on file at level jk (This coculd be epensive at it writes from the bottom ... ierr = putvar(ncout, id_varout(1), wn(:,:,itop), jk, npiglo, npjglo, ktime=jt) ! swap top and bottom index itmp=itop ; itop=ibot ; ibot=itmp END DO ! loop to next level END DO ! loop on time ierr = closeout(ncout) END PROGRAM cdfw cdftools-3.0/cdfstatcoord.f900000644000175000017500000001032012241227304017313 0ustar amckinstryamckinstryPROGRAM cdfstatcoord !!====================================================================== !! *** PROGRAM cdfstatcoord *** !!===================================================================== !! ** Purpose : Compute statistics about the grid metric versus latitude !! !! ** Method : bins e1 and e2 by latitudes and takes the mean value !! of each bin !! !! History : 2.1 : 07/2007 : J.M. Molines : Original code (T. Penduff idea) !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: narg, iargc ! browse lines INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: ngood ! point counter REAL(KIND=4), PARAMETER :: pp_binsize=2. ! bin size REAL(KIND=4), PARAMETER :: pp_latmin=-80. ! minimum latitude REAL(KIND=4), PARAMETER :: pp_latmax=90. ! maximum latitude REAL(KIND=4) :: rlat, rlat1, rlat2 ! working variables REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: e1, e2, gphi, zmask ! metrics and mask REAL(KIND=8) :: de1mean, de2mean ! mean value of horiz metrics CHARACTER(LEN=256) :: cf_coo, cf_msk ! file names CHARACTER(LEN=256) :: cv_msk='tmask' ! mask variable name LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lgood ! flag for point selection !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg < 2 ) THEN PRINT *,' usage : cdfstatcoord COOR-file MSK-file [ MSK-var ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Computes and displays statistics about grid metrics vs latitude.' PRINT *,' Bins e1 and e2 by latitude bins, and compute the mean of each bin.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' COOR-file : coordinates file with e1 e2 metrics' PRINT *,' MSK-file : mask file ' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [MSK-var] : mask variable name. Default is ', TRIM(cv_msk) PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none apart those requested on command line.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' Standard output' STOP ENDIF CALL getarg (1, cf_coo) CALL getarg (2, cf_msk) IF ( narg == 3 ) CALL getarg(3, cv_msk) IF ( chkfile(cf_coo) .OR. chkfile(cf_msk) ) STOP ! missing files npiglo= getdim (cf_coo, cn_x) npjglo= getdim (cf_coo, cn_y) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo ALLOCATE ( e1(npiglo,npjglo) , e2(npiglo,npjglo) ) ALLOCATE ( gphi(npiglo,npjglo), zmask(npiglo,npjglo), lgood(npiglo,npjglo) ) ! read grid metrics and latitude e1 = getvar(cf_coo, cn_ve1t, 1, npiglo, npjglo) e2 = getvar(cf_coo, cn_ve2t, 1, npiglo, npjglo) gphi = getvar(cf_coo, cn_gphit, 1, npiglo, npjglo) ! read zmask (1) zmask = getvar(cf_msk, cv_msk, 1, npiglo, npjglo) rlat = pp_latmin + pp_binsize/2. DO WHILE ( rlat <= pp_latmax ) rlat1 = rlat - pp_binsize/2. ; rlat2 = rlat + pp_binsize/2. lgood = .FALSE. WHERE ( rlat1 <= gphi .AND. gphi < rlat2 .AND. zmask /= 0 ) lgood=.TRUE. ngood = COUNT(lgood) IF ( ngood /= 0 ) THEN de1mean = SUM( e1, mask=lgood) / ngood de2mean = SUM( e2, mask=lgood) / ngood ELSE de1mean = -999. de2mean = -999. ENDIF PRINT '(f8.3, 3f15.3,i8)', rlat, de1mean, de2mean ,de1mean/de2mean, ngood rlat = rlat + pp_binsize ENDDO END PROGRAM cdfstatcoord cdftools-3.0/cdfmhst.f900000644000175000017500000005731412241227304016302 0ustar amckinstryamckinstryPROGRAM cdfmhst !!====================================================================== !! *** PROGRAM cdfmhst *** !!===================================================================== !! ** Purpose : Compute Meridional Heat Salt Transport. !! !! ** Method : Starts from the mean VT, VS fields computed by cdfvT. !! Optionally, it can read V, T and S files in separate files !! Zonal and vertical integration are performed for these !! quantities. If a sub-basin mask is provided, then a !! meridional H/S transoport is computed for each sub basin. !! Meridional H/S transports at different depths !! !! History : 2.1 : 01/2005 : J.M. Molines : Original code !! : 04/2005 : A.M. Treguier : adaptation to regional config !! : 04/2007 : J.M. Molines : add netcdf output !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic. !! 10/2012 : M.A. Balmaseda: opt separate V,T,S infiles !! opt z dimension !! add inp0 !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: jbasins, jvar ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ik0 ! working integer INTEGER(KIND=4) :: ifile ! dummuy loop INTEGER(KIND=4) :: ijarg ! argument counter INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt, npko ! size of the domain INTEGER(KIND=4) :: numouth = 10 ! logical unit for heat INTEGER(KIND=4) :: numouts = 11 ! logical unit for salt INTEGER(KIND=4) :: npvar=1 ! number of variables type INTEGER(KIND=4) :: nbasins ! number of basins INTEGER(KIND=4) :: nbasinso ! basins in output INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4) :: ivar ! variable index INTEGER(KIND=4), DIMENSION(2) :: iloc ! working array INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! for output variables REAL(KIND=4), PARAMETER :: pprau0 = 1000. ! reference density REAL(KIND=4), PARAMETER :: pprcp = 4000. ! specific heat REAL(KIND=4), PARAMETER :: ppspval= 9999.99 ! missing value REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdep ! depth array REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! 1D e3t for full step REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e3v, gphiv ! metrics and latitude REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvt, zvs ! transport components REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zv, zt, zs ! v,t,s REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon ! dummy longitude = 0. REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlat ! latitude for i = north pole REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_glo ! zonal integral REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_atl ! zonal integral REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_pac REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_ind REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_aus REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_med REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_glo REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_atl REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_pac REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_ind REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_aus REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_med REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dmtrp ! transport in PW ir kT/s REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwkh, dtrph ! working variables REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtrps, dwks ! working variables TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for attributes CHARACTER(LEN=256) :: cf_vtfil ! input VT or V file name CHARACTER(LEN=256) :: cf_vfil ! separate V files CHARACTER(LEN=256) :: cf_tfil ! separate T,S files CHARACTER(LEN=256) :: cf_sfil ! separate T,S files CHARACTER(LEN=256) :: cf_outh='zonal_heat_trp.dat' CHARACTER(LEN=256) :: cf_outs='zonal_salt_trp.dat' CHARACTER(LEN=256) :: cf_outnc='mhst.nc' CHARACTER(LEN=256) :: cv_zomht='zomht' ! MHT variable name CHARACTER(LEN=256) :: cv_zomst='zomst' ! MST variable name CHARACTER(LEN=256) :: cldum ! dummy character variable CHARACTER(LEN=5), DIMENSION(6) :: cbasin=(/'_glo ','_atl ','_inp ','_ind ','_pac ','_inp0'/) CHARACTER(LEN=80), DIMENSION(:), ALLOCATABLE :: cvarname ! varname arrays CHARACTER(LEN=256) :: cldimension ! varname arrays LOGICAL :: llglo = .FALSE. ! flag for sub basin file LOGICAL :: lchk = .FALSE. ! flag for missing files LOGICAL :: lfull = .FALSE. ! flag for missing files LOGICAL :: lsepf = .FALSE. ! flag for separate files LOGICAL :: lzdim = .FALSE. ! flag for separate files !!---------------------------------------------------------------------- CALL ReadCdfNames() !! Read command line and output usage message if not compliant. narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmhst VT-file | (V-file T-file [S-file]) [MST] [-full] ...' PRINT *,' ... [-Zdim] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the meridional heat/salt transport as a function of ' PRINT *,' latitude. If the file ',TRIM(cn_fbasins),' is provided, the meridional ' PRINT *,' heat/salt transport for each sub-basin is also computed.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' VT-file : netcdf file containing the mean value of the products' PRINT *,' U.S, U.T, V.S and V.T (obtained with cdfvT).' PRINT *,' or ' PRINT *,' V-file T-file [S-file] : specify V, T S file as separate files. If' PRINT *,' S-file is not specified, assume that salinity is in T-file.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [MST ] : output flag for meridional salt transport on netcdf files.' PRINT *,' If not specified, only the MHT is output.' PRINT *,' [-full ] : to be set for full step case.' PRINT *,' [-Zdim ] : to be set to output vertical structure of Heat/salt transport' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fhgr),', ',TRIM(cn_fzgr),' and ',TRIM(cn_fmsk) PRINT *,' If ',TRIM(cn_fbasins),' is also available, sub-basin meridional transports' PRINT *,' are also computed.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' ASCII files : ', TRIM(cf_outh),' : Meridional Heat Transport' PRINT *,' ', TRIM(cf_outs),' : Meridional Salt Transport' PRINT *,' netcdf file : ', TRIM(cf_outnc) PRINT *,' variables : ( [... ] : MST option ) ' PRINT *,' ', TRIM(cv_zomht),cbasin(1),' : Meridional Heat Transport (global)' PRINT *,' [ ', TRIM(cv_zomst),cbasin(1),' : Meridional Salt Transport (global) ] ' PRINT *,' If ',TRIM(cn_fbasins),' is available, per basin meridional transport ' PRINT *,' are also available:' DO jbasins=2, 6 PRINT *,' ', TRIM(cv_zomht),cbasin(jbasins),' : Meridional Heat Transport' PRINT *,' [ ', TRIM(cv_zomst),cbasin(jbasins),' : Meridional Salt Transport ]' END DO STOP ENDIF npvar = 1 ! default value ( no MST output) ijarg = 1 ifile = 0 ! browse command line and detect the file name as argument different from any option ! count the number of files. Assume VT if 1 only, V TS if 2 and V T S if 3 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum) ; ijarg = ijarg+1 SELECT CASE ( cldum) CASE ( 'MST' ) ; npvar = 2 CASE ( '-full' ) ; lfull = .TRUE. CASE ( '-Zdim' ) ; lzdim = .TRUE. CASE DEFAULT ; ifile = ifile + 1 SELECT CASE (ifile) CASE ( 1) ; cf_vtfil = cldum CASE ( 2) ; cf_tfil = cldum CASE ( 3) ; cf_sfil = cldum CASE DEFAULT ; PRINT *,' WARNING: more than 3 files in input : weird ' END SELECT END SELECT END DO ! security check SELECT CASE (ifile ) CASE ( 0 ) ; PRINT *, ' You must provide at least 1 file name (VT) ' ; STOP CASE ( 1 ) ; lsepf = .false.; CASE ( 2 ) ; lsepf = .true. ; cf_vfil = cf_vtfil ; cf_sfil = cf_tfil CASE ( 3 ) ; lsepf = .true. ; cf_vfil = cf_vtfil END SELECT ! check for missing files lchk = lchk .OR. chkfile( cn_fhgr ) lchk = lchk .OR. chkfile( cn_fzgr ) lchk = lchk .OR. chkfile( cn_fmsk ) lchk = lchk .OR. chkfile( cf_vtfil) IF ( lsepf ) THEN lchk = lchk .OR. chkfile( cf_tfil) lchk = lchk .OR. chkfile( cf_sfil) ENDIF IF ( lchk ) STOP ! missing files ! check for sub basin file and set appropriate variables IF ( .NOT. chkfile(cn_fbasins ) ) THEN llglo = .TRUE. nbasins = 5 nbasinso = 6 ELSE PRINT *,' Only compute for GLOBAL basin' llglo = .FALSE. nbasins = 1 nbasinso = 1 ENDIF npiglo = getdim (cf_vtfil, cn_x) npjglo = getdim (cf_vtfil, cn_y) npk = getdim (cf_vtfil, cn_z) npt = getdim (cf_vtfil, cn_t) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt IF ( lzdim ) THEN ! output file hold heat/salt transport by levels npko = npk cldimension = 'TZY' ELSE npko = 1 cldimension = 'TY' ENDIF ! Allocate arrays ALLOCATE ( tim(npt) ) ALLOCATE ( dwkh(npiglo,npjglo), zmask(npiglo,npjglo), zvt(npiglo,npjglo) ) ALLOCATE ( dwks(npiglo,npjglo), zvs(npiglo,npjglo) ) ALLOCATE ( e1v(npiglo,npjglo), e3v(npiglo,npjglo), gphiv(npiglo,npjglo)) ALLOCATE ( dtrph(npiglo,npjglo)) ALLOCATE ( dtrps(npiglo,npjglo)) ALLOCATE ( dzonal_heat_glo(npjglo), dzonal_heat_atl(npjglo), dzonal_heat_pac(npjglo) ) ALLOCATE ( dzonal_heat_ind(npjglo), dzonal_heat_aus(npjglo), dzonal_heat_med(npjglo) ) ALLOCATE ( dzonal_salt_glo(npjglo), dzonal_salt_atl(npjglo), dzonal_salt_pac(npjglo) ) ALLOCATE ( dzonal_salt_ind(npjglo), dzonal_salt_aus(npjglo), dzonal_salt_med(npjglo) ) ALLOCATE ( rdumlon(1,npjglo), rdumlat(1,npjglo)) ALLOCATE ( dmtrp(npjglo) ) ALLOCATE ( gdep (npko) ) IF ( lsepf ) THEN ALLOCATE ( zv(npiglo,npjglo), zt(npiglo,npjglo), zs(npiglo,npjglo) ) ENDIF IF ( lfull ) ALLOCATE ( e31d(npk) ) e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo) gphiv(:,:) = getvar(cn_fhgr, cn_gphiv, 1, npiglo, npjglo) IF ( lzdim ) THEN gdep(:) = getvare3(cn_fzgr, cn_gdept, npk ) ELSE gdep(:) = 0. ! dummy depth for netcdf output ENDIF IF ( lfull ) e31d = getvare3(cn_fzgr, cn_ve3t, npk ) iloc = MAXLOC( gphiv ) rdumlat(1,:) = gphiv(iloc(1),:) rdumlon(:,:) = 0. ! set the dummy longitude to 0 ! prepare output netcdf output file ! Allocate output variables ALLOCATE(stypvar(nbasinso*npvar), cvarname(nbasinso*npvar) ) ALLOCATE( ipk(nbasinso*npvar), id_varout(nbasinso*npvar) ) ipk(:)=npko ! all output variables either 1 or npko levels DO jbasins = 1,nbasinso cvarname(jbasins) = TRIM(cv_zomht)//TRIM(cbasin(jbasins)) stypvar(jbasins)%cname = cvarname(jbasins) stypvar(jbasins)%cunits = 'PW' stypvar(jbasins)%rmissing_value = ppspval stypvar(jbasins)%valid_min = -10. stypvar(jbasins)%valid_max = 20 stypvar(jbasins)%clong_name = 'Meridional Heat Transport '//TRIM(cbasin(jbasins)) stypvar(jbasins)%cshort_name = cvarname(jbasins) stypvar(jbasins)%conline_operation = 'N/A' stypvar(jbasins)%caxis = cldimension IF ( npvar == 2 ) THEN ! MST ivar = nbasinso+jbasins cvarname(ivar) = TRIM(cv_zomst)//TRIM(cbasin(jbasins)) stypvar(ivar )%cname = cvarname(ivar) stypvar(ivar )%cunits = 'T/sec' stypvar(ivar )%rmissing_value = ppspval stypvar(ivar )%valid_min = -10.e9 stypvar(ivar )%valid_max = 20.e9 stypvar(ivar )%clong_name = 'Meridional Salt Transport '//TRIM(cbasin(jbasins)) stypvar(ivar )%cshort_name = cvarname(ivar) stypvar(ivar )%conline_operation = 'N/A' stypvar(ivar )%caxis = cldimension ENDIF END DO ! create output fileset ncout = create (cf_outnc, cf_vtfil, 1, npjglo, npko, cdep='depthv' ) ierr = createvar (ncout, stypvar, nbasinso*npvar, ipk, id_varout ) ierr = putheadervar(ncout, cf_vtfil, 1, npjglo, npko, pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdep) tim = getvar1d (cf_vtfil, cn_vtimec, npt ) ierr = putvar1d (ncout, tim, npt, 'T') OPEN(numouth,FILE=cf_outh,FORM='FORMATTED', RECL=256) ! to avoid wrapped line with ifort OPEN(numouts,FILE=cf_outs,FORM='FORMATTED', RECL=256) ! to avoid wrapped line with ifort DO jt=1, npt dtrph(:,:) = 0.d0 dtrps(:,:) = 0.d0 DO jk = 1,npk PRINT *,'level ',jk ! Get temperature and salinity at jk IF ( lsepf ) THEN zv(:,:)= getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt) zt(:,:)= getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zs(:,:)= getvar(cf_sfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) zvt(:,:)=0. zvs(:,:)=0. DO ji=1, npiglo DO jj = 1, npjglo -1 zvt(ji,jj) = 0.5 * ( zt(ji,jj) + zt(ji,jj+1) )*zv(ji,jj) ! temper at Vpoint zvs(ji,jj) = 0.5 * ( zs(ji,jj) + zs(ji,jj+1) )*zv(ji,jj) ! salinity at Vpoint END DO END DO ELSE zvt(:,:)= getvar(cf_vtfil, cn_vomevt, jk, npiglo, npjglo, ktime=jt) zvs(:,:)= getvar(cf_vtfil, cn_vomevs, jk, npiglo, npjglo, ktime=jt) ENDIF ! get e3v at level jk IF ( lfull ) THEN e3v(:,:) = e31d(jk) ELSE e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF dwkh(:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)*1.d0 dwks(:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)*1.d0 ! integrates vertically dtrph(:,:) = dtrph(:,:) + dwkh(:,:) * pprau0 * pprcp dtrps(:,:) = dtrps(:,:) + dwks(:,:) !global zmask(:,:) = getvar(cn_fmsk, 'vmask', 1, npiglo, npjglo) DO jj=1,npjglo dzonal_heat_glo(jj) = SUM( dtrph(2:npiglo-1,jj)*zmask(2:npiglo-1,jj) ) dzonal_salt_glo(jj) = SUM( dtrps(2:npiglo-1,jj)*zmask(2:npiglo-1,jj) ) END DO IF ( llglo ) THEN ! Zonal mean with mask ! Atlantic zmask(:,:) = getvar(cn_fbasins, 'tmaskatl', 1, npiglo, npjglo) DO jj=1,npjglo dzonal_heat_atl(jj) = SUM( dtrph(:,jj)*zmask(:,jj) ) dzonal_salt_atl(jj) = SUM( dtrps(:,jj)*zmask(:,jj) ) END DO ! Pacific zmask(:,:) = getvar(cn_fbasins, 'tmaskpac', 1, npiglo, npjglo) DO jj=1,npjglo dzonal_heat_pac(jj) = SUM( dtrph(:,jj)*zmask(:,jj) ) dzonal_salt_pac(jj) = SUM( dtrps(:,jj)*zmask(:,jj) ) END DO ! Indian zmask(:,:) = getvar(cn_fbasins, 'tmaskind', 1, npiglo, npjglo) DO jj=1,npjglo dzonal_heat_ind(jj) = SUM( dtrph(:,jj)*zmask(:,jj) ) dzonal_salt_ind(jj) = SUM( dtrps(:,jj)*zmask(:,jj) ) END DO ! Austral dzonal_heat_aus = 0.d0 dzonal_salt_aus = 0.d0 ! zmask(:,:)=getvar(cn_fbasins,'tmaskant',1,npiglo,npjglo) ! DO jj=1,npjglo ! dzonal_heat_aus(jj)= SUM( dtrph(:,jj)*zmask(:,jj)) ! dzonal_salt_aus(jj)= SUM( dtrps(:,jj)*zmask(:,jj)) ! END DO ! ! Med dzonal_heat_med = 0.d0 dzonal_salt_med = 0.d0 ! zmask(:,:)=getvar(cn_fbasins,'tmaskmed',1,npiglo,npjglo) ! DO jj=1,npjglo ! dzonal_heat_med(jj)= SUM( dtrph(:,jj)*zmask(:,jj)) ! dzonal_salt_med(jj)= SUM( dtrps(:,jj)*zmask(:,jj)) ! END DO ENDIF IF ( lzdim .OR. ( jk == npk ) ) THEN !output this level IF ( lzdim ) THEN ; ik0 = jk ; ELSE ; ik0 = 1 ; ENDIF DO jvar=1,npvar ! MHT [ and MST ] (1 or 2 ) IF ( jvar == 1 ) THEN ! MHT ivar=1 dmtrp(:) = dzonal_heat_glo(:)/1.d15 ! GLO WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 IF ( nbasins == 5 ) THEN dmtrp(:) = dzonal_heat_atl(:)/1.d15 ! ATL WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 dmtrp(:) = (dzonal_heat_ind(:) + dzonal_heat_pac(:))/1.d15 ! INP WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 dmtrp(:) = dzonal_heat_ind(:)/1.d15 ! IND WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 dmtrp(:) = dzonal_heat_pac(:)/1.d15 ! PAC WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 ! now inp0 dmtrp(:) = ( dzonal_heat_glo(:) - dzonal_heat_atl(:) )/1.d15 ! INP0 WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 ENDIF ELSE ! MST dmtrp(:) = dzonal_salt_glo(:)/1.d6 ! GLO WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr=putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 IF ( nbasins == 5 ) THEN dmtrp(:) = dzonal_salt_atl(:)/1.d6 ! ATL WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 dmtrp(:) = (dzonal_salt_ind(:) + dzonal_salt_pac(:))/1.d6 ! INP WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 dmtrp(:) = dzonal_salt_ind(:)/1.d6 ! IND WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 dmtrp(:) = dzonal_salt_pac(:)/1.d6 ! PAC WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr=putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 ! now inp0 dmtrp(:) = ( dzonal_salt_glo(:) - dzonal_salt_atl(:) )/1.d6 ! INP0 WHERE ( dmtrp == 0 ) dmtrp = ppspval ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), ik0, 1, npjglo, ktime=jt) ivar=ivar+1 ENDIF ENDIF END DO ENDIF ! end loop on check for ouptut END DO ! loop to next level WRITE(numouth,*)'! Zonal heat transport (integrated alon I-model coordinate) (in Pw)' IF ( llglo ) THEN WRITE(numouth,*)'! J Global Atlantic Pacific Indian Mediteranean Austral ' WRITE(numouth,*)' ! time : ', jt DO jj=npjglo, 1, -1 WRITE(numouth,9000) jj, & rdumlat(1,jj), dzonal_heat_glo(jj)/1d15 , & dzonal_heat_atl(jj)/1d15, & dzonal_heat_pac(jj)/1d15, & dzonal_heat_ind(jj)/1d15, & dzonal_heat_med(jj)/1d15, & dzonal_heat_aus(jj)/1d15 END DO ELSE WRITE(numouth,*)'! J Global ' WRITE(numouth,*)' ! time : ', jt DO jj=npjglo, 1, -1 WRITE(numouth,9000) jj, & rdumlat(1,jj), dzonal_heat_glo(jj)/1d15 END DO ENDIF ! WRITE(numouts,*)' ! Zonal salt transport (integrated alon I-model coordinate) (in 10^6 kg/s)' IF ( llglo ) THEN WRITE(numouts,*)' ! J Global Atlantic Pacific Indian Mediteranean Austral ' WRITE(numouts,*)' ! time : ', jt ! DO jj=npjglo, 1, -1 WRITE(numouts,9001) jj, & rdumlat(1,jj), dzonal_salt_glo(jj)/1d6 , & dzonal_salt_atl(jj)/1d6, & dzonal_salt_pac(jj)/1d6, & dzonal_salt_ind(jj)/1d6, & dzonal_salt_med(jj)/1d6, & dzonal_salt_aus(jj)/1d6 END DO ELSE WRITE(numouts,*)' J Global ' WRITE(numouts,*)' ! time : ', jt DO jj=npjglo, 1, -1 WRITE(numouts,9001) jj, & rdumlat(1,jj), dzonal_salt_glo(jj)/1d6 ENDDO ENDIF ENDDO ! time loop ierr = closeout(ncout) CLOSE(numouth) CLOSE(numouts) 9000 FORMAT(I4,6(1x,f9.3,1x,f8.4)) 9001 FORMAT(I4,6(1x,f9.2,1x,f9.3)) END PROGRAM cdfmhst cdftools-3.0/cdfrichardson.f900000644000175000017500000002401712241227304017455 0ustar amckinstryamckinstryPROGRAM cdfrichardson !!====================================================================== !! *** PROGRAM cdfrichardson *** !!===================================================================== !! ** Purpose : Compute the Richardson NUmber !! using same algoritm than NEMO !! !! ** Method : Try to avoid 3 d arrays : work with 2 levels at a time !! The Richardson number is computed as !! Ri = N^2/ dz(U)**2 !! and dz(U)** [ squared vertical velocity derivative] is : !! dz(ub)*dz(ub) + dz(vb)*dz(vb) !! !! History : 2.0 : 11/2004 : J.M. Molines : Original code !! 2.1 : 04/2005 : J.M. Molines : use cdfio !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames ! for cdf variable names USE eos !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! INTEGER(KIND=4) :: npiglo, npjglo, npk, npt ! size of the domain INTEGER(KIND=4) :: iup = 1, idown = 2, itmp ! for swapping the levels INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(2) :: ipk, id_varout ! level and id of output variables REAL(KIND=4) :: zpi ! 3.14... REAL(KIND=4) :: rspval=0. ! missing_value REAL(KIND=4) :: zcoef, zdku, zdkv, zzri ! working real REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: ztemp, zsal, zwk ! Array to read 2 layer of data REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zu, zv ! Array to read 2 layer of velocities REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zri ! Richardson number REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e3w ! mask and metric REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep, tim, e3w1d ! depth and time CHARACTER(LEN=256) :: cldum ! dummy char variable CHARACTER(LEN=256) :: cf_tfil ! input T file name CHARACTER(LEN=256) :: cf_ufil ! input U file name CHARACTER(LEN=256) :: cf_vfil ! input V file name CHARACTER(LEN=256) :: cf_out = 'richardson.nc' ! output file name CHARACTER(LEN=256) :: cglobal ! global attribute CHARACTER(LEN=80) :: cv_e3w = 'e3w_ps' ! e3w variable name (partial step) CHARACTER(LEN=80) :: cv_ric = 'voric' ! cdf variable name for N2 CHARACTER(LEN=80) :: cv_dep ! cdf variable name for depth TYPE(variable), DIMENSION(1) :: stypvar ! variable attribute LOGICAL :: l_w=.FALSE. ! flag for vertical location of ric LOGICAL :: lchk=.TRUE. ! check missing files LOGICAL :: lfull=.FALSE. ! full step flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfrichardson gridT gridU gridV [ W ] [-full]' PRINT *,' PURPOSE :' PRINT *,' Compute the Richardson Number (Ri) according to' PRINT *,' temperature, salinity and velocity components' PRINT *,' given in the input files.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' gridT : input gridT file for temperature and salinity' PRINT *,' gridU : input gridU file for zonal velocity component' PRINT *,' gridV : input gridV file for meridional velocity component' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ W ] : keep N2 at W points. Default is to interpolate N2' PRINT *,' at T point on the vertical' PRINT *,' [ -full ] : indicate a full step configuration instead of' PRINT *,' the default partial steps.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fzgr),' is needed for this program.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_ric) STOP ENDIF cglobal = 'Partial step computation' ijarg = 1 CALL getarg (ijarg, cf_tfil) ; ijarg = ijarg + 1 CALL getarg (ijarg, cf_ufil) ; ijarg = ijarg + 1 CALL getarg (ijarg, cf_vfil) ; ijarg = ijarg + 1 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE (cldum) CASE ('W','w') ; l_w = .TRUE. CASE ('-full') ; lfull = .TRUE. ; cglobal = 'full step computation' CASE DEFAULT ; PRINT *,' Option not understood :', TRIM(cldum) ; STOP END SELECT END DO lchk = chkfile (cn_fzgr ) lchk = lchk .OR. chkfile (cf_tfil ) lchk = lchk .OR. chkfile (cf_ufil ) lchk = lchk .OR. chkfile (cf_vfil ) IF ( lchk ) STOP ! missing files npiglo = getdim (cf_tfil, cn_x) npjglo = getdim (cf_tfil, cn_y) npk = getdim (cf_tfil, cn_z) npt = getdim (cf_tfil, cn_t) ipk(1) = npk ! 3D stypvar(1)%cname = cv_ric stypvar(1)%cunits = 'no' stypvar(1)%rmissing_value = rspval stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 50000. stypvar(1)%clong_name = 'Richardson Number' stypvar(1)%cshort_name = cv_ric stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2) ) ALLOCATE (zu(npiglo,npjglo,2), zv(npiglo,npjglo,2) ) ALLOCATE (zwk(npiglo,npjglo,2), zmask(npiglo,npjglo) ) ALLOCATE (zri(npiglo,npjglo), e3w(npiglo,npjglo) ) ALLOCATE (gdep(npk), tim(npt) ) zwk(:,:,:) = rspval zri(:,:) = rspval IF ( lfull ) ALLOCATE (e3w1d(npk) ) cv_dep=cn_gdept IF (l_w) cv_dep=cn_gdepw gdep(:) = getvare3(cn_fzgr, cv_dep, npk) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk) ierr = createvar (ncout , stypvar, 1, ipk, id_varout, cdglobal=TRIM(cglobal)) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk, pdep=gdep) zpi=ACOS(-1.) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt,'T') IF ( lfull ) e3w1d(:) = getvare3(cn_fzgr, cn_ve3w, npk) gdep(:) = getvare3(cn_fzgr, cn_gdepw, npk) DO jt=1,npt ! 2 levels of T and S are required : iup,idown (with respect to W level) ! Compute from bottom to top (for vertical integration) ztemp(:,:,idown) = getvar(cf_tfil, cn_votemper, npk-1, npiglo, npjglo, ktime=jt) zsal( :,:,idown) = getvar(cf_tfil, cn_vosaline, npk-1, npiglo, npjglo, ktime=jt) zu( :,:,idown) = getvar(cf_ufil, cn_vozocrtx, npk-1, npiglo, npjglo, ktime=jt) zv( :,:,idown) = getvar(cf_vfil, cn_vomecrty, npk-1, npiglo, npjglo, ktime=jt) DO jk = npk-1, 2, -1 PRINT *,'level ',jk zmask(:,:)=1. ztemp(:,:,iup)= getvar(cf_tfil, cn_votemper, jk-1, npiglo, npjglo, ktime=jt) WHERE(ztemp(:,:,idown) == 0 ) zmask = 0 zsal(:,:,iup) = getvar(cf_tfil, cn_vosaline, jk-1, npiglo, npjglo, ktime=jt) zu( :,:,iup) = getvar(cf_ufil, cn_vozocrtx, jk-1, npiglo, npjglo, ktime=jt) zv( :,:,iup) = getvar(cf_vfil, cn_vomecrty, jk-1, npiglo, npjglo, ktime=jt) IF ( lfull ) THEN e3w(:,:) = e3w1d(jk) ELSE e3w(:,:) = getvar(cn_fzgr, cv_e3w , jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF zwk(:,:,iup) = eosbn2(ztemp, zsal, gdep(jk), e3w, npiglo, npjglo ,iup, idown)* zmask(:,:) DO jj = 2, npjglo - 1 DO ji = 2, npiglo - 1 zcoef = 0.5 / e3w(ji,jj) ! ! shear of horizontal velocity zdku = zcoef * ( zu(ji-1,jj,iup ) + zu(ji,jj,iup ) & & -zu(ji-1,jj,idown) - zu(ji,jj,idown ) ) zdkv = zcoef * ( zv(ji,jj-1,iup ) + zv(ji,jj,iup ) & & -zv(ji,jj-1,idown) - zv(ji,jj,idown ) ) ! ! richardson number (minimum value set to zero) zzri = zwk(ji,jj,iup) / ( zdku*zdku + zdkv*zdkv + 1.e-20 ) zwk(ji,jj,iup) = MAX( zzri, 0.e0 ) ENDDO ENDDO IF ( .NOT. l_w ) THEN ! now put zri at T level (k ) WHERE ( zwk(:,:,idown) == 0 ) zri(:,:) = zwk(:,:,iup) ELSEWHERE zri(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * zmask(:,:) END WHERE ELSE zri(:,:) = zwk(:,:,iup) ENDIF WHERE ( zri < 0 .AND. zri /= rspval ) zri = rspval ierr = putvar(ncout, id_varout(1), zri, jk, npiglo, npjglo, ktime=jt ) itmp = idown ; idown = iup ; iup = itmp END DO ! loop to next level END DO ierr = closeout(ncout) END PROGRAM cdfrichardson cdftools-3.0/cdfcsp.f900000644000175000017500000001206312241227304016104 0ustar amckinstryamckinstryPROGRAM cdfcsp !!====================================================================== !! *** PROGRAM cdfcsp *** !!===================================================================== !! ** Purpose : Replace the masked part of the arrays (marked with !! special values) with spval zero. Replace consistently !! the definition of the spval in the variable attribut. !! !! History : 2.1 : 10/2006 : F. Castruccio : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jf, jk, jvar, jt ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk , npt ! size of the domain INTEGER(KIND=4) :: ncid, ierr ! ncdf related integer INTEGER(KIND=4) :: nvars ! Number of variables in a file INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: tab ! working array REAL(KIND=4) :: zspval ! special value read in file CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cunits ! units attribute CHARACTER(LEN=256) :: clname ! long name attribute CHARACTER(LEN=256) :: csname ! short name attribute CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! type for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfcsp list_of_files ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Replace missing_values by 0 and update attribute' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' The list of cdf file to process, all variables will be processed' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : same as input file (modified)' PRINT *,' variables : same as input file' STOP ENDIF !! Initialisation from 1st file (all file are assume to have the same geometry) CALL getarg (1, cf_in) IF ( chkfile (cf_in) ) STOP ! missing file npiglo = getdim (cf_in, cn_x) npjglo = getdim (cf_in, cn_y) npk = getdim (cf_in, cn_z, kstatus=ierr) npt = getdim (cf_in, cn_t) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z',kstatus=ierr) IF (ierr /= 0 ) THEN PRINT *, "ASSUME NO VERTICAL DIMENSIONS !" npk=0 ENDIF ENDIF PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE( tab(npiglo,npjglo) ) nvars = getnvar(cf_in) ALLOCATE (cv_names(nvars), id_var(nvars),ipk(nvars), stypvar(nvars)) cv_names(:) = getvarname(cf_in, nvars, stypvar) ipk(:) = getipk (cf_in, nvars ) id_var(:) = getvarid (cf_in, nvars ) DO jf = 1, narg CALL getarg (jf, cf_in) IF ( chkfile (cf_in) ) STOP ! missing file PRINT *, 'Change spval on file ', cf_in ncid = ncopen(cf_in) npt = getdim (cf_in,cn_t) DO jvar = 1,nvars IF ( cv_names(jvar) == cn_vlon2d .OR. & & cv_names(jvar) == cn_vlat2d .OR. & & cv_names(jvar) == cn_vtimec .OR. & & cv_names(jvar) == cn_vdeptht .OR. & & cv_names(jvar) == cn_vdepthu .OR. & & cv_names(jvar) == cn_vdepthv ) THEN ! skip these variable ELSE ierr = getvaratt (cf_in, cv_names(jvar), cunits, zspval, clname, csname) ierr = cvaratt (cf_in, cv_names(jvar), cunits, 0., clname, csname) DO jt=1,npt DO jk = 1, ipk(jvar) tab(:,:) = getvar(cf_in, cv_names(jvar), jk, npiglo, npjglo, ktime=jt ) WHERE( tab(:,:) == zspval ) tab(:,:) = 0. ierr = putvar(ncid, id_var(jvar), tab, jk, npiglo, npjglo, ktime=jt ) ENDDO END DO ENDIF ENDDO ENDDO ierr = closeout(ncid) END PROGRAM cdfcsp cdftools-3.0/cdfvhst.f900000644000175000017500000001775712241227304016322 0ustar amckinstryamckinstryPROGRAM cdfvhst !!====================================================================== !! *** PROGRAM cdfvhst *** !!===================================================================== !! ** Purpose : Compute Verticaly integrated Heat Salt Transport. !! !! ** Method : Take VT files computed by cdfvT.f90 and integrate !! vertically to produce a 2D file !! !! History : 2.1 : 01/2005 : J.M. Molines : Original code !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg ! argument counter INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncdf id of output file INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout ! output variable levels and id's REAL(KIND=4), PARAMETER :: pp_rau0=1000. ! fresh water density ( kg/m3) REAL(KIND=4), PARAMETER :: pp_rcp=4000. ! heat capacity of water (J/kg/K) REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e2u ! horizontal metrics REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3u, e3v ! vertical metrics REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zut, zus ! heat and salt zonal copmponents REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zvt, zvs ! heat and salt meridional components REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics when full step REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dtrput, dtrpus ! zonal transport REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dtrpvt, dtrpvs ! meridional transport TYPE (variable), DIMENSION(4) :: stypvar ! structure output variables CHARACTER(LEN=256) :: cf_vtfil ! input file name (vt) CHARACTER(LEN=256) :: cf_out='trp.nc' ! output file name CHARACTER(LEN=256) :: cldum ! dummy char variable LOGICAL :: lfull=.FALSE. ! flag for full step !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfvhst VTfile [-full ]' PRINT *,' PURPOSE :' PRINT *,' Computes the vertically integrated heat and salt transports ' PRINT *,' at each grid cell.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' VTfile : file which contains UT, VT, US, VS quantities' PRINT *,' (produced by cdfvT.f90)' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -full ] : use full step computation (default is partial steps).' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' Files ',TRIM(cn_fhgr),', ',TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' Netcdf file : ',TRIM(cf_out) PRINT *,' Variables : ', TRIM(cn_somevt),', ',TRIM(cn_somevs),', ',TRIM(cn_sozout),' and ',TRIM(cn_sozous) STOP ENDIF ijarg = 1 DO WHILE (ijarg <= narg ) CALL getarg(ijarg, cldum ) ; ijarg = ijarg+1 SELECT CASE (cldum ) CASE ( '-full' ) lfull = .TRUE. CASE DEFAULT cf_vtfil = cldum END SELECT END DO IF ( chkfile(cf_vtfil) ) STOP ! missing file npiglo= getdim (cf_vtfil,cn_x ) npjglo= getdim (cf_vtfil,cn_y ) npk = getdim (cf_vtfil,cn_z ) npt = getdim (cf_vtfil,cn_t ) ! define new variables for output ipk(:) = 1 stypvar%rmissing_value = 0. stypvar%valid_min = -100. stypvar%valid_max = 100. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' stypvar(1)%cname = cn_somevt stypvar(2)%cname = cn_somevs stypvar(3)%cname = cn_sozout stypvar(4)%cname = cn_sozous stypvar(1)%cunits = 'W' stypvar(2)%cunits = 'kg.s-1' stypvar(3)%cunits = 'W' stypvar(4)%cunits = 'kg.s-1' stypvar(1)%clong_name = 'Meridional_heat_transport' stypvar(2)%clong_name = 'Meridional_salt_transport' stypvar(3)%clong_name = 'Zonal_heat_transport' stypvar(4)%clong_name = 'Zonal_salt_transport' stypvar(1)%cshort_name = cn_somevt stypvar(2)%cshort_name = cn_somevs stypvar(3)%cshort_name = cn_sozout stypvar(4)%cshort_name = cn_sozous PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! Allocate arrays ALLOCATE ( zvt(npiglo,npjglo), zvs(npiglo,npjglo) ) ALLOCATE ( zut(npiglo,npjglo), zus(npiglo,npjglo) ) ALLOCATE ( e1v(npiglo,npjglo), e3v(npiglo,npjglo) ) ALLOCATE ( e2u(npiglo,npjglo), e3u(npiglo,npjglo) ) ALLOCATE ( dtrpvt(npiglo,npjglo), dtrpvs(npiglo,npjglo)) ALLOCATE ( dtrput(npiglo,npjglo), dtrpus(npiglo,npjglo)) ALLOCATE ( tim(npt), e31d(npk) ) ! create output fileset ncout = create (cf_out, cf_vtfil, npiglo, npjglo, 1 ) ierr = createvar (ncout, stypvar, 4, ipk, id_varout ) ierr = putheadervar(ncout, cf_vtfil, npiglo, npjglo, 1 ) tim = getvar1d(cf_vtfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ! read level independent metrics e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo) e2u(:,:) = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk ) ! used only for full step DO jt=1, npt ! reset transport to 0 dtrpvt(:,:) = 0.d0 dtrpvs(:,:) = 0.d0 dtrput(:,:) = 0.d0 dtrpus(:,:) = 0.d0 DO jk = 1,npk PRINT *,'level ',jk, ' time ', jt ! Get heat/salt transport component at jk zvt(:,:)= getvar(cf_vtfil, cn_vomevt, jk ,npiglo, npjglo, ktime=jt) zvs(:,:)= getvar(cf_vtfil, cn_vomevs, jk ,npiglo, npjglo, ktime=jt) zut(:,:)= getvar(cf_vtfil, cn_vozout, jk ,npiglo, npjglo, ktime=jt) zus(:,:)= getvar(cf_vtfil, cn_vozous, jk ,npiglo, npjglo, ktime=jt) ! get e3v at level jk ( and multiply by respective horizontal metric) IF ( lfull ) THEN e3v(:,:) = e31d(jk) * e1v(:,:) e3u(:,:) = e31d(jk) * e2u(:,:) ELSE e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.) * e1v(:,:) e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.) * e2u(:,:) ENDIF ! integrates vertically dtrpvt(:,:) = dtrpvt(:,:) + zvt(:,:) * e3v(:,:) * pp_rau0*pp_rcp * 1.d0 dtrpvs(:,:) = dtrpvs(:,:) + zvs(:,:) * e3v(:,:) * 1.d0 dtrput(:,:) = dtrput(:,:) + zut(:,:) * e3u(:,:) * pp_rau0*pp_rcp * 1.d0 dtrpus(:,:) = dtrpus(:,:) + zus(:,:) * e3u(:,:) * 1.d0 END DO ! loop to next level ! output on file ierr = putvar(ncout, id_varout(1) ,SNGL(dtrpvt), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(2) ,SNGL(dtrpvs), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(3) ,SNGL(dtrput), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(4) ,SNGL(dtrpus), 1, npiglo, npjglo, ktime=jt) END DO ! loop on time step ierr = closeout (ncout) END PROGRAM cdfvhst cdftools-3.0/modpoly.f900000644000175000017500000003371212241227304016331 0ustar amckinstryamckinstryMODULE modpoly !!====================================================================== !! *** MODULE modpoly *** !! Determine if a given point is within a polygon or not. This module is !! inherited from de finite element mesh generator program (TRIGRID) !!===================================================================== !! History : 2.1 : 03/2006 : J.M. Molines : Port from trigrid !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Licence !! !! Use algorithms developped in the late 80's for a finite element !! mesh generator (TRIGRID) by R. Walters, C. Werner et Al. !! Some original comments are maintained for references. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! ReadPoly : Read polygon file !! PrepPoly : Compute elements of the sides of polygon !! InPoly : Check if a point in in or out of a polygon !! PointSlope : Internal routine which computes slopes and coeff, of the side !!---------------------------------------------------------------------- IMPLICIT NONE PRIVATE INTEGER(KIND=4), PUBLIC , PARAMETER :: jpvert = 50 !: Number of vertex per polygon INTEGER(KIND=4), PUBLIC , PARAMETER :: jpolys = 20 !: Number of polygons. ! - Storage for polygon definitions INTEGER(KIND=4) :: numpolys ! number of of polygons currently defined INTEGER(KIND=4), DIMENSION(jpolys) :: nvertcnt ! number of vertices of a given polygon REAL(KIND=4), DIMENSION(jpolys,jpvert+1) :: vertx, verty ! 2dim. array of polygons and their X,Y coordinates REAL(KIND=4) :: rmaxx, rmaxy ! max x,y of polygon coordinates REAL(KIND=4) :: rminx, rminy ! min x,y of polygon coordinates REAL(KIND=8), DIMENSION(jpvert) :: slope ! slope of the sides of polygone REAL(KIND=8), DIMENSION(jpvert) :: ra, rb, rc ! equation of side of polygon PUBLIC :: ReadPoly PUBLIC :: PrepPoly PUBLIC :: InPoly PRIVATE :: PointSlope !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE ReadPoly(cdfront, kpoly, cdarea) !!--------------------------------------------------------------------- !! *** ROUTINE ReadPoly *** !! !! ** Purpose : read an ASCII file with names of polygon area !! and vertices. !! !! References : late 80's trigrid (Walters et Al.) !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in) :: cdfront ! Name of input file INTEGER(KIND=4), INTENT(out) :: kpoly ! number of poylgons CHARACTER(LEN=*), DIMENSION (:), INTENT(out) :: cdarea ! Name of the polygonal area INTEGER(KIND=4) :: jj ! dummy loop index INTEGER(KIND=4),DIMENSION(jpolys) :: ipac ! flag for Pacific area (across date line ) INTEGER(KIND=4) :: inum=8 ! logical unit for input file INTEGER(KIND=4) :: ipoly ! polygon counter INTEGER(KIND=4) :: ivert ! number of vertices of a polygon !!---------------------------------------------------------------------- OPEN (inum,FILE=cdfront) ipoly=0 ! DO WHILE (.TRUE.) ipoly=ipoly+1 READ(inum,'(a)',END=995) cdarea(ipoly) ! 1rst line of block : name of polygon READ(inum,*)nvertcnt(ipoly), ipac(ipoly) ! 2nd : number of vertices, ivert=nvertcnt(ipoly) READ(inum,*)(vertx(ipoly,jj),verty(ipoly,jj),jj=1,ivert) ! 3rd : (x,y) pairs foreach vertex ! take care of the date line for pacific zone IF (ipac(ipoly) == 1 ) THEN DO jj=1,ivert IF (vertx(ipoly,jj) < 0 ) vertx(ipoly,jj) = vertx(ipoly,jj) + 360. END DO ENDIF ! Automatically close the polygon vertx(ipoly,ivert+1)=vertx(ipoly,1) verty(ipoly,ivert+1)=verty(ipoly,1) ! add dummy 0.001 to integer vertex coordinates... to avoid singular problem DO jj=1, ivert+1 IF ( (vertx(ipoly, jj) - INT( vertx(ipoly, jj) ) ) == 0 ) vertx(ipoly, jj) = vertx(ipoly, jj)+0.001 IF ( (verty(ipoly, jj) - INT( verty(ipoly, jj) ) ) == 0 ) verty(ipoly, jj) = verty(ipoly, jj)+0.001 END DO ENDDO 995 kpoly=ipoly-1 CLOSE(inum) END SUBROUTINE ReadPoly SUBROUTINE PrepPoly ( kpolyid ) !!--------------------------------------------------------------------- !! *** ROUTINE PrepPoly *** !! !! ** Purpose : determine polygon information in preparation for !! a call to InPoly. !! !! ** Method : returns slope and equation of lines (ra, rc, rb) !! as well as the min/max of polygon coordinates !! !! References : Trigrid !!---------------------------------------------------------------------- INTEGER(KIND=4) ,INTENT(in) :: kpolyid ! polygon Id INTEGER(KIND=4) ji ! dummy loop index INTEGER(KIND=4) inumvert ! number of vertices for polygon kpolyid !!---------------------------------------------------------------------- ! - get slopes & line equations for each polygon boundary inumvert = nvertcnt(kpolyid) DO ji = 1, inumvert-1 CALL PointSlope ( slope(ji), vertx(kpolyid,ji), vertx(kpolyid,ji+1), & & verty(kpolyid,ji), verty(kpolyid,ji+1), & & ra(ji), rb(ji), rc(ji) ) END DO ! - ( ji = 1, inumvert-1 ) CALL PointSlope ( slope(inumvert), vertx(kpolyid,inumvert), vertx(kpolyid,1), & & verty(kpolyid,inumvert), verty(kpolyid,1), & & ra(inumvert), rb(inumvert), rc(inumvert) ) ! - calculate the max x,y's of polygon rmaxx = vertx(kpolyid,1) rmaxy = verty(kpolyid,1) DO ji = 1, inumvert IF (vertx(kpolyid,ji) > rmaxx) rmaxx = vertx(kpolyid,ji) IF (verty(kpolyid,ji) > rmaxy) rmaxy = verty(kpolyid,ji) END DO ! - calculate the min x,y's of polygon rminx = vertx(kpolyid,1) rminy = verty(kpolyid,1) DO ji = 1, inumvert IF (vertx(kpolyid,ji) < rminx) rminx = vertx(kpolyid,ji) IF (verty(kpolyid,ji) < rminy) rminy = verty(kpolyid,ji) END DO END SUBROUTINE PrepPoly SUBROUTINE InPoly ( kpolyid, pxpoint, pypoint, ld_in ) !!--------------------------------------------------------------------- !! *** ROUTINE InPoly *** !! !! ** Purpose : To see if a point is inside or outside of the specified !! polygon. !! !! ** Method : Use the equation of the side of the polygon to determine !! if a point is in (ld_in = true) or out (ld_in = false) !! !! References : Trigrid !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kpolyid ! Polygon ID REAL(KIND=4), INTENT(in) :: pxpoint, pypoint ! Position to check LOGICAL, INTENT(out) :: ld_in ! True if in the polygon INTEGER(KIND=4) :: ji INTEGER(KIND=4) :: icross, inumvert REAL(KIND=8) :: zxpt, zx, zy, zevenodd !!---------------------------------------------------------------------- inumvert = nvertcnt(kpolyid) ! - store coordinates of point to test zx = pxpoint zy = pypoint ! - get the number of cross with the polygon boundary icross = 0 ! - see if point falls in the max and min range of polygon IF ( zx <= rmaxx ) THEN IF ( zx >= rminx ) THEN IF ( zy <= rmaxy ) THEN IF ( zy >= rminy ) THEN ! - step through the polygon boundaries DO ji = 1, inumvert ! - see if slope = 9999 and if point is on same y axis IF ( slope(ji) == 9999 ) THEN IF ( zx >= vertx(kpolyid,ji) ) THEN IF ( ji == inumvert ) THEN IF ( ( (zy <= verty(kpolyid,inumvert) ) .AND. & & (zy > verty(kpolyid,1) ) ) .OR. & & ( (zy >= verty(kpolyid,inumvert) ) .AND. & & (zy < verty(kpolyid,1) ) ) ) THEN ! - it has crossed the polygon boundary icross = icross + 1 ! if (zy == 398) print *, zx, zy, icross ,'A', ji ENDIF ! ( zy test ) ELSEIF ( ( (zy <= verty(kpolyid,ji) ) .AND. & & (zy > verty(kpolyid,ji+1) ) ) .OR. & & ( (zy >= verty(kpolyid,ji) ) .AND. & & (zy < verty(kpolyid,ji+1) ) ) ) THEN ! - it has crossed the polygon boundary icross = icross + 1 ! if (zy == 398) print *, zx, zy, icross,'B', ji ENDIF ! ( ji = inumvert ) ENDIF ! ( zx >= vertx(kpolyid,ji) ) ! - see if normal slope (+ or -), and if point is not ! - higher or lower than y endpoints of the vertices ELSEIF ( slope(ji) .NE. 0 ) THEN zxpt = ( rc(ji) + zy ) / ra(ji) IF ( ji == inumvert ) THEN IF ( ( (zxpt <= vertx(kpolyid,inumvert) ) .AND. & & (zxpt > vertx(kpolyid,1) ) ) .OR. & & ( (zxpt >= vertx(kpolyid,inumvert) ) .AND. & & (zxpt < vertx(kpolyid,1) ) ) ) THEN IF ( zx >= zxpt) THEN ! - it has crossed the polygon boundary icross = icross + 1 ! if (zy == 398) print *, zx, zy, icross,'C', ji ENDIF ! ( zx >= zxpt ) ENDIF ! ( zxpt test ) ELSEIF ( ( (zxpt <= vertx(kpolyid,ji) ) .AND. & & (zxpt > vertx(kpolyid,ji+1) ) ) .OR. & & ( (zxpt >= vertx(kpolyid,ji) ) .AND. & & (zxpt < vertx(kpolyid,ji+1) ) ) ) THEN IF ( zx >= zxpt ) THEN ! - it has crossed the polygon boundary icross = icross + 1 ! if (zy == 398) print *, zx, zy, icross,'D', ji, slope(ji), zxpt ENDIF ! ( zx >= zxpt ) ENDIF ! ( ji = inumvert ) ENDIF ! ( zxpt test ) END DO ! ( ji = 1, inumvert ) ! - decide how many times scanline crossed poly bounds zevenodd = AMOD ( ( icross * 1.0 ), 2.0 ) IF ( zevenodd .NE. 0 ) THEN ! - point is in polygon ld_in = .TRUE. ELSE ld_in = .FALSE. ENDIF ! - ( zevenodd ne 0 ) ELSE ld_in = .FALSE. ENDIF ! - ( zy >= rminy ) ELSE ld_in = .FALSE. ENDIF ! - ( zy <= rmaxy ) ELSE ld_in = .FALSE. ENDIF ! - ( zx >= rminx ) ELSE ld_in = .FALSE. ENDIF ! - ( zx <= rmaxx ) END SUBROUTINE InPoly SUBROUTINE PointSlope ( pslup, pvertxa, pvertxb, pvertya, pvertyb, pax, pby, pcnstnt ) !!--------------------------------------------------------------------- !! *** ROUTINE PointSlope *** !! !! ** Purpose : To get the slope and general equations of lines. !! !! ** Method : GIVEN: vertxa, vertxb, vertya, vertyb = endpoints of line section !! to operate on. !! RETURNS: slup = slope of the line section !! ax, by, cnstnt = general eqation of the line section. !! !! References : trigrid !!---------------------------------------------------------------------- REAL(KIND=8), INTENT(out) :: pslup REAL(KIND=4), INTENT(in) :: pvertxa, pvertxb, pvertya, pvertyb REAL(KIND=8), INTENT(out) :: pax, pby, pcnstnt REAL(KIND=8) :: zvertxa, zvertxb, zvertya, zvertyb REAL(KIND=8) :: zrise, zrun !!---------------------------------------------------------------------- zvertxa = pvertxa ; zvertxb = pvertxb zvertya = pvertya ; zvertyb = pvertyb zrise = zvertyb - zvertya zrun = zvertxb - zvertxa IF ( zrun == 0 ) THEN pslup = 9999 ELSE pslup = zrise / zrun ENDIF IF ( ABS(pslup) <= 0.001 ) THEN pslup = 0.0 ENDIF IF ( pslup == 0 ) THEN pax = pslup pby = 1 pcnstnt = zvertya ELSEIF ( pslup == 9999 ) THEN pax = 1 pby = 0 pcnstnt = zvertxa ELSE pax = pslup pby = -1 pcnstnt = ( pslup * zvertxa - zvertya ) ENDIF END SUBROUTINE PointSlope END MODULE modpoly cdftools-3.0/cdfgeostrophy.f900000644000175000017500000003515512241227304017531 0ustar amckinstryamckinstryPROGRAM cdfgeostrophy !!====================================================================== !! *** PROGRAM cdfgeostrophy *** !!===================================================================== !! ** Purpose : Compute the ug and vg component of the geostrophic !! velocity from ssh and density field !! !! ** Method : * Integrate pressure from surface to current level !! P(n) = rho_insitu(1) * g * ssh !! + sum( rho_insitu(k) * g * h(k) ) k=1,n-1 !! + rho_insitu(n) * g * h(n) / 2 !! !! h = level thickness !! !! * Interpolation of Pressure on F points !! values on F-point are given !! by the demi-sum of X points (on the diagonal) !! !! p1 = 0.5 * ( A + B ) !! p1 = 0.5 * ( B + C ) !! p1 = 0.5 * ( C + D ) !! !! F--------F--------F--------F !! | | | | !! | | B | | !! | | | | !! F--------p1--V----p2-------F !! | | | | !! | A | Pi,j U C | !! | | | | !! F--------F--------p3-------F !! | | | | !! | | D | | !! | | | | !! F--------F--------F--------F !! !! * Compute local coriolis parameter at U and V point !! !! F--------F1--V----F2-------F !! | | | | !! | | Pij U | !! | | | | !! F--------F--------F3-------F !! !! Vg computation : Fij_v = 0.5 * ( F1 + F2 ) !! Ug computation : Fij_u = 0.5 * ( F2 + F3 ) !! !! * Compute geostrophic balance !! !! Vg(i,j) = +1 * ( 1 / rho0 * Fij_v ) * ( p2 - p1 ) / e1v(i,j) !! Ug(i,j) = -1 * ( 1 / rho0 * Fij_u ) * ( p2 - p3 ) / e2u(i,j) !! !! * Masking : !! !! - if A,B or C are land points -> Vg = 0 !! - if B,C or D are land points -> Ug = 0 !! - multiplied by umask and vmask !! - if f < 1e-5, we mask !! !! ** Note : Ug is located on a U grid point !! Vg V grid point !! !! !! History : 3.0 : 01/2011 : R.Dussin : original code !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jt ! dummy loop index INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: jk ! vertical index INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: ncoutu ! ncid for ugeo file INTEGER(KIND=4) :: ncoutv ! ncid for vgeo file INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4), DIMENSION(1) :: ipk ! levels of output vars INTEGER(KIND=4), DIMENSION(1) :: id_varoutu ! varid for ugeo INTEGER(KIND=4), DIMENSION(1) :: id_varoutv ! varid for vgeo REAL(KIND=4) :: grav ! gravity REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: deptht, depthw REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1u, e2v, ff ! horiz metrics, coriolis (f-point) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e2u ! horiz metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! vertic metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamu, gphiu ! longitude latitude u-point REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamv, gphiv ! longitude latitude v-point REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: umask, vmask ! mask at u and v points REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! mask at t points REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsigsurf ! density at first level (used for zpsurf) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsiglevel ! density at current level (used for zplevel/zphalflevel) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zt, zsal ! temporary arrays for temperature and salinity REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: un, vn ! velocity components REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: zsshn ! ssh REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: zpupper ! total pressure above current level REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: zphalflevel ! pressure at T-point of current level REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: zplevel ! pressure at bottom W-point of current level REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: zpsurf ! pressure due to SSH REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: zptot ! total pressure at current level REAL(KIND=4) :: zhlevel ! thickness of current level REAL(KIND=4) :: zhhalflevel ! thickness of half the current level REAL(KIND=4) :: zrho0 ! reference density in geos balance REAL(KIND=4) :: zohr0 ! reference density in geos balance REAL(KIND=4) :: zffu, zffv ! local coriolis parameter REAL(KIND=4) :: zp1, zp2 ! dummy for pressure interp REAL(KIND=4) :: zp3, zp4 ! dummy for pressure interp REAL(KIND=4) :: zumask, zvmask ! dummy for mask CHARACTER(LEN=256) :: cf_tfil ! input file name CHARACTER(LEN=256) :: cf_uout='ugeo.nc' CHARACTER(LEN=256) :: cf_vout='vgeo.nc' TYPE(variable), DIMENSION(1) :: stypvaru ! attributes for ugeo TYPE(variable), DIMENSION(1) :: stypvarv ! attributes for vgeo LOGICAL :: lchk ! file existence flag !!---------------------------------------------------------------------- CALL ReadCdfNames() grav = 9.81 ! gravity zrho0 = 1025 ! reference density zohr0 = 1. / zrho0 narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfgeostrophy T-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the geostrophic velocity component from the pressure gradient ' PRINT *,' computed from SSH and in-situ density (T,S of input file) ' PRINT *,' ' PRINT *,' WARNING : USE AT YOUR OWN RISKS' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with SSH, T and S.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fmsk),' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' - netcdf file : ', TRIM(cf_uout) PRINT *,' variables : ', TRIM(cn_vozocrtx) PRINT *,' - netcdf file : ', TRIM(cf_vout) PRINT *,' variables : ', TRIM(cn_vomecrty) STOP ENDIF CALL getarg(1, cf_tfil) lchk = chkfile(cn_fhgr) lchk = chkfile(cn_fzgr) .OR. lchk lchk = chkfile(cn_fmsk) .OR. lchk lchk = chkfile(cf_tfil) .OR. lchk IF ( lchk ) STOP ! missing file npiglo = getdim(cf_tfil, cn_x) npjglo = getdim(cf_tfil, cn_y) npk = getdim(cf_tfil, cn_z) npt = getdim(cf_tfil, cn_t) PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk ipk(1) = npk stypvaru(1)%cname = TRIM(cn_vozocrtx) stypvaru(1)%cunits = 'm/s' stypvaru(1)%rmissing_value = 0. stypvaru(1)%valid_min = -20. stypvaru(1)%valid_max = 20. stypvaru(1)%clong_name = 'Zonal_Geostrophic_Velocity' stypvaru(1)%cshort_name = TRIM(cn_vozocrtx) stypvaru(1)%conline_operation = 'N/A' stypvaru(1)%caxis = 'TZYX' stypvarv(1)%cname = TRIM(cn_vomecrty) stypvarv(1)%cunits = 'm/s' stypvarv(1)%rmissing_value = 0. stypvarv(1)%valid_min = -20. stypvarv(1)%valid_max = 20. stypvarv(1)%clong_name = 'Meridional_Geostrophic_Velocity' stypvarv(1)%cshort_name = TRIM(cn_vomecrty) stypvarv(1)%conline_operation = 'N/A' stypvarv(1)%caxis = 'TZYX' ! Allocate the memory ALLOCATE ( e1v(npiglo,npjglo), e2u(npiglo,npjglo) ) ALLOCATE ( ff(npiglo,npjglo) ) ALLOCATE ( glamu(npiglo,npjglo), gphiu(npiglo,npjglo) ) ALLOCATE ( glamv(npiglo,npjglo), gphiv(npiglo,npjglo) ) ALLOCATE ( un(npiglo,npjglo), vn(npiglo,npjglo) ) ALLOCATE ( zsshn(npiglo,npjglo) ) ALLOCATE ( umask(npiglo,npjglo), vmask(npiglo,npjglo) ) ALLOCATE ( tmask(npiglo,npjglo) ) ALLOCATE ( zpupper(npiglo,npjglo), zpsurf(npiglo,npjglo) ) ALLOCATE ( zphalflevel(npiglo,npjglo), zplevel(npiglo,npjglo) ) ALLOCATE ( zptot(npiglo,npjglo) ) ALLOCATE ( zt(npiglo,npjglo), zsal(npiglo,npjglo) ) ALLOCATE ( deptht(npk), depthw(npk) ) ALLOCATE ( zsigsurf(npiglo,npjglo) , zsiglevel(npiglo,npjglo) ) ALLOCATE ( e3(npiglo,npjglo) ) ALLOCATE ( tim(npt) ) ! Read the metrics from the mesh_hgr file e2u = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo) e1v = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo) ff = getvar(cn_fhgr, cn_vff, 1, npiglo, npjglo) glamu = getvar(cn_fhgr, cn_glamu, 1, npiglo, npjglo) gphiu = getvar(cn_fhgr, cn_gphiu, 1, npiglo, npjglo) glamv = getvar(cn_fhgr, cn_glamv, 1, npiglo, npjglo) gphiv = getvar(cn_fhgr, cn_gphiv, 1, npiglo, npjglo) deptht(:) = getvar1d(cf_tfil, cn_vdeptht, npk ) ! create output filesets ! U geo ncoutu = create (cf_uout, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncoutu, stypvaru, 1, ipk, id_varoutu ) ierr = putheadervar(ncoutu, cf_tfil, npiglo, npjglo, npk, pnavlon=glamu, pnavlat=gphiu) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncoutu, tim, npt, 'T') ! V geo ncoutv = create (cf_vout, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncoutv, stypvarv, 1, ipk, id_varoutv ) ierr = putheadervar(ncoutv, cf_tfil, npiglo, npjglo, npk, pnavlon=glamv, pnavlat=gphiv) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncoutv, tim, npt, 'T') ! time loop DO jt=1,npt ! Read ssh zsshn = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo, ktime=jt) ! Read temperature and salinity zt = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt) zsal = getvar(cf_tfil, cn_vosaline, 1, npiglo, npjglo, ktime=jt) ! Compute density at first level zsigsurf(:,:) = 1000. + sigmai ( zt,zsal,deptht(1),npiglo,npjglo ) ! Compute psurf (pressure due to SSH) zpsurf(:,:) = zsigsurf * grav * zsshn zpupper(:,:) = 0.d0 DO jk=1,npk tmask = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo) umask = getvar(cn_fmsk, 'umask', jk, npiglo, npjglo) vmask = getvar(cn_fmsk, 'vmask', jk, npiglo, npjglo) PRINT *,'Working on level ', jk !! 1. First we compute integrated pressure from the surface to current level ! Thickness e3 = getvar(cn_fzgr, cn_ve3t, jk, npiglo, npjglo) ! MAXVAL is used to avoid partial steps zhlevel = MAXVAL(e3) zhhalflevel = 0.5 * MAXVAL(e3) ! !PRINT *,' At level ', jk, ' thickness is ', zhlevel ! Read temperature and salinity at current level zt = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zsal = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) ! Compute density of this level zsiglevel(:,:) = 1000. + sigmai ( zt,zsal,deptht(jk),npiglo,npjglo ) ! Compute the pressure at T-point zphalflevel(:,:) = zsiglevel * grav * zhhalflevel ! Compute the pressure at bottom W-point zplevel(:,:) = zsiglevel * grav * zhlevel ! Compute the total pression -> This one is used in the geostrophic balance ! zptot(:,:) = zpsurf(:,:) + zpupper(:,:) + zphalflevel(:,:) ! update zpupper for next level zpupper(:,:) = zpupper(:,:) + zplevel(:,:) !! 2. We compute the velocities from geostrophic balance un(:,:) = 0.d0 vn(:,:) = 0.d0 DO jj=2,npjglo-1 DO ji=2,npiglo-1 ! local coriolis parameter zffu = 0.5 * ( ff(ji,jj) + ff(ji,jj-1) ) zffv = 0.5 * ( ff(ji,jj) + ff(ji-1,jj) ) ! interp on F points zp1 = 0.5 * ( zptot(ji-1,jj) + zptot(ji,jj+1) ) zp2 = 0.5 * ( zptot(ji+1,jj) + zptot(ji,jj+1) ) zp3 = 0.5 * ( zptot(ji,jj-1) + zptot(ji+1,jj) ) zumask = tmask(ji,jj-1) * tmask(ji+1,jj) * tmask(ji,jj+1) zvmask = tmask(ji-1,jj) * tmask(ji,jj+1) * tmask(ji+1,jj) ! geostrophic balance vn(ji,jj) = +1 * ( zohr0 / zffv ) * ( zp2 - zp1 ) / e1v(ji,jj) un(ji,jj) = -1 * ( zohr0 / zffu ) * ( zp2 - zp3 ) / e2u(ji,jj) vn(ji,jj) = vn(ji,jj) * zvmask un(ji,jj) = un(ji,jj) * zumask ENDDO ENDDO WHERE ( ABS(ff) < 1.e-5 ) un(:,:) = 0.d0 WHERE ( ABS(ff) < 1.e-5 ) vn(:,:) = 0.d0 un(:,:) = un(:,:) * umask(:,:) vn(:,:) = vn(:,:) * vmask(:,:) ! write un and vn ... ierr = putvar(ncoutu, id_varoutu(1), un(:,:), jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncoutv, id_varoutv(1), vn(:,:), jk, npiglo, npjglo, ktime=jt) ENDDO ! vertical loop END DO ! time loop ierr = closeout(ncoutu) ierr = closeout(ncoutv) END PROGRAM cdfgeostrophy cdftools-3.0/cdfnrjcomp.f900000644000175000017500000001735312241227304016776 0ustar amckinstryamckinstryPROGRAM cdfnrjcomp !!====================================================================== !! *** PROGRAM cdfnrjcomp *** !!===================================================================== !! ** Purpose : Compute the terms for energy components !! (Mean Kinetic Energy, Eddy Kinetic Energy, !! Mean Potential Energy, Eddy Potential Energy ) !! compute : tbar, ubar, vbar, anotsqrt, anousqrt, anovsqrt !! !! History : 2.1 : 02/2008 : A. Melet : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index INTEGER(KIND=4) :: npiglo, npjglo ! domain size INTEGER(KIND=4) :: npk, npt ! domain size INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(6) :: ipk, id_varout ! level and varid's of output var REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn, u2n, v2n REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tn, t2n, anotsqrt REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: umask, vmask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: anousqrt, anovsqrt REAL(KIND=4), DIMENSION(1) :: tim ! time counter CHARACTER(LEN=256) :: cf_in ! input filename CHARACTER(LEN=256) :: cf_out='nrjcomp.nc' ! output file name TYPE (variable), DIMENSION(6) :: stypvar ! structure for attibutes !!---------------------------------------------------------------------- CALL ReadCdfNames() !! narg = iargc() IF ( narg /= 1 ) THEN PRINT *,' usage : cdfnrjcomp IN-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute contributing terms of the energy equation at T-points.' PRINT *,' Input file contains mean values processed by cdfmoyuvwt.' PRINT *,' The means must have been computed on long enough period' PRINT *,' for the statistics to be meaningful' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : netcdf file produced by cdfmoyuvwt.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' all variables are located at T point.' PRINT *,' variables : tbar : mean temperature ' PRINT *,' ubar : mean zonal velocity' PRINT *,' vbar : mean meridional velocity' PRINT *,' anotsqrt : mean squared temperature anomaly' PRINT *,' anousqrt : mean squared zonal velocity anomaly' PRINT *,' anovsqrt : mean squared meridional velocity anomaly' STOP ENDIF CALL getarg(1, cf_in) IF ( chkfile(cf_in) ) STOP ! missing file npiglo = getdim(cf_in,cn_x) npjglo = getdim(cf_in,cn_y) npk = getdim(cf_in,cn_z) npt = getdim(cf_in,cn_t) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! define new variables for output ipk(:) = npk stypvar(1)%cname = 'tbar' stypvar(1)%clong_name = 'temporal mean of the temperature on T point' stypvar(1)%cshort_name = 'tbar' stypvar(2)%cname = 'ubar' stypvar(2)%clong_name = 'temporal mean of the zonal velocity on T point' stypvar(2)%cshort_name = 'ubar' stypvar(3)%cname = 'vbar' stypvar(3)%clong_name = 'temporal mean of the meridional velocity on T point' stypvar(3)%cshort_name = 'vbar' stypvar(4)%cname = 'anotsqrt' stypvar(4)%clong_name = 'temporal mean of the square of the temperature anomaly on T point (*1000)' stypvar(4)%cshort_name = 'anotsqrt' stypvar(5)%cname = 'anousqrt' stypvar(5)%clong_name = 'temporal mean of the square of the zonal speed anomaly on T point (*1000)' stypvar(5)%cshort_name = 'anousqrt' stypvar(6)%cname = 'anovsqrt' stypvar(6)%clong_name = 'temporal mean of the square of the meridional speed anomaly on T point (*1000)' stypvar(6)%cshort_name = 'anovsqrt' stypvar%cunits = ' ' stypvar%rmissing_value = 0. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TZYX' ! create output fileset ncout = create (cf_out, cf_in, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 6, ipk, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk ) ! Allocate the memory ALLOCATE ( un(npiglo,npjglo), vn(npiglo,npjglo) ) ALLOCATE ( umask(npiglo,npjglo), vmask(npiglo,npjglo) ) ALLOCATE ( u2n(npiglo,npjglo), v2n(npiglo,npjglo) ) ALLOCATE ( anousqrt(npiglo,npjglo), anovsqrt(npiglo,npjglo) ) ALLOCATE ( tn(npiglo,npjglo), t2n(npiglo,npjglo) ) ALLOCATE ( anotsqrt(npiglo,npjglo) ) tim = getvar1d(cf_in,cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jk=1, npk PRINT *,' level ',jk anousqrt(:,:) = 0.0 anovsqrt(:,:) = 0.0 anotsqrt(:,:) = 0.0 un(:,:) = getvar(cf_in, 'ubar', jk, npiglo, npjglo, ktime=1) vn(:,:) = getvar(cf_in, 'vbar', jk, npiglo, npjglo, ktime=1) u2n(:,:) = getvar(cf_in, 'u2bar', jk, npiglo, npjglo, ktime=1) v2n(:,:) = getvar(cf_in, 'v2bar', jk, npiglo, npjglo, ktime=1) tn(:,:) = getvar(cf_in, 'tbar', jk, npiglo, npjglo, ktime=1) t2n(:,:) = getvar(cf_in, 't2bar', jk, npiglo, npjglo, ktime=1) ! compute the mask DO jj = 2, npjglo DO ji = 2, npiglo umask(ji,jj) = 0. vmask(ji,jj) = 0. umask(ji,jj) = un(ji,jj)*un(ji-1,jj) vmask(ji,jj) = vn(ji,jj)*vn(ji,jj-1) IF (umask(ji,jj) /= 0.) umask(ji,jj)=1. IF (vmask(ji,jj) /= 0.) vmask(ji,jj)=1. ENDDO ENDDO DO jj = 2, npjglo DO ji = 2, npiglo ! vector opt. anotsqrt(ji,jj) = 1000. * ( t2n(ji,jj) - tn(ji,jj) * tn(ji,jj) ) anousqrt(ji,jj) = 1000./2. * umask(ji,jj)*( ( u2n(ji,jj) - un(ji,jj)*un(ji,jj) ) & & + ( u2n(ji-1,jj) - un(ji-1,jj)*un(ji-1,jj) ) ) anovsqrt(ji,jj) = 1000./2. * vmask(ji,jj)*( ( v2n(ji,jj) - vn(ji,jj)*vn(ji,jj) ) & & + ( v2n(ji,jj-1) - vn(ji,jj)*vn(ji,jj-1) ) ) END DO END DO ! ierr = putvar(ncout, id_varout(1), tn, jk, npiglo, npjglo, ktime=1) ierr = putvar(ncout, id_varout(2), un, jk, npiglo, npjglo, ktime=1) ierr = putvar(ncout, id_varout(3), vn, jk, npiglo, npjglo, ktime=1) ierr = putvar(ncout, id_varout(4), anotsqrt, jk, npiglo, npjglo, ktime=1) ierr = putvar(ncout, id_varout(5), anousqrt, jk, npiglo, npjglo, ktime=1) ierr = putvar(ncout, id_varout(6), anovsqrt, jk, npiglo, npjglo, ktime=1) END DO ierr = closeout(ncout) END PROGRAM cdfnrjcomp cdftools-3.0/cdfmkmask.f900000644000175000017500000003520112241227304016601 0ustar amckinstryamckinstryPROGRAM cdfmkmask !!====================================================================== !! *** PROGRAM cdfmkmask *** !!===================================================================== !! ** Purpose : Build mask file from a salinity output !! !! ** Method : Read vosaline and set tmask to 1 where sal is not 0 !! then umask, vmask and fmask are deduced from tmask !! REM: the result may be locally different for fmask than !! fmask produced online as there are computed on line !! merged with cdfmkmask-zone by adding a zoom option. When !! used with -zoom option, the mask is 0 outside the zoom !! area. !! !! History : 2.1 : 11/2005 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !! Modified : 3.0 : 08/2011 : P. Mathiot : Add zoomij, zoombat, zoomvar and time option !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! INTEGER(KIND=4) :: npiglo, npjglo, npk, nt ! size of the domain INTEGER(KIND=4) :: iimin, iimax ! limit in i INTEGER(KIND=4) :: ijmin, ijmax ! limit in j INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout ! outptut variables : number of levels, INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mbathy ! bathymetry in levels REAL(KIND=4) :: rlonmin, rlonmax ! limit in longitude REAL(KIND=4) :: rlatmin, rlatmax ! limit in latitude REAL(KIND=4) :: rbatmin, rbatmax ! limit in latitude REAL(KIND=4) :: rvarmin, rvarmax ! limit in variable REAL(KIND=4), DIMENSION(:) , ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:) , ALLOCATABLE :: rdep ! depth REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask, zmask ! 2D mask at current level REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rlon, rlat ! latitude and longitude REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rbat ! bathymetry CHARACTER(LEN=256) :: cf_tfil ! file name CHARACTER(LEN=256) :: cf_out = 'mask_sal.nc' ! output file CHARACTER(LEN=256) :: cv_mask ! variable name CHARACTER(LEN=256) :: cv_dep ! variable name CHARACTER(LEN=256) :: cldum ! dummy string TYPE (variable), DIMENSION(4) :: stypvar ! output attribute LOGICAL :: lzoom = .false. ! zoom flag lat/lon LOGICAL :: lzoomij = .false. ! zoom flag i/j LOGICAL :: lzoombat = .false. ! zoom flag bat LOGICAL :: lzoomvar = .false. ! zoom flag var LOGICAL :: ltime = .false. ! time flag LOGICAL :: lmbathy = .false. ! mbathy flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmkmask T-file [-zoom lonmin lonmax latmin latmax] ...' PRINT *,' ... [-zoomij iimin iimax ijmin ijmax] ...' PRINT *,' ... [-zoombat bathymin bathymax] ...' PRINT *,' ... [-o OUT-file ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Build a mask file from vosaline array read from the input file.' PRINT *,' It assumes that land salinity values are set to 0.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with salinity.' PRINT *,' if T-file = -maskfile, we assume a reference file named ',TRIM(cn_fmsk) PRINT *,' with tmask variable.' PRINT *,' if T-file = -mbathy, we assume a reference file named ' PRINT *,' bathylevel.nc with mbathy variable, giving the number of ' PRINT *,' levels in the ocean.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-zoom lonmin lonmax latmin latmax] : geographical windows used to' PRINT *,' limit the area where the mask is builded. Outside' PRINT *,' this area, the mask is set to 0.' PRINT *,' [-zoomij iimin iimax ijmin ijmax] : model grid windows used to' PRINT *,' limit the area where the mask is builded. Outside' PRINT *,' this area, the mask is set to 0.' PRINT *,' [-zoombat bathymin bathymax] : depth windows used to' PRINT *,' limit the area where the mask is builded. Outside' PRINT *,' this area, the mask is set to 0.' PRINT *,' Need mesh_zgr.nc' PRINT *,' [-zoomvar varname varmin varmax] : range of varname used to' PRINT *,' limit the area where the mask is builded. Outside' PRINT *,' this area, the mask is set to 0.' PRINT *,' [-time ] : If further time step is available' PRINT *,' a mask for each time step is done' PRINT *,' [-o OUT-file ] : output file name to be used in place of standard' PRINT *,' name [ ',TRIM(cf_out),' ]' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' If option -zoombat is used, file ', TRIM(cn_fzgr),' is required.' PRINT *,' If option T-file is -maskfile then ', TRIM(cn_fmsk), ' is required.' PRINT *,' If option T-file is -mbathy then bathylevel.nc and ', TRIM(cn_fzgr) PRINT *,' are required.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out), ' or OUT-file.' PRINT *,' variables : tmask, umask, vmask, fmask' PRINT *,' fmask can differ from standard fmask because it does not' PRINT *,' reflect the slip/noslip lateral condition.' STOP ENDIF ijarg = 1 CALL getarg (ijarg, cf_tfil) ; ijarg = ijarg + 1 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) ! CASE ( '-zoom' ) ! read a zoom lat/lon area lzoom = .true. CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rlonmin CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rlonmax CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rlatmin CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rlatmax ! CASE ( '-zoomij' ) ! read a zoom i/j area lzoomij = .true. CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimin CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax ! CASE ( '-zoombat' ) ! read a zoom bathy area lzoombat = .true. CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rbatmin CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rbatmax ! CASE ( '-zoomvar' ) ! read a zoom variable area lzoomvar = .true. CALL getarg (ijarg, cv_mask) ; ijarg = ijarg + 1 ; CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rvarmin CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rvarmax CASE ( '-time' ) ! create a mask for each time step of the file ltime=.true. CASE ( '-o' ) ! change output file name CALL getarg (ijarg, cf_out) ; ijarg = ijarg + 1 ! CASE DEFAULT PRINT *, 'ERROR : unknown option :', TRIM(cldum) STOP END SELECT ENDDO IF ( lzoom .AND. lzoomij ) PRINT *, 'WARNING 2 spatial condition for mask' IF (.NOT. lzoomvar) cv_mask = cn_vosaline IF (TRIM(cf_tfil)=='-maskfile') THEN cv_mask = 'tmask' cf_tfil = cn_fmsk cn_z = 'z' END IF IF (TRIM(cf_tfil)=='-mbathy') THEN cv_mask = 'mbathy' cv_dep = 'nav_lev' cf_tfil = 'bathylevel.nc' cn_z = 'z' lmbathy = .TRUE. IF ( chkfile(cn_fzgr) ) STOP ! missing file END IF IF ( chkfile(cf_tfil) ) STOP ! missing file npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) IF ( lmbathy ) THEN npk = getdim (cn_fzgr,cn_z) ALLOCATE ( rdep(npk) ) ELSE npk = getdim (cf_tfil,cn_z) ENDIF nt = getdim (cf_tfil,cn_t) PRINT *,' npiglo = ', npiglo PRINT *,' npjglo = ', npjglo PRINT *,' npk = ', npk PRINT *,' nt = ', nt IF ( nt == 0 ) THEN PRINT *,' nt is forced to 1' nt = 1 ENDIF IF ((nt > 1) .AND. (.NOT. ltime)) THEN PRINT *, "WARNING nt > 1" PRINT *, "we used only the first time step" nt=1 END IF ipk(1:4) = npk stypvar(1)%cname = 'tmask' stypvar(2)%cname = 'umask' stypvar(3)%cname = 'vmask' stypvar(4)%cname = 'fmask' stypvar(1:4)%cunits = '1/0' stypvar(1:4)%rmissing_value = 9999. stypvar(1:4)%valid_min = 0. stypvar(1:4)%valid_max = 1. stypvar(1)%clong_name = 'tmask' stypvar(2)%clong_name = 'umask' stypvar(3)%clong_name = 'vmask' stypvar(4)%clong_name = 'fmask' stypvar(1)%cshort_name = 'tmask' stypvar(2)%cshort_name = 'umask' stypvar(3)%cshort_name = 'vmask' stypvar(4)%cshort_name = 'fmask' stypvar(1:4)%conline_operation = 'N/A' stypvar(1:4)%caxis = 'TZYX' stypvar(1:4)%cprecision = 'i2' ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk) ierr = createvar (ncout, stypvar, 4, ipk, id_varout ) IF ( lmbathy ) THEN rdep(:) = getvare3(cn_fzgr, cv_dep ,npk) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk, pdep=rdep, cdep='nav_lev') ELSE ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk) ENDIF !! Allocate only usefull variable and read only usefull variable ALLOCATE (tmask(npiglo,npjglo), zmask(npiglo,npjglo), tim(nt)) IF ( lmbathy ) THEN ALLOCATE (mbathy(npiglo,npjglo)) ENDIF IF ( lzoom ) THEN ALLOCATE (rlon(npiglo,npjglo), rlat(npiglo,npjglo)) rlon(:,:) = getvar(cf_tfil, cn_vlon2d, 1, npiglo, npjglo) rlat(:,:) = getvar(cf_tfil, cn_vlat2d, 1, npiglo, npjglo) ENDIF IF ( lzoombat ) THEN IF ( chkfile(cn_fzgr) ) STOP ! missing file ALLOCATE ( rbat (npiglo,npjglo) ) rbat(:,:)= getvar(cn_fzgr, cn_hdepw, 1 ,npiglo, npjglo) END IF IF ( lmbathy ) THEN mbathy(:,:) = getvar(cf_tfil, cv_mask, 1, npiglo, npjglo) ENDIF !! Now compute the mask DO jt=1, nt IF (MOD(jt,10)==0) PRINT *,jt,'/',nt,' ...' DO jk=1, npk ! tmask IF ( lmbathy ) THEN tmask(:,:) = 1. WHERE (mbathy < jk ) tmask = 0. ELSE tmask(:,:) = getvar(cf_tfil, cv_mask, jk, npiglo, npjglo, ktime=jt) ENDIF IF ( lzoomvar ) THEN zmask=tmask WHERE ((tmask .GE. rvarmin) .AND. (tmask .LE. rvarmax)) zmask = 1 WHERE ((tmask .LT. rvarmin) .OR. (tmask .GT. rvarmax)) zmask = 0 tmask=zmask ELSE WHERE (tmask > 0 ) tmask = 1 WHERE (tmask <=0 ) tmask = 0 ENDIF IF ( lzoom ) THEN IF (rlonmax > rlonmin) THEN WHERE (rlon > rlonmax ) tmask = 0 WHERE (rlon < rlonmin ) tmask = 0 ELSE WHERE (rlon < rlonmin .AND. rlon > rlonmax ) tmask = 0 END IF WHERE (rlat > rlatmax ) tmask = 0 WHERE (rlat < rlatmin ) tmask = 0 ENDIF IF ( lzoomij ) THEN tmask(1:iimin-1,: ) = 0 ! West tmask(iimax+1:npiglo,:) = 0 ! East tmask(:,ijmax+1:npjglo) = 0 ! North tmask(:,1:ijmin-1 ) = 0 ! South ENDIF IF ( lzoombat ) THEN WHERE (rbat < rbatmin .OR. rbat > rbatmax) tmask = 0 ENDIF ierr = putvar(ncout, id_varout(1), tmask, jk ,npiglo, npjglo, ktime=jt) ! umask zmask = 0. DO ji=1,npiglo-1 DO jj=1,npjglo zmask(ji,jj) = tmask(ji,jj)*tmask(ji+1,jj) END DO END DO ierr = putvar(ncout, id_varout(2), zmask, jk ,npiglo, npjglo, ktime=jt) ! vmask zmask=0. DO ji=1,npiglo DO jj=1,npjglo-1 zmask(ji,jj) = tmask(ji,jj)*tmask(ji,jj+1) END DO END DO ierr = putvar(ncout, id_varout(3), zmask, jk, npiglo, npjglo, ktime=jt) !fmask zmask=0. DO ji=1,npiglo-1 DO jj=1,npjglo-1 zmask(ji,jj) = tmask(ji,jj)*tmask(ji,jj+1)*tmask(ji+1,jj)*tmask(ji+1,jj+1) END DO END DO ierr = putvar(ncout, id_varout(4), zmask, jk, npiglo, npjglo, ktime=jt) END DO ! loop to next level END DO tim(:) = 0. ierr = putvar1d(ncout, tim, nt,'T') ierr = closeout(ncout ) PRINT *,'' PRINT *,'Mask file ',TRIM(cf_out),' has been created' END PROGRAM cdfmkmask cdftools-3.0/cdfgeo-uv.f900000644000175000017500000002201112241227304016513 0ustar amckinstryamckinstryPROGRAM cdfgeo_uv !!====================================================================== !! *** PROGRAM cdfgeo_uv *** !!===================================================================== !! ** Purpose : Compute the ug and vg component of the geostrophic !! velocity from the SSH field !! !! ** Method : ug = -g/f * d(ssh)/dy !! vg = g/f * d(ssh)/dx !! !! ** Note : ug is located on a V grid point !! vg U grid point !! !! !! History : 2.1 : 02/2008 : J. Juanno : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. and bug fix !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jt ! dummy loop index INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: ncoutu ! ncid for ugeo file INTEGER(KIND=4) :: ncoutv ! ncid for vgeo file INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4), DIMENSION(1) :: ipk ! levels of output vars INTEGER(KIND=4), DIMENSION(1) :: id_varoutu ! varid for ugeo INTEGER(KIND=4), DIMENSION(1) :: id_varoutv ! varid for vgeo REAL(KIND=4) :: grav ! gravity REAL(KIND=4) :: ffu, ffv ! coriolis param f at U and V point REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1u, e2v, ff ! horiz metrics, coriolis (f-point) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamu, gphiu ! longitude latitude u-point REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamv, gphiv ! longitude latitude v-point REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn ! velocity components REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsshn ! ssh REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: umask, vmask ! mask at u and v points CHARACTER(LEN=256) :: cf_tfil ! input file name CHARACTER(LEN=256) :: cf_uout='ugeo.nc' CHARACTER(LEN=256) :: cf_vout='vgeo.nc' TYPE(variable), DIMENSION(1) :: stypvaru ! attributes for ugeo TYPE(variable), DIMENSION(1) :: stypvarv ! attributes for vgeo LOGICAL :: lchk ! file existence flag !!---------------------------------------------------------------------- CALL ReadCdfNames() grav = 9.81 ! gravity narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfgeo-uv T-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the geostrophic velocity component from the gradient ' PRINT *,' of the SSH read in the input file. Note that in the C-grid ' PRINT *,' output file, the zonal component is located on V point and the' PRINT *,' meridional component is located on U point.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with SSH.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' - netcdf file : ', TRIM(cf_uout) PRINT *,' variables : ', TRIM(cn_vozocrtx) PRINT *,' *** CAUTION: this variable is located on V-point ***' PRINT *,' - netcdf file : ', TRIM(cf_vout) PRINT *,' variables : ', TRIM(cn_vomecrty) PRINT *,' *** CAUTION: this variable is located on U-point ***' STOP ENDIF CALL getarg(1, cf_tfil) lchk = chkfile(cn_fhgr) lchk = chkfile(cn_fzgr) .OR. lchk lchk = chkfile(cf_tfil) .OR. lchk IF ( lchk ) STOP ! missing file npiglo = getdim(cf_tfil, cn_x) npjglo = getdim(cf_tfil, cn_y) npk = getdim(cf_tfil, cn_z) npt = getdim(cf_tfil, cn_t) PRINT *, ' NPIGLO= ', npiglo PRINT *, ' NPJGLO= ', npjglo PRINT *, ' NPK = ', npk PRINT *, ' NPT = ', npt ipk(1) = 1 stypvaru(1)%cname = TRIM(cn_vozocrtx) stypvaru(1)%cunits = 'm/s' stypvaru(1)%rmissing_value = 0. stypvaru(1)%valid_min = 0. stypvaru(1)%valid_max = 20. stypvaru(1)%clong_name = 'Zonal_Geostrophic_Velocity' stypvaru(1)%cshort_name = TRIM(cn_vozocrtx) stypvaru(1)%conline_operation = 'N/A' stypvaru(1)%caxis = 'TYX' stypvarv(1)%cname = TRIM(cn_vomecrty) stypvarv(1)%cunits = 'm/s' stypvarv(1)%rmissing_value = 0. stypvarv(1)%valid_min = 0. stypvarv(1)%valid_max = 20. stypvarv(1)%clong_name = 'Meridional_Geostrophic_Velocity' stypvarv(1)%cshort_name = TRIM(cn_vomecrty) stypvarv(1)%conline_operation = 'N/A' stypvarv(1)%caxis = 'TYX' ! Allocate the memory ALLOCATE ( e1u(npiglo,npjglo), e2v(npiglo,npjglo) ) ALLOCATE ( ff(npiglo,npjglo), tim(npt) ) ALLOCATE ( glamu(npiglo,npjglo), gphiu(npiglo,npjglo) ) ALLOCATE ( glamv(npiglo,npjglo), gphiv(npiglo,npjglo) ) ALLOCATE ( un(npiglo,npjglo), vn(npiglo,npjglo) ) ALLOCATE ( zsshn(npiglo,npjglo) ) ALLOCATE ( umask(npiglo,npjglo), vmask(npiglo,npjglo) ) ! Read the metrics from the mesh_hgr file e2v = getvar(cn_fhgr, cn_ve2v, 1, npiglo, npjglo) e1u = getvar(cn_fhgr, cn_ve1u, 1, npiglo, npjglo) ff = getvar(cn_fhgr, cn_vff, 1, npiglo, npjglo) glamu = getvar(cn_fhgr, cn_glamu, 1, npiglo, npjglo) gphiu = getvar(cn_fhgr, cn_gphiu, 1, npiglo, npjglo) glamv = getvar(cn_fhgr, cn_glamv, 1, npiglo, npjglo) gphiv = getvar(cn_fhgr, cn_gphiv, 1, npiglo, npjglo) ! create output filesets ! U geo ! @ V-point ! ncoutu = create (cf_uout, cf_tfil, npiglo, npjglo, 0 ) ierr = createvar (ncoutu, stypvaru, 1, ipk, id_varoutu ) ierr = putheadervar(ncoutu, cf_tfil, npiglo, npjglo, 0, pnavlon=glamv, pnavlat=gphiv) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncoutu, tim, npt, 'T') ! V geo ! @ U-point ! ncoutv = create (cf_vout, cf_tfil, npiglo, npjglo, 0 ) ierr = createvar (ncoutv, stypvarv, 1, ipk, id_varoutv ) ierr = putheadervar(ncoutv, cf_tfil, npiglo, npjglo, 0, pnavlon=glamu, pnavlat=gphiu) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncoutv, tim, npt, 'T') ! Read ssh DO jt=1,npt zsshn = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo, ktime=jt) IF ( jt == 1 ) THEN ! compute the masks umask=0. ; vmask = 0 DO jj = 1, npjglo DO ji = 1, npiglo - 1 umask(ji,jj) = zsshn(ji,jj)*zsshn(ji+1,jj) IF (umask(ji,jj) /= 0.) umask(ji,jj) = 1. END DO END DO DO jj = 1, npjglo - 1 DO ji = 1, npiglo vmask(ji,jj) = zsshn(ji,jj)*zsshn(ji,jj+1) IF (vmask(ji,jj) /= 0.) vmask(ji,jj) = 1. END DO END DO ! e1u and e1v are modified to simplify the computation below ! note that geostrophy is not available near the equator ( f=0) DO jj=2, npjglo - 1 DO ji=2, npiglo - 1 ffu = ff(ji,jj) + ff(ji, jj-1) IF ( ffu /= 0. ) THEN e1u(ji,jj)= 2.* grav * umask(ji,jj) / ( ffu ) / e1u(ji,jj) ELSE e1u(ji,jj)= 0. ! spvalue ENDIF ffv = ff(ji,jj) + ff(ji-1,jj ) IF ( ffv /= 0. ) THEN e2v(ji,jj)= 2.* grav * vmask(ji,jj) / ( ffv ) / e2v(ji,jj) ELSE e2v(ji,jj)= 0. ! spvalue ENDIF END DO END DO END IF ! Calculation of geostrophic velocity : un(:,:) = 0. vn(:,:) = 0. DO jj = 2,npjglo - 1 DO ji = 2,npiglo -1 vn(ji,jj) = e1u(ji,jj) * ( zsshn(ji+1,jj ) - zsshn(ji,jj) ) un(ji,jj) = e2v(ji,jj) * ( zsshn(ji ,jj+1) - zsshn(ji,jj) ) END DO END DO ! write un and vn ... ierr = putvar(ncoutu, id_varoutu(1), un(:,:), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncoutv, id_varoutv(1), vn(:,:), 1, npiglo, npjglo, ktime=jt) END DO ! time loop ierr = closeout(ncoutu) ierr = closeout(ncoutv) END PROGRAM cdfgeo_uv cdftools-3.0/cdfmxlheatc.f900000644000175000017500000001662512241227304017134 0ustar amckinstryamckinstryPROGRAM cdfmxlheatc !!====================================================================== !! *** PROGRAM cdfmxlheatc *** !!===================================================================== !! ** Purpose : Compute the heat content in the mixed layer. Work for !! partial steps (default) or full step (-full option) !! !! ** Method : compute the sum ( rho cp T * e1 *e2 * e3 *mask ) !! for the mixed layer stored into gridT file !! !! History : 2.1 : 04/2006 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames USE modutils !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: narg, iargc, ijarg ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain, INTEGER(KIND=4) :: ncout, ierr ! ncid and error status INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vars REAL(KIND=4), PARAMETER :: rprho0=1020. ! rho reference density REAL(KIND=4), PARAMETER :: rpcp=4000. ! calorific capacity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zt ! temperature in the MXL REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmxl ! depth of the MXL REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! vertical levels REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metric full REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth output REAL(KIND=8) :: dvol ! total volume REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmxlheatc ! heat content CHARACTER(LEN=256) :: cf_tfil ! input file name CHARACTER(LEN=256) :: cf_out='mxlheatc.nc'! output file CHARACTER(LEN=256) :: cv_out='somxlheatc' ! output file CHARACTER(LEN=256) :: cglobal ! global attribute CHARACTER(LEN=256) :: cldum ! dummy string TYPE(variable), DIMENSION(1) :: stypvar ! stucture for attributes (output) LOGICAL :: lfull=.FALSE. ! full step flag LOGICAL :: lchk ! file existence flag (true if missing) !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmxlheatc T-file [-full]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Computed the heat content in the mixed layer (Joules/m2).' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf input file with temperature and mld (gridT).' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -full ] : for full step configurations, default is partial step.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fzgr),' and ',TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_out),' (Joules/m2)' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfmxl, cdfmxlhcsc and cdfmxlsaltc.' PRINT *,' ' STOP ENDIF ijarg = 1 CALL getarg (ijarg, cf_tfil ) ; ijarg = ijarg + 1 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum ) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-full' ) ; lfull = .true. CASE DEFAULT ; PRINT *, TRIM(cldum),' : unknown option' ; STOP END SELECT END DO lchk = chkfile (cn_fzgr) lchk = chkfile (cn_fmsk) .OR. lchk lchk = chkfile (cf_tfil) .OR. lchk IF ( lchk ) STOP ! missing files CALL SetGlobalAtt( cglobal) npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) rdep(1) = 0. ipk(:) = 1 stypvar(1)%cname = cv_out stypvar(1)%cunits = 'J/m2' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -1.e15 stypvar(1)%valid_max = 1.e15 stypvar(1)%clong_name = 'Mixed_Layer_Heat_Content' stypvar(1)%cshort_name = cv_out stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! Allocate arrays ALLOCATE ( zmask(npiglo,npjglo), dmxlheatc(npiglo, npjglo) ) ALLOCATE ( zt(npiglo,npjglo), zmxl(npiglo,npjglo) ) ALLOCATE ( e3(npiglo,npjglo) ) ALLOCATE ( gdepw(0:npk), tim(npt) ) IF ( lfull ) ALLOCATE ( e31d(npk) ) ! Initialize output file ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1) ierr = createvar (ncout, stypvar, 1, ipk, id_varout, cdglobal=cglobal ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=rdep) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') gdepw(0) = 99999. ! dummy value always masked gdepw(1:npk) = getvare3(cn_fzgr, cn_gdepw, npk) IF ( lfull ) e31d( :) = getvare3(cn_fzgr, cn_ve3t, npk) dvol = 0.d0 dmxlheatc(:,:) = 0.d0 DO jt=1,npt zmxl( :,:) = getvar(cf_tfil, cn_somxl010, 1, npiglo, npjglo, ktime=jt) DO jk = 1, npk ! Get temperatures at jk zt( :,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo) ! get e3 at level jk ( ps...) IF ( lfull ) THEN ; e3(:,:) = e31d(jk) ELSE ; e3(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF ! e3 is used as a flag for the mixed layer; It is 0 outside the mixed layer e3(:,:)= MAX ( 0., MIN(e3, zmxl-gdepw(jk) ) ) WHERE ( e3 == 0 ) zmask = 0. dvol = SUM( DBLE(e3 * zmask) ) dmxlheatc = zt * e3 * zmask * 1.d0 + dmxlheatc IF (dvol == 0 ) EXIT ! no more layer below get out of the jk loop END DO ! Output to netcdf file : J/m2 dmxlheatc = rprho0*rpcp*dmxlheatc ierr = putvar(ncout, id_varout(1), REAL(dmxlheatc), 1, npiglo, npjglo, ktime=jt) END DO ierr = closeout(ncout) END PROGRAM cdfmxlheatc cdftools-3.0/cdfspeed.f900000644000175000017500000002037412241227304016423 0ustar amckinstryamckinstryPROGRAM cdfspeed !!====================================================================== !! *** PROGRAM cdfspeed *** !!===================================================================== !! ** Purpose : combine u and v to obtains the wind speed !! !! ** Method : speed=sqrt(u**2 + v**2) !! !! History : 2.1 : 11/2007 : P. Mathiot : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt, jlev ! dummy loop index INTEGER(KIND=4) :: narg, iargc, ijarg ! command line INTEGER(KIND=4) :: ncout, ierr ! output file stuff INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt, nlev ! size of the domain INTEGER(KIND=4) :: nvpk ! vertical levels in working variable INTEGER(KIND=4) :: ik ! level counter INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nklevel ! requested levels INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! output variable vertical level, varid REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter array REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept, gdeptall ! deptht values for requested/all levels REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, zv, zspeed ! working arrays, speed CHARACTER(LEN=256) :: cf_vfil, cf_ufil ! file for u and v components CHARACTER(LEN=256) :: cf_tfil='none' ! file for T point position CHARACTER(LEN=256) :: cv_u, cv_v ! name of u and v variable CHARACTER(LEN=256) :: cf_out='speed.nc' ! output file name CHARACTER(LEN=256) :: cldum ! dummy char variable TYPE (variable), DIMENSION(1) :: stypvar ! structure for attibutes LOGICAL :: lforcing ! forcing flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfspeed U-file V-file U-var V-var [-t T-file] ...' PRINT *,' ... [-lev level_list]' PRINT *,' PURPOSE :' PRINT *,' Computes the speed of ocean currents or wind speed' PRINT *,' ' PRINT *,' If the input files are 3D, the input is assumed to be ' PRINT *,' a model output on native C-grid. Speed is computed on the A-grid.' PRINT *,' ' PRINT *,' If the input file is 2D and then we assume that this is ' PRINT *,' a forcing file already on the A-grid.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' U-file : netcdf file for U component' PRINT *,' V-file : netcdf file for V component' PRINT *,' U-var : netcdf variable name for U component' PRINT *,' V-var : netcdf variable name for V component' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-t T-file ] : indicate any file on gridT for correct header' PRINT *,' of the output file (usefull for 3D files)' PRINT *,' [-lev level_list ] : indicate a list of levels to be processed' PRINT *,' If not used, all levels are processed.' PRINT *,' This option should be the last on the command line' PRINT *,' ' PRINT *,' OUTPUT :' PRINT *,' Output on ',TRIM(cf_out),' variable U ' STOP ENDIF nlev =0 ijarg=1 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum ) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-lev' ) nlev = narg -ijarg + 1 ALLOCATE ( nklevel(nlev) ) DO jlev = 1, nlev CALL getarg(ijarg, cldum ) ; ijarg = ijarg + 1 ; READ( cldum,*) nklevel(jlev) END DO CASE ( '-t' ) CALL getarg(ijarg, cf_tfil ) ; ijarg = ijarg + 1 IF ( chkfile (cf_tfil) ) STOP ! missing file CASE DEFAULT cf_ufil = cldum CALL getarg(ijarg, cf_vfil ) ; ijarg = ijarg + 1 IF ( chkfile(cf_ufil) .OR. chkfile(cf_vfil) ) STOP ! missing file CALL getarg(ijarg, cv_u ) ; ijarg = ijarg + 1 CALL getarg(ijarg, cv_v ) ; ijarg = ijarg + 1 END SELECT ENDDO npiglo = getdim (cf_vfil,cn_x) npjglo = getdim (cf_vfil,cn_y) npk = getdim (cf_vfil,cn_z) nvpk = getvdim(cf_vfil,cv_v) npt = getdim (cf_vfil,cn_t) IF ( (npk == 0) ) THEN lforcing=.TRUE. npk=1 PRINT *, 'W A R N I N G : you used a forcing field' ELSE lforcing=.FALSE. IF ( TRIM(cf_tfil) == 'none' ) THEN PRINT *,' ERROR: you must specify a griT file as fifth argument ' PRINT *,' This is for the proper header of output file ' STOP ENDIF END IF IF ( nlev == 0 ) THEN nlev = npk ALLOCATE ( nklevel(nlev) ) DO jlev =1, nlev nklevel(jlev) = jlev ENDDO ENDIF IF (nvpk == 2 ) nvpk = 1 IF (nvpk == 3 ) nvpk = nlev PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'nvpk =', nvpk PRINT *, 'nlev =', nlev PRINT *, 'npt =', npt IF ( nlev > nvpk ) THEN PRINT *, 'W A R N I N G : nlev larger than nvpk, we assume nlev=nvpk' nlev = nvpk END IF ! define new variables for output stypvar(1)%cname = 'U' stypvar(1)%cunits = 'm.s-1' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -1000. stypvar(1)%valid_max = 1000. stypvar(1)%clong_name = 'Current or wind speed' stypvar(1)%cshort_name = 'U' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' ! create output fileset IF (lforcing ) THEN ipk(1) = 1 ! 2D no dep variable ncout = create (cf_out, cf_vfil, npiglo, npjglo, 0 ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_vfil, npiglo, npjglo, 0 ) nlev=1 ; nklevel(nlev) = 1 ELSE ALLOCATE ( gdept(nlev), gdeptall(npk) ) gdeptall = getvar1d ( cf_tfil, cn_vdeptht, npk ) DO jlev = 1, nlev gdept(jlev) = gdeptall( nklevel(jlev) ) END DO ipk(1) = nlev ncout = create (cf_out, cf_tfil, npiglo, npjglo, nlev ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, nlev, pdep=gdept ) END IF ! Allocate arrays ALLOCATE ( zv(npiglo,npjglo), zu(npiglo,npjglo), zspeed(npiglo,npjglo), tim(npt)) DO jt=1,npt tim(jt)=jt END DO ierr=putvar1d(ncout, tim, npt, 'T') DO jt = 1,npt DO jlev = 1, nlev ik = nklevel(jlev) ! Get velocities v at jk zu(:,:) = getvar(cf_ufil, cv_u, ik, npiglo, npjglo, ktime=jt) zv(:,:) = getvar(cf_vfil, cv_v, ik, npiglo, npjglo, ktime=jt) IF ( lforcing ) THEN ! u and v are already on the T grid points ELSE ! in this case we are on the C-grid and the speed must be computed ! on the A-grid. We use reverse loop in order to use only one array DO ji=npiglo,2,-1 DO jj=1,npjglo zu(ji,jj) = 0.5*(zu(ji-1,jj)+zu(ji,jj)) ENDDO ENDDO DO ji=1,npiglo DO jj=npjglo,2 -1 zv(ji,jj) = 0.5*(zv(ji,jj-1)+zv(ji,jj)) ENDDO ENDDO END IF zspeed = SQRT(zv*zv+zu*zu) ierr = putvar(ncout, id_varout(1), zspeed, jlev ,npiglo, npjglo, ktime=jt) END DO END DO ierr = closeout(ncout) END PROGRAM cdfspeed cdftools-3.0/cdfbn2.f900000644000175000017500000001753612241227304016012 0ustar amckinstryamckinstryPROGRAM cdfbn2 !!====================================================================== !! *** PROGRAM cdfbn2 *** !!===================================================================== !! ** Purpose : Compute the Brunt Vaissala frequency !! using same algoritm than NEMO !! !! ** Method : Try to avoid 3 d arrays : work with 2 levels a a time !! The brunt-vaisala frequency is computed using the !! polynomial expression of McDougall (1987): !! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w !! N2 is then insterpolated at T levels !! !! History : 2.0 : 11/2004 : J.M. Molines : Original code !! 2.1 : 04/2005 : J.M. Molines : use cdfio !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames ! for cdf variable names USE eos !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! INTEGER(KIND=4) :: npiglo, npjglo, npk, npt ! size of the domain INTEGER(KIND=4) :: iup = 1, idown = 2, itmp ! for swapping the levels INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(2) :: ipk, id_varout ! level and id of output variables REAL(KIND=4) :: zpi ! 3.14... REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: ztemp, zsal, zwk ! Array to read 2 layer of data REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zn2 ! Brunt Vaissala Frequency (N2) REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e3w ! mask and metric REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep, tim, e3w1d ! depth and time CHARACTER(LEN=256) :: cf_tfil, cldum, cv_dep ! input file name, ... CHARACTER(LEN=256) :: cf_out = 'bn2.nc' ! output file name CHARACTER(LEN=256) :: cglobal ! global attribute CHARACTER(LEN=80) :: cv_e3w = 'e3w_ps' ! e3w variable name (partial step) CHARACTER(LEN=80) :: cv_bn2 = 'vobn2' ! cdf variable name for N2 TYPE(variable), DIMENSION(1) :: stypvar ! variable attribute LOGICAL :: l_w=.false. ! flag for vertical location of bn2 LOGICAL :: lchk=.true. ! check missing files LOGICAL :: lfull=.false. ! full step flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfbn2 T-file [W] [-full]' PRINT *,' PURPOSE :' PRINT *,' Compute the Brunt-Vaissala frequency (N2) according to' PRINT *,' temperature and salinity given in the input file.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf input gridT file for temperature and salinity.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ W ] : keep N2 at W points. Default is to interpolate N2' PRINT *,' at T point on the vertical.' PRINT *,' [ -full ] : indicate a full step configuration instead of' PRINT *,' the default partial steps.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fzgr),' is needed for this program.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_bn2) STOP ENDIF cglobal = 'Partial step computation' ijarg = 1 CALL getarg (ijarg, cf_tfil) ; ijarg = ijarg + 1 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE (cldum) CASE ('W','w') ; l_w = .true. CASE ('-full') ; lfull = .true. ; cglobal = 'full step computation' CASE DEFAULT ; PRINT *,' Option not understood :', TRIM(cldum) ; STOP END SELECT END DO lchk = chkfile (cn_fzgr ) lchk = lchk .OR. chkfile (cf_tfil ) IF ( lchk ) STOP ! missing files npiglo = getdim (cf_tfil, cn_x) npjglo = getdim (cf_tfil, cn_y) npk = getdim (cf_tfil, cn_z) npt = getdim (cf_tfil, cn_t) ipk(1) = npk ! 3D stypvar(1)%cname = cv_bn2 stypvar(1)%cunits = 's-1' stypvar(1)%rmissing_value = -1000. stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 50000. stypvar(1)%clong_name = 'Brunt_Vaissala_Frequency' stypvar(1)%cshort_name = cv_bn2 stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2) ) ALLOCATE (zwk(npiglo,npjglo,2), zmask(npiglo,npjglo) ) ALLOCATE (zn2(npiglo,npjglo), e3w(npiglo,npjglo) ) ALLOCATE (gdep(npk), tim(npt) ) IF ( lfull ) ALLOCATE (e3w1d(npk) ) cv_dep=cn_gdept IF (l_w) cv_dep=cn_gdepw gdep(:) = getvare3(cn_fzgr, cv_dep, npk) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk) ierr = createvar (ncout , stypvar, 1, ipk, id_varout, cdglobal=TRIM(cglobal)) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk, pdep=gdep) zpi=ACOS(-1.) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt,'T') IF ( lfull ) e3w1d(:) = getvare3(cn_fzgr, cn_ve3w, npk) gdep(:) = getvare3(cn_fzgr, cn_gdepw, npk) DO jt=1,npt ! 2 levels of T and S are required : iup,idown (with respect to W level) ! Compute from bottom to top (for vertical integration) ztemp(:,:,idown) = getvar(cf_tfil, cn_votemper, npk-1, npiglo, npjglo, ktime=jt) zsal( :,:,idown) = getvar(cf_tfil, cn_vosaline, npk-1, npiglo, npjglo, ktime=jt) DO jk = npk-1, 2, -1 PRINT *,'level ',jk zmask(:,:)=1. ztemp(:,:,iup)= getvar(cf_tfil, cn_votemper, jk-1, npiglo, npjglo, ktime=jt) WHERE(ztemp(:,:,idown) == 0 ) zmask = 0 zsal(:,:,iup) = getvar(cf_tfil, cn_vosaline, jk-1, npiglo, npjglo, ktime=jt) IF ( lfull ) THEN e3w(:,:) = e3w1d(jk) ELSE e3w(:,:) = getvar(cn_fzgr, cv_e3w , jk, npiglo, npjglo, ldiom=.true.) ENDIF zwk(:,:,iup) = eosbn2(ztemp, zsal, gdep(jk), e3w, npiglo, npjglo ,iup, idown)* zmask(:,:) IF ( .NOT. l_w ) THEN ! now put zn2 at T level (k ) WHERE ( zwk(:,:,idown) == 0 ) zn2(:,:) = zwk(:,:,iup) ELSEWHERE zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * zmask(:,:) END WHERE ELSE zn2(:,:) = zwk(:,:,iup) ENDIF WHERE ( zn2 == 0 ) zn2 = -1000. ierr = putvar(ncout, id_varout(1), zn2, jk, npiglo, npjglo, ktime=jt ) itmp = idown ; idown = iup ; iup = itmp END DO ! loop to next level END DO ierr = closeout(ncout) END PROGRAM cdfbn2 cdftools-3.0/cdftempvol-full.f900000644000175000017500000003135712241227304017754 0ustar amckinstryamckinstryPROGRAM cdftempvol_full !!--------------------------------------------------------------------- !! *** PROGRAM cdftempvol_full *** !! !! ** Purpose: Compute water volume in a given domain between isotherms !! FULL STEPS version !! !! ** Method : compute the sum ( e1 * e2 * e3 * mask ) !! -The box boundary are given by imin, imax, jmin, jmax !! read metrics, depth, etc !! read T and SSH !! compute the depths of isothermal surfaces !! compute the volume from surface to the isotherm !! compute the volume in each class of temperature !! compute the total volume !! !! history : !! Original : F. Castruccio (Fall 2006) !!--------------------------------------------------------------------- !! $Rev$ !! $Date$ !! $Id$ !!-------------------------------------------------------------- !! * Modules used USE cdfio !! * Local variables IMPLICIT NONE INTEGER :: nbins !: number of density classes INTEGER :: ji, jj, jk, jclass, jiso, jbin, jarg !: dummy loop index INTEGER :: ipos !: working variable INTEGER :: narg, iargc !: command line INTEGER :: npiglo,npjglo !: size of the domain INTEGER :: npk, nk !: vertical size, number of wet layers in the section INTEGER :: numbimg=10 !: optional bimg logical unit INTEGER :: numout=11 !: ascii output INTEGER :: imin, imax, jmin, jmax !: working box limits REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdept, gdepw !: depth of T and W points REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: e3t !: depth of T and W points REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1t, e2t !: lon, lat of T from file REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zt !: temperature from file REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zssh !: SSH from file REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: tmp !: temporary array ! double precision for cumulative variables REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: e1, e2 !: either e1t or e2t REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: e3 , zmask !: e3 and zmask REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztemp, gdep !: temp., depth of temp. points REAL(KIND=8) :: temp_min, temp_max, dtemp !: Min and Max for temp. bining REAL(KIND=8) :: temp,zalfa !: current working temp. REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: temp_lev !: built array with temp. levels REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: hiso !: depth of isotherms REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwvol, zwvolbin, volbin2 !: volume arrays REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: volbin !: volume arrays CHARACTER(LEN=256) :: cfilet !: files name CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc' !: coordinates files CHARACTER(LEN=256) :: cfilout='voltemp.txt' !: output file CHARACTER(LEN=256) :: cdum !: dummy string LOGICAL :: l_print=.FALSE. !: flag for printing additional results LOGICAL :: l_print2=.FALSE. !: flag for printing additional results LOGICAL :: l_bimg=.FALSE. !: flag for bimg output !! * Initialisations ! Read command line and output usage message if not compliant. narg= iargc() IF ( narg < 6 ) THEN PRINT '(255a)',' Usage : cdftempvol-full gridTfile imin, imax, jmin, jmax temp_max temp_min nbins [options]' PRINT '(255a)',' imin, imax, jmin, jmax : horizontal limit of the box' PRINT '(255a)',' temp_max, temp_min : limit for temperature bining ' PRINT '(255a)',' nbins : number of bins to use ' PRINT '(255a)',' Possible options :' PRINT '(255a)',' -print :additional output is send to std output' PRINT '(255a)',' -bimg : 2D (x=lat/lon, y=temp) output on bimg file for hiso, cumul trp, trp' PRINT '(255a)',' Files mesh_hgr.nc, mesh_zgr.nc must be in the current directory' PRINT '(255a)',' Output on voltemp.txt' STOP ENDIF !! Read arguments CALL getarg (1, cfilet) CALL getarg (2,cdum) ; READ(cdum,*) imin CALL getarg (3,cdum) ; READ(cdum,*) imax CALL getarg (4,cdum) ; READ(cdum,*) jmin CALL getarg (5,cdum) ; READ(cdum,*) jmax CALL getarg (6,cdum) ; READ(cdum,*) temp_max CALL getarg (7,cdum) ; READ(cdum,*) temp_min CALL getarg (8,cdum) ; READ(cdum,*) nbins DO jarg=9, narg CALL getarg(jarg,cdum) SELECT CASE (cdum) CASE ('-print' ) l_print = .TRUE. CASE ('-bimg') l_bimg = .TRUE. CASE DEFAULT PRINT *,' Unknown option ', TRIM(cdum),' ... ignored' END SELECT END DO ! Allocate and build temp. levels and section array ALLOCATE ( temp_lev (nbins+1) ) temp_lev(1)=temp_max dtemp=( temp_max - temp_min) / nbins DO jclass =2, nbins+1 temp_lev(jclass)= temp_lev(1) - (jclass-1) * dtemp END DO ! Look for size of the domain npiglo= getdim (cfilet,'x') npjglo= getdim (cfilet,'y') npk = getdim (cfilet,'depth') IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF ALLOCATE ( gdept(npk), gdepw(npk), e1t(npiglo,npjglo), e2t(npiglo,npjglo), e3t(npk) ) ALLOCATE ( volbin(nbins), volbin2(npjglo,nbins) ) volbin=0.d0 ; volbin2=0.d0 ! read dimensions gdept(:) = getvare3(coordzgr, 'gdept',npk) gdepw(:) = getvare3(coordzgr, 'gdepw',npk) e1t(:,:) = getvar(coordhgr, 'e1t', 1,npiglo,npjglo,kimin=imin,kjmin=jmin) e2t(:,:) = getvar(coordhgr, 'e2t', 1,npiglo,npjglo,kimin=imin,kjmin=jmin) e3t(:) = getvare3(coordzgr, 'e3t',npk) !! * Main loop DO jj=jmin,jmax ALLOCATE ( zt(npiglo,npk), tmp(npiglo,1), ztemp(npiglo,0:npk), zssh(npiglo,1) ) ALLOCATE ( e1(npiglo,npk), e2(npiglo,npk), e3(npiglo,npk), gdep(npiglo, npk), zmask(npiglo,npk) ) ALLOCATE ( zwvol(npiglo, nbins+1) , hiso(npiglo,nbins+1), zwvolbin(npiglo,nbins) ) zssh= 0. ; gdep= 0. ; zmask = 0. ; ztemp=0.d0 ; e1=0.d0 ; e2=0.d0 ; e3=0.d0 zwvol=0.d0 ; zwvolbin=0.d0 zssh(:,:)=getvar(cfilet,'sossheig',1, npiglo, 1 , kimin=imin+1 , kjmin=jj) DO jk=1,npk ! initiliaze gdep to gdept() gdep(:,jk) = gdept(jk) ! metrics (Full step case) e1(:,jk)=e1t(:,jj-jmin+1) e2(:,jk)=e2t(:,jj-jmin+1) e3(:,jk)=e3t(jk) ! temperature tmp(:,:)=getvar(cfilet,'votemper',jk, npiglo, 1, kimin=imin+1, kjmin=jj) zmask(:,jk)=tmp(:,1) WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1 zt(:,jk) = tmp(:,1) ! limitation to 'wet' points IF ( SUM(zt(:,jk)) == 0 ) THEN nk=jk ! first vertical point of the section full on land EXIT ! as soon as all the points are on land ENDIF END DO ! temp. only for wet points ztemp(:,1:nk)=zt(:,:) ztemp(:,0)=ztemp(:,1)-1.e-4 ! dummy layer for easy interpolation ! Some control print IF ( l_print2 ) THEN PRINT *,' T (deg C)' DO jk=1,nk PRINT 9000, jk, (ztemp(ji,jk),ji=1,npiglo) END DO PRINT *,' SSH (m)' PRINT 9000, 1, (zssh(ji,1),ji=1,npiglo) PRINT *,' GDEP (m) ' DO jk=1,nk PRINT 9001,jk, (gdep(ji,jk)*zmask(ji,jk),ji=1,npiglo) END DO PRINT *, 'E1 (m)' DO jk=1,nk PRINT 9001,jk, (e1(ji,jk)*zmask(ji,jk),ji=1,npiglo) END DO PRINT *, 'E2 (m)' DO jk=1,nk PRINT 9001,jk, (e2(ji,jk)*zmask(ji,jk),ji=1,npiglo) END DO PRINT *, 'E3 (m)' DO jk=1,nk PRINT 9001,jk, (e3(ji,jk)*zmask(ji,jk),ji=1,npiglo) END DO END IF ! compute depth of isotherms (nbins+1 ) IF (l_print ) PRINT *,' DEP ISO ( m )' DO jiso =1, nbins+1 temp=temp_lev(jiso) !!! REM : I and K loop can be inverted if necessary DO ji=1,npiglo hiso(ji,jiso) = gdept(npk) DO jk=1,nk IF ( ztemp(ji,jk) > temp ) THEN ELSE ! interpolate between jk-1 and jk zalfa=(temp - ztemp(ji,jk-1)) / ( ztemp(ji,jk) -ztemp(ji,jk-1) ) IF (ABS(zalfa) > 1.1 ) THEN ! case ztemp(0) = ztemp(1)-1.e-4 hiso(ji,jiso)= 0. ELSE hiso(ji,jiso)= gdep(ji,jk)*zalfa + (1.-zalfa)* gdep(ji,jk-1) ENDIF EXIT ENDIF END DO END DO IF (l_print) PRINT 9002, temp,(hiso(ji,jiso),ji=1,npiglo) END DO ! compute volume between surface and isotherm IF (l_print) PRINT *,' VOL SURF --> ISO (1.e12 M3)' DO jiso = 1, nbins + 1 temp=temp_lev(jiso) DO ji=1,npiglo !zwvol(ji,jiso) = e1(ji,1)*e2(ji,1)*zssh(ji,1) DO jk=1, nk IF ( gdepw(jk+1) < hiso(ji,jiso) ) THEN zwvol(ji,jiso)= zwvol(ji,jiso) + e1(ji,jk)*e2(ji,jk)*e3(ji,jk) ELSE ! last box ( fraction) zwvol(ji,jiso)= zwvol(ji,jiso) + e1(ji,jk)*e2(ji,jk)*(hiso(ji,jiso)-gdepw(jk)) EXIT ! jk loop ENDIF END DO END DO IF (l_print) PRINT 9003, temp,(zwvol(ji,jiso)/1.e12,ji=1,npiglo) END DO ! binned volume : difference between 2 isotherms IF (l_print) PRINT *,' VOL bins (SV)' DO jbin=1, nbins temp=temp_lev(jbin) DO ji=1, npiglo zwvolbin(ji,jbin) = zwvol(ji,jbin+1) - zwvol(ji,jbin) END DO volbin2(jj-jmin+1,jbin)=SUM(zwvolbin(:,jbin) ) IF (l_print) PRINT 9003, temp,(zwvolbin(ji,jbin)/1.e12,ji=1,npiglo), volbin2(jj-jmin+1,jbin)/1.e12 volbin(jbin)=volbin(jbin)+volbin2(jj-jmin+1,jbin) END DO PRINT *,' Total volume in all bins (1e.15 M3):',SUM(volbin2(jj-jmin+1,:) )/1.e15 ! ! output of the code for 1 section ! IF (l_bimg) THEN ! ! (along section, depth ) 2D variables ! cdum='Tdep.bimg' ! OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED') ! cdum=' 3 dimensions in this file ' ! WRITE(numbimg) cdum ! cdum=' 1: T ' ! WRITE(numbimg) cdum ! WRITE(cdum,'(a,4i5.4)') 'in box ', imin,imax,jmin,jmax ! WRITE(numbimg) cdum ! cdum=' file '//TRIM(cfilet) ! WRITE(numbimg) cdum ! WRITE(numbimg) npiglo,nk,1,1,2,0 ! WRITE(numbimg) 1.,-float(nk),1.,1., 0. ! WRITE(numbimg) 0. ! WRITE(numbimg) 0. ! ! temperature ! WRITE(numbimg) (( REAL(ztemp(ji,jk)), ji=1,npiglo) , jk=nk,1,-1 ) ! CLOSE(numbimg) ! ! (along section, temp ) 2D variables ! cdum='Volume_water_Tdep.bimg' ! OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED') ! cdum=' 3 dimensions in this file ' ! WRITE(numbimg) cdum ! cdum=' 1: hiso ; 2: bin vol ' ! WRITE(numbimg) cdum ! WRITE(cdum,'(a,4i5.4)') ' in box ', imin,imax,jmin,jmax ! WRITE(numbimg) cdum ! cdum=' file '//TRIM(cfilet) ! WRITE(numbimg) cdum ! WRITE(numbimg) npiglo,nbins,1,1,2,0 ! WRITE(numbimg) 1.,-REAL(temp_lev(nbins)),1.,REAL(dtemp), 0. ! WRITE(numbimg) 0. ! WRITE(numbimg) 0. ! ! hiso ! WRITE(numbimg) (( REAL(hiso(ji,jiso)), ji=1,npiglo) , jiso=nbins,1,-1) ! ! binned transport ! WRITE(numbimg) (( REAL(zwvolbin(ji,jiso))/1.e15, ji=1,npiglo) , jiso=nbins,1,-1) ! CLOSE(numbimg) ! ENDIF ! free memory for the next section DEALLOCATE ( zt, tmp, ztemp, zssh ) DEALLOCATE ( e1, e2, e3, gdep, zmask ) DEALLOCATE ( zwvol, hiso, zwvolbin ) PRINT *,' Total volume in all bins (1e.15 M3):',SUM(volbin(:)/1.e15 ) END DO ! next section !! Global Output OPEN( numout, FILE=cfilout) ipos=INDEX(cfilet,'_gridT.nc') WRITE(numout,9006) TRIM(cfilet(1:ipos-1)) WRITE(numout,*) ' temp. ' DO jiso=1,nbins WRITE(numout,9004) temp_lev(jiso), volbin(jiso) ENDDO CLOSE(numout) 9000 FORMAT(i7,60f8.3) 9001 FORMAT(i7,60f8.0) 9002 FORMAT(f7.3,60f8.0) 9003 FORMAT(f7.3,60f8.3) 9004 FORMAT(f9.4, 60e16.7) 9005 FORMAT('#',a9, 60(2x,a12,2x) ) 9006 FORMAT('# ',a) END PROGRAM cdftempvol_full cdftools-3.0/cdfmaskdmp.f900000644000175000017500000002105312241227304016752 0ustar amckinstryamckinstryPROGRAM cdfmaskdmp !!====================================================================== !! *** PROGRAM cdfmaskdmp *** !!===================================================================== !! ** Purpose : Compute 3D mask for AABW relaxation from T and S !! climatology. !! Store the results on a cdf file. !! !! ** Method: read temp and salinity, compute sigma-2 !! compute coefs, create mask !! !! History : 2.1 : 09/2010 : R. Dussin : Original code from JLS Py version !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: narg, iargc ! browse command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's REAL(KIND=4) :: ref_dep=2000. ! reference depth in meters REAL(KIND=4) :: zsnmin=37.16 ! minimum density REAL(KIND=4) :: zswidth=0.025 ! tapering width REAL(KIND=4) :: hmin=1000. ! depth limit REAL(KIND=4) :: hwidth=100. ! depth tapering height REAL(KIND=4) :: rlatmax=-20 ! max latitude REAL(KIND=4) :: rlatwidth=2 ! latitude tapering width REAL(KIND=4) :: wdep, wsig, wlat ! tapering function dep, sigma and lat REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp ! temperature REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsal ! salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsigi ! sigma-i REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zwdmp ! 2D build mask at current level REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zlat ! latitudes REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zdep ! deptht CHARACTER(LEN=256) :: cf_tfil ! input filename for temperature CHARACTER(LEN=256) :: cf_sfil ! input filename for salinity CHARACTER(LEN=256) :: cf_out='mask_dmp.nc' ! output file name CHARACTER(LEN=256) :: cldum ! dummy string CHARACTER(LEN=256) :: cglobal ! Global attribute with command name TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfmaskdmp T-file S-file ... ' PRINT *,' ... [ref_dep snmin swidth hmin hwidth latmax latwidth]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute a damping mask with smooth transition according to density,' PRINT *,' depth and latitude criteria.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : temperature file' PRINT *,' S-file : salinity file' PRINT *,' They can be the same file, but as many climatologied are provided' PRINT *,' in separate files, we decided to put both in the command line.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' ** If used, they must all be provided in the correct order (!) **' PRINT *,' ref_dep : reference depth for potential density.' PRINT *,' snmin : density minimum for the mask.' PRINT *,' swidth : density width for tapering' PRINT *,' hmin : minimum depth' PRINT *,' hwidth : depth width for tapering' PRINT *,' latmax : maximum latitude' PRINT *,' latwidth : latitude width for tapering' PRINT *,' ' PRINT *,' Actual default values are :' PRINT *,' ref_dep = ', ref_dep PRINT *,' snmin = ', zsnmin PRINT *,' swidth = ', zswidth PRINT *,' hmin = ', hmin PRINT *,' hwidth = ', hwidth PRINT *,' latmax = ', rlatmax PRINT *,' latwidth = ', rlatwidth PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : wdmp' STOP ENDIF IF ( narg > 2 .AND. narg < 9 ) THEN PRINT *,'wrong number of arguments' STOP ENDIF CALL getarg (1, cf_tfil) CALL getarg (2, cf_sfil) IF ( chkfile(cf_tfil) .OR. chkfile(cf_sfil) ) STOP ! missing files IF ( narg == 9 ) THEN CALL getarg (3, cldum) ; READ(cldum,*) ref_dep CALL getarg (4, cldum) ; READ(cldum,*) zsnmin CALL getarg (5, cldum) ; READ(cldum,*) zswidth CALL getarg (6, cldum) ; READ(cldum,*) hmin CALL getarg (7, cldum) ; READ(cldum,*) hwidth CALL getarg (8, cldum) ; READ(cldum,*) rlatmax CALL getarg (9, cldum) ; READ(cldum,*) rlatwidth ENDIF WRITE(cglobal,'(a,a,1x,a,7f9.3)') 'cdfmaskdmp ', TRIM(cf_tfil), TRIM(cf_sfil), ref_dep, zsnmin, & & zswidth, hmin, hwidth, rlatmax, rlatwidth npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) ipk(:) = npk stypvar(1)%cname = 'wdmp' stypvar(1)%cunits = '[0-1]' stypvar(1)%rmissing_value = 1.e+20 stypvar(1)%caxis = 'TZYX' stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 1. stypvar(1)%clong_name = 'Damping mask build on density criteria' stypvar(1)%cshort_name = 'wdmp' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE (ztemp(npiglo,npjglo), zsal( npiglo,npjglo) ) ALLOCATE (zsigi(npiglo,npjglo), zmask(npiglo,npjglo), zlat(npiglo,npjglo) ) ALLOCATE (zwdmp(npiglo,npjglo) ) ALLOCATE (tim(npt) , zdep(npk) ) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout, cdglobal=cglobal) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) tim(:) = getvar1d(cf_tfil, cn_vtimec, npt ) zdep(:) = getvar1d(cf_tfil, cn_vdeptht, npk ) zlat(:,:) = getvar (cf_tfil, cn_vlat2d, 1, npiglo, npjglo) ierr=putvar1d(ncout, tim, npt, 'T') DO jt = 1, npt PRINT *,'time: ',jt DO jk = 1, npk PRINT *, 'jk = ', jk ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zsal( :,:) = getvar(cf_sfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) zmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo ) zsigi(:,:) = sigmai( ztemp, zsal, ref_dep, npiglo, npjglo)* zmask(:,:) DO jj=1,npjglo DO ji=1,npiglo wdep = TANH( (zdep(jk ) - hmin ) / hwidth ) / 2. + 0.5 wsig = TANH( (zsigi(ji,jj) - zsnmin ) / zswidth ) / 2. + 0.5 wlat = TANH(-(zlat( ji,jj) - rlatmax) / rlatwidth) / 2. + 0.5 zwdmp(ji,jj) = wdep * wsig * wlat ENDDO ENDDO zwdmp(:,:) = zwdmp(:,:) * zmask(:,:) ierr = putvar(ncout, id_varout(1), zwdmp, jk,npiglo, npjglo, ktime=jt) END DO ! loop to next level END DO ! loop on time ierr = closeout(ncout) END PROGRAM cdfmaskdmp cdftools-3.0/cdfisopsi.f900000644000175000017500000004430712241227304016633 0ustar amckinstryamckinstryPROGRAM cdfisopsi !!====================================================================== !! *** PROGRAM cdfisopsi *** !!===================================================================== !! ** Purpose : Compute a geostrophic streamfunction projected !! on an isopycn (Ref: McDougall and ?, need reference) !! !! ** Method : read temp and salinity, compute sigmainsitu and sigma !! at a reference level, projection of p,T,S on a given !! isopycnal, compute specific volume anomaly and !! integrates it. !! !! History : 2.1 : 12/2010 : R. Dussin !! 3.0 : 03/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4), PARAMETER :: jp_vars=7 INTEGER(KIND=4) :: jj, ji, jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line arguments INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ik, ik0 ! INTEGER(KIND=4) :: ncout INTEGER(KIND=4), DIMENSION(jp_vars) :: ipk ! outptut variables : number of levels, INTEGER(KIND=4), DIMENSION(jp_vars) :: id_varout ! ncdf varid's REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d, ztemp3 ! 3d array REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: zsal3, zsva3 ! 3d array REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp, zsal , zssh ! Array to read a layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp0, zsal0 ! Arrays for reference profile REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsiginsitu ! in-situ density REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsig0, zsigsurf ! potential density of ref profile and surface REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask, zdep ! 2D mask at current level, level depths REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! 2d working arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztempint ! 2d working arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsalint ! 2d working arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zint ! 2d working arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: pint ! 2d working arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: alpha ! 2d working arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdeltapsi1 REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdeltapsi2 REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: psi0 REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: psi REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsva2 REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: prof, tim ! prof (m) and time (sec) REAL(KIND=4) :: P1, P2 REAL(KIND=4) :: zspval ! missing value REAL(KIND=4) :: refdepth REAL(KIND=4) :: zsigmaref ! REAL(KIND=4) :: ztmean, zsmean ! mean temperature and salinity on isopycnal REAL(KIND=4) :: hmean, pmean ! mean isopycnal depth and mean pressure CHARACTER(LEN=256) :: cf_tfil ! input gridT file CHARACTER(LEN=256) :: cf_out='isopsi.nc' ! output file name CHARACTER(LEN=256) :: cldum ! dummy character variable for reading TYPE(variable) , DIMENSION(jp_vars) :: stypvar ! structure for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfisopsi ref_level sigma_ref gridT ' PRINT *,' Compute a geostrophic streamfunction' PRINT *,' projected on an isopycn.' PRINT *,' ref_level = reference level for pot. density' PRINT *,' sigma_ref = density level to project on' PRINT *,' gridT = input file for temperature and salinity' PRINT *,' ' PRINT *,' Output on ',TRIM(cf_out),' variable soisopsi' PRINT *,' Depths are taken from input file ' PRINT *,' requires ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr) STOP ENDIF CALL getarg (1, cldum) ; READ (cldum,*) refdepth CALL getarg (2, cldum) ; READ (cldum,*) zsigmaref CALL getarg (3, cf_tfil) IF ( chkfile(cf_tfil) .OR. chkfile(cn_fzgr) .OR. chkfile(cn_fhgr) ) STOP ! missing file PRINT *, 'Potential density referenced at ', refdepth , ' meters' PRINT *, 'Isopycn for projection is ', zsigmaref npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE ( prof(npk) , tim(npt) ) ALLOCATE ( e1t(npiglo,npjglo), e2t(npiglo,npjglo) ) e1t(:,:) = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e2t(:,:) = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) !-------------------------------------------------------------------- !! Output file ipk(:)= 1 ! all variables are 2d stypvar(1)%cname = 'votemper_interp' stypvar(1)%cunits = 'DegC' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -2. stypvar(1)%valid_max = 45. stypvar(1)%clong_name = 'Temperature interpolated on isopycnal layer' stypvar(1)%cshort_name = 'votemper_interp' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' stypvar(2)%cname = 'vosaline_interp' stypvar(2)%cunits = 'PSU' stypvar(2)%rmissing_value = 0. stypvar(2)%valid_min = 0. stypvar(2)%valid_max = 50. stypvar(2)%clong_name = 'Salinity interpolated on isopycnal layer' stypvar(2)%cshort_name = 'vosaline_interp' stypvar(2)%conline_operation = 'N/A' stypvar(2)%caxis = 'TZYX' stypvar(3)%cname = 'depth_interp' stypvar(3)%cunits = 'meters' stypvar(3)%rmissing_value = 0. stypvar(3)%valid_min = 0.0 stypvar(3)%valid_max = 8000. stypvar(3)%clong_name = 'Depth of the isopycnal layer' stypvar(3)%cshort_name = 'depth_interp' stypvar(3)%conline_operation = 'N/A' stypvar(3)%caxis = 'TZYX' stypvar(4)%cname = 'soisopsi' stypvar(4)%cunits = 'm2s-2 (to be verified)' stypvar(4)%rmissing_value = 0. stypvar(4)%valid_min = -500. stypvar(4)%valid_max = 500. stypvar(4)%clong_name = 'Total streamfunction on the isopycnal layer' stypvar(4)%cshort_name = 'soisopsi' stypvar(4)%conline_operation = 'N/A' stypvar(4)%caxis = 'TZYX' stypvar(5)%cname = 'soisopsi0' stypvar(5)%cunits = 'm2s-2 (to be verified)' stypvar(5)%rmissing_value = 0. stypvar(5)%valid_min = -500. stypvar(5)%valid_max = 500. stypvar(5)%clong_name = 'Contribution of the SSH' stypvar(5)%cshort_name = 'soisopsi' stypvar(5)%conline_operation = 'N/A' stypvar(5)%caxis = 'TZYX' stypvar(6)%cname = 'soisopsi1' stypvar(6)%cunits = 'm2s-2 (to be verified)' stypvar(6)%rmissing_value = 0. stypvar(6)%valid_min = -500. stypvar(6)%valid_max = 500. stypvar(6)%clong_name = 'Contribution of specific volume anomaly vertical integration' stypvar(6)%cshort_name = 'soisopsi' stypvar(6)%conline_operation = 'N/A' stypvar(6)%caxis = 'TZYX' stypvar(7)%cname = 'soisopsi2' stypvar(7)%cunits = 'm2s-2 (to be verified)' stypvar(7)%rmissing_value = 0. stypvar(7)%valid_min = -500. stypvar(7)%valid_max = 500. stypvar(7)%clong_name = 'Contribution of pressure term on the isopycnal layer' stypvar(7)%cshort_name = 'soisopsi' stypvar(7)%conline_operation = 'N/A' stypvar(7)%caxis = 'TZYX' ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, jp_vars, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) prof(:) = getvar1d(cf_tfil, cn_vdeptht, npk ) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') zspval = getatt(cf_tfil, cn_vosaline, cn_missing_value ) !--------------------------------------------------------------------------- DO jt=1,npt PRINT *,'time ',jt, tim(jt)/86400.,' days' !------------------------------------------------------------------------------ ! 1. First we compute the potential density and store it into a 3d array ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zmask(npiglo,npjglo)) ALLOCATE (v3d(npiglo,npjglo,npk) ) DO jk = 1, npk zmask(:,:) = 1. ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zsal(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) WHERE(zsal == zspval ) zmask = 0 v3d(:,:,jk) = sigmai(ztemp, zsal, refdepth, npiglo, npjglo ) * zmask(:,:) END DO ! loop to next level DEALLOCATE ( ztemp, zsal, zmask ) !------------------------------------------------------------------------------ ! 2. Projection of T,S and p on the chosen isopycnal layer (from cdfrhoproj) ALLOCATE ( alpha(npiglo,npjglo) ) !! Compute coefficients DO ji=1,npiglo DO jj = 1, npjglo ik = 1 ! Assume that rho (z) is increasing downward (no inversion) ! Caution with sigma0 at great depth ! DO WHILE (zsigmaref >= v3d(ji,jj,ik) .AND. ik <= npk & & .AND. v3d(ji,jj,ik) /= zspval ) ik=ik+1 END DO ik=ik-1 ik0=ik IF (ik == 0) THEN ik=1 alpha(ji,jj) = 0. ELSE IF (v3d(ji,jj,ik+1) == zspval ) THEN ik0=0 alpha(ji,jj) = 0. ELSE ! ... alpha is always in [0,1]. Adding ik0 ( >=1 ) for saving space for ik0 alpha(ji,jj)= (zsigmaref-v3d(ji,jj,ik))/(v3d(ji,jj,ik+1)-v3d(ji,jj,ik)) + ik0 ENDIF END DO END DO DEALLOCATE (v3d) ! Working on temperature first ALLOCATE( ztempint(npiglo, npjglo), zint(npiglo, npjglo), pint(npiglo, npjglo) ) ALLOCATE( ztemp3(npiglo, npjglo,npk) ) DO jk=1,npk ztemp3(:,:,jk) = getvar(cf_tfil, cn_votemper, jk ,npiglo, npjglo, ktime=jt) ENDDO DO ji=1,npiglo DO jj=1,npjglo ! ik0 is retrieved from alpha, taking the integer part. ! The remnant is alpha. ik0=INT(alpha(ji,jj)) alpha(ji,jj) = alpha(ji,jj) - ik0 IF (ik0 /= 0) THEN P1=ztemp3(ji,jj,ik0) P2=ztemp3(ji,jj,ik0+1) IF (P1 /= zspval .AND. P2 /= zspval) THEN ztempint(ji,jj) = alpha(ji,jj) * P2 + (1-alpha(ji,jj)) * P1 zint(ji,jj) = alpha(ji,jj) * prof(ik0+1) + (1-alpha(ji,jj)) * prof(ik0) ELSE ztempint(ji,jj) = zspval zint(ji,jj) = zspval ENDIF ELSE ztempint(ji,jj) = zspval zint(ji,jj) = zspval ENDIF ! re-add ik0 to alpha for the next computation alpha(ji,jj) = alpha(ji,jj) + ik0 END DO END DO pint = zint / 10. ! pressure on the isopycnal layer = depth / 10. ierr = putvar(ncout, id_varout(1), ztempint, 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(3), zint, 1, npiglo, npjglo, ktime=jt) DEALLOCATE( ztemp3 ) ! Working on salinity ALLOCATE( zsalint(npiglo, npjglo) ) ALLOCATE( zsal3(npiglo, npjglo,npk) ) DO jk=1,npk zsal3(:,:,jk) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) ENDDO DO ji=1,npiglo DO jj=1,npjglo ! ik0 is retrieved from alpha, taking the integer part. ! The remnant is alpha. ik0=INT(alpha(ji,jj)) alpha(ji,jj) = alpha(ji,jj) - ik0 IF (ik0 /= 0) THEN P1=zsal3(ji,jj,ik0) P2=zsal3(ji,jj,ik0+1) IF (P1 /= zspval .AND. P2 /= zspval) THEN zsalint(ji,jj) = alpha(ji,jj) * P2 + (1-alpha(ji,jj)) * P1 ELSE zsalint(ji,jj) = zspval ENDIF ELSE zsalint(ji,jj) = zspval ENDIF ! re-add ik0 to alpha for the next computation alpha(ji,jj) = alpha(ji,jj) + ik0 END DO END DO ierr = putvar(ncout, id_varout(2), zsalint, 1, npiglo, npjglo, ktime=jt) DEALLOCATE( zsal3 ) ! 3. Compute means for T,S and depth on the isopycnal layer ALLOCATE( zmask(npiglo, npjglo) ) zmask=1. ! define a new mask which correspond to the isopycnal layer WHERE( zint == 0. ) zmask = 0. ztmean = SUM( ztempint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask ) zsmean = SUM( zsalint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask ) ! JMM rem : hmean never used ... ! hmean = SUM( zint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask ) pmean = SUM( pint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask ) DEALLOCATE ( ztempint, zsalint ) ! 4. Compute specific volume anomaly ALLOCATE( zsva3(npiglo,npjglo,npk) ) ALLOCATE( zsiginsitu(npiglo,npjglo), zsig0(npiglo,npjglo) ) ALLOCATE( ztemp(npiglo,npjglo), zsal(npiglo,npjglo) ) ALLOCATE( ztemp0(npiglo,npjglo), zsal0(npiglo,npjglo) ) DO jk=1,npk ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zsal (:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) ztemp0(:,:) = ztmean zsal0 (:,:) = zsmean ! again land/sea mask zmask (:,:) = 1. WHERE( zsal == zspval ) zmask = 0. zsiginsitu(:,:) = sigmai ( ztemp, zsal, prof(jk), npiglo, npjglo ) * zmask(:,:) ! in-situ density zsig0(:,:) = sigmai ( ztemp0, zsal0, prof(jk), npiglo, npjglo ) * zmask(:,:) ! density of reference profile zsva3(:,:,jk) = ( 1. / zsiginsitu(:,:) ) - ( 1. / zsig0(:,:) ) ENDDO DEALLOCATE( zsiginsitu, zsig0, ztemp0, zsal0 ) ! 5. Integrates from surface to depth of isopycnal layer ALLOCATE( zdep(npiglo, npjglo), rdeltapsi1(npiglo, npjglo) ) rdeltapsi1(:,:) = 0. DO jk=1, npk zdep(:,:) = getvar(cn_fzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.TRUE.) ! For each point we integrate from surface to zint(ji,jj) which is the depth ! of the isopycnal layer ! If isopycnal layer depth is below the current level WHERE( zint >= prof(jk) ) rdeltapsi1 = rdeltapsi1 - zsva3(:,:,jk) * zdep / 10. ! If isopycnal layer is between current level and previous level WHERE( zint < prof(jk) .AND. zint > prof(jk-1) ) rdeltapsi1 = rdeltapsi1 & & - zsva3(:,:,jk) * ( zint - prof(jk-1) ) / 10. ENDDO ierr = putvar(ncout, id_varout(6), rdeltapsi1, 1, npiglo, npjglo, ktime=jt) DEALLOCATE( zdep ) ! 6. Projection of the specific volume anomaly on the isopycnal layer ALLOCATE( zsva2(npiglo,npjglo), rdeltapsi2(npiglo,npjglo) ) DO ji=1,npiglo DO jj=1,npjglo ! ik0 is retrieved from alpha, taking the integer part. ! The remnant is alpha. ik0=INT(alpha(ji,jj)) alpha(ji,jj) = alpha(ji,jj) - ik0 IF (ik0 /= 0) THEN P1=zsva3(ji,jj,ik0) P2=zsva3(ji,jj,ik0+1) IF (P1 /= zspval .AND. P2 /= zspval) THEN zsva2(ji,jj) = alpha(ji,jj) * P2 + ( 1-alpha(ji,jj) ) * P1 ELSE zsva2(ji,jj) = zspval ENDIF ELSE zsva2(ji,jj) = zspval ENDIF ! re-add ik0 to alpha for the next computation alpha(ji,jj) = alpha(ji,jj) + ik0 END DO END DO rdeltapsi2 = ( pint - pmean ) * zsva2 ierr = putvar(ncout, id_varout(7), rdeltapsi2, 1, npiglo, npjglo, ktime=jt) DEALLOCATE ( zsva3, zsva2, alpha, zint, pint ) ! 6. Finally we compute the surface streamfunction ALLOCATE(zssh(npiglo,npjglo) , zsigsurf(npiglo,npjglo), psi0(npiglo,npjglo) ) ztemp (:,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt) zsal (:,:) = getvar(cf_tfil, cn_vosaline, 1, npiglo, npjglo, ktime=jt) zssh (:,:) = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo, ktime=jt) ! land/sea mask at surface zmask (:,:) = 1. WHERE( zsal == zspval ) zmask = 0. zsigsurf(:,:) = sigmai ( ztemp, zsal, prof(1), npiglo, npjglo ) * zmask(:,:) psi0 = zsigsurf * zssh * (9.81 / 1020. ) ierr = putvar(ncout, id_varout(5), psi0, 1, npiglo, npjglo, ktime=jt) DEALLOCATE(zssh, zsigsurf, ztemp, zsal ) ! 7. At least we are done with the computations ALLOCATE( psi(npiglo,npjglo) ) ! final mask for output : mask the contribution of SSH where isopycn outcrops zmask=1. WHERE(rdeltapsi1 == zspval ) zmask = 0. psi = ( psi0 * zmask ) + rdeltapsi1 + rdeltapsi2 ierr = putvar(ncout, id_varout(4), psi, 1, npiglo, npjglo, ktime=jt) DEALLOCATE( psi, psi0, rdeltapsi1, rdeltapsi2, zmask ) END DO ! loop to next time ierr = closeout(ncout) END PROGRAM cdfisopsi cdftools-3.0/cdfgradT.f900000644000175000017500000002136712241227304016367 0ustar amckinstryamckinstryPROGRAM cdfgradT !!====================================================================== !! *** PROGRAM cdfgradT *** !!===================================================================== !! ** Purpose : !! !! ** Method : !! !! History : 3.0 : 05/2013 : N. Ducousso !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output variable INTEGER(KIND=4) :: ierr ! error status INTEGER(KIND=4) :: iup= 1, icurr= 2 ! INTEGER(KIND=4), DIMENSION(6) :: ipk, id_varout ! output variable REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: tim REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zt, zs REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: umask, vmask, wmask REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1u, e2v, e3w REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: gradt_x, gradt_y, gradt_z REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: grads_x, grads_y, grads_z CHARACTER(LEN=256) :: cf_tfil ! input file name CHARACTER(LEN=256) :: cf_out = 'gradT.nc' ! output file name CHARACTER(LEN=256), DIMENSION(2) :: cv_namesi ! input variable names TYPE(variable), DIMENSION(6) :: stypvar ! output data structure LOGICAL :: lchk = .FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() cv_namesi(1) = cn_votemper cv_namesi(2) = cn_vosaline narg= iargc() IF ( narg /= 1 ) THEN PRINT *,' usage : cdfgradT T-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' ' STOP ENDIF CALL getarg (1, cf_tfil) IF (chkfile(cf_tfil) ) STOP ! missing file npiglo = getdim (cf_tfil, cn_x) npjglo = getdim (cf_tfil, cn_y) npk = getdim (cf_tfil, cn_z) npt = getdim (cf_tfil, cn_t) !! Create output variables ipk(:) = npk ! 3D stypvar(1)%cname = 'vozogradt' stypvar(1)%cunits = '' stypvar(1)%rmissing_value = -1000. stypvar(1)%valid_min = -1. stypvar(1)%valid_max = 1. stypvar(1)%clong_name = 'zonal temper gradient' stypvar(1)%cshort_name = 'vozogradt' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' stypvar(2)%cname = 'vomegradt' stypvar(2)%cunits = '' stypvar(2)%rmissing_value = -1000. stypvar(2)%valid_min = -1. stypvar(2)%valid_max = 1. stypvar(2)%clong_name = 'meridional temper gradient' stypvar(2)%cshort_name = 'vomegradt' stypvar(2)%conline_operation = 'N/A' stypvar(2)%caxis = 'TZYX' stypvar(3)%cname = 'vovegradt' stypvar(3)%cunits = '' stypvar(3)%rmissing_value = -1000. stypvar(3)%valid_min = -1. stypvar(3)%valid_max = 1. stypvar(3)%clong_name = 'vertical temper gradient' stypvar(3)%cshort_name = 'vovegradt' stypvar(3)%conline_operation = 'N/A' stypvar(3)%caxis = 'TZYX' stypvar(4)%cname = 'vozograds' stypvar(4)%cunits = '' stypvar(4)%rmissing_value = -1000. stypvar(4)%valid_min = -1. stypvar(4)%valid_max = 1. stypvar(4)%clong_name = 'zonal saline gradient' stypvar(4)%cshort_name = 'vozograds' stypvar(4)%conline_operation = 'N/A' stypvar(4)%caxis = 'TZYX' stypvar(5)%cname = 'vomegrads' stypvar(5)%cunits = '' stypvar(5)%rmissing_value = -1000. stypvar(5)%valid_min = -1. stypvar(5)%valid_max = 1. stypvar(5)%clong_name = 'meridional saline gradient' stypvar(5)%cshort_name = 'vomegrads' stypvar(5)%conline_operation = 'N/A' stypvar(5)%caxis = 'TZYX' stypvar(6)%cname = 'vovegrads' stypvar(6)%cunits = '' stypvar(6)%rmissing_value = -1000. stypvar(6)%valid_min = -1. stypvar(6)%valid_max = 1. stypvar(6)%clong_name = 'vertical saline gradient' stypvar(6)%cshort_name = 'vovegrads' stypvar(6)%conline_operation = 'N/A' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt !! Allocate arrays ALLOCATE (tim(npt) ) ALLOCATE (e1u(npiglo,npjglo), e2v(npiglo,npjglo), e3w(npiglo,npjglo)) ALLOCATE (umask(npiglo,npjglo), vmask(npiglo,npjglo), wmask(npiglo,npjglo)) ALLOCATE (zt(npiglo,npjglo,2), zs(npiglo,npjglo,2)) ALLOCATE (gradt_x(npiglo,npjglo), gradt_y(npiglo,npjglo), gradt_z(npiglo,npjglo)) ALLOCATE (grads_x(npiglo,npjglo), grads_y(npiglo,npjglo), grads_z(npiglo,npjglo)) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 6, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') e1u = getvar(cn_fhgr, cn_ve1u, 1, npiglo, npjglo) e2v = getvar(cn_fhgr, cn_ve2v, 1, npiglo, npjglo) DO jt = 1,npt DO jk = npk, 1, -1 !! Main loop : (2 levels of T are required : iup, icurr) PRINT *,'level ',jk ! read files IF (jk == 1) THEN zt(:,:,iup) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zt(:,:,icurr) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zs(:,:,iup) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) zs(:,:,icurr) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) ELSE zt(:,:,iup) = getvar(cf_tfil, cn_votemper, jk-1, npiglo, npjglo, ktime=jt) zt(:,:,icurr) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) zs(:,:,iup) = getvar(cf_tfil, cn_vosaline, jk-1, npiglo, npjglo, ktime=jt) zs(:,:,icurr) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) END IF e3w(:,:) = getvar(cn_fzgr, 'e3w_ps', jk, npiglo, npjglo, ldiom=.true.) umask(:,:) = getvar(cn_fmsk, 'umask' , jk, npiglo, npjglo ) vmask(:,:) = getvar(cn_fmsk, 'vmask' , jk, npiglo, npjglo ) wmask(:,:) = getvar(cn_fmsk, 'tmask' , jk, npiglo, npjglo ) ! zonal grad located at U point gradt_x(:,:) = 0. gradt_x(1:npiglo-1,:) = 1. / e1u(1:npiglo-1,:) * & & ( zt(2:npiglo,:,icurr) - zt(1:npiglo-1,:,icurr) ) * umask(1:npiglo-1,:) grads_x(:,:) = 0. grads_x(1:npiglo-1,:) = 1. / e1u(1:npiglo-1,:) * & & ( zs(2:npiglo,:,icurr) - zs(1:npiglo-1,:,icurr) ) * umask(1:npiglo-1,:) ! meridional grad located at V point gradt_y(:,:) = 0. gradt_y(:,1:npjglo-1) = 1. / e2v(:,1:npjglo-1) * & & ( zt(:,2:npjglo,icurr) - zt(:,1:npjglo-1,icurr) ) * vmask(:,1:npjglo-1) grads_y(:,:) = 0. grads_y(:,1:npjglo-1) = 1. / e2v(:,1:npjglo-1) * & & ( zs(:,2:npjglo,icurr) - zs(:,1:npjglo-1,icurr) ) * vmask(:,1:npjglo-1) ! vertical grad located at W point gradt_z(:,:) = 0. gradt_z(:,:) = 1. / e3w(:,:) * ( zt(:,:,iup) - zt(:,:,icurr) ) * wmask(:,:) grads_z(:,:) = 0. grads_z(:,:) = 1. / e3w(:,:) * ( zs(:,:,iup) - zs(:,:,icurr) ) * wmask(:,:) ! write ierr = putvar(ncout, id_varout(1), REAL(gradt_x), jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(2), REAL(gradt_y), jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(3), REAL(gradt_z), jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(4), REAL(grads_x), jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(5), REAL(grads_y), jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(6), REAL(grads_z), jk, npiglo, npjglo, ktime=jt) END DO END DO ierr = closeout(ncout) END PROGRAM cdfgradT cdftools-3.0/cdf2matlab.f900000644000175000017500000001655412241227304016652 0ustar amckinstryamckinstryPROGRAM cdf2matlab !!====================================================================== !! *** PROGRAM cdf2matlab *** !!===================================================================== !! ** Purpose : Reshapes ORCA grids to be matlab-friendly !! !! ** Method : transform input file with monotonically increasing !! longitudes. !! !! History : 2.1 : 01/2011 : R. Dussin : Original code !! 3.0 : 03/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj ! dummy loop index INTEGER(KIND=4) :: narg, iargc ! INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain INTEGER(KIND=4) :: npiglox2 ! new model size in x INTEGER(KIND=4) :: ilev, iindex, itmp INTEGER(KIND=4) :: ncout INTEGER(KIND=4) :: ierr INTEGER(KIND=4), DIMENSION(3) :: ipk, id_varout REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zlon, zlat, zvar ! input arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zlonout, zlatout ! output arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zlonwork, zlatwork ! working arrays arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvarout, zvarwork ! working arrays arrays REAL(KIND=4), DIMENSION(1) :: tim CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cf_out='output.nc' ! output file name CHARACTER(LEN=256) :: cv_in ! input variable name CHARACTER(LEN=256) :: cldum ! dummy character variable TYPE(variable), DIMENSION(3) :: stypvar ! structure for attribute !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg /= 3 ) THEN PRINT *,' usage : cdf2matlab IN-file IN-var level ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Convert global nemo input file (ORCA configurations) into' PRINT *,' a file with monotonically increasing longitudes.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : input model file.' PRINT *,' IN-var : netcdf variable name to process.' PRINT *,' level : level to process.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : same name than in input file.' STOP ENDIF !! !! Initialisation from 1st file (all file are assume to have the same geometry) CALL getarg (1, cf_in) CALL getarg (2, cv_in) CALL getarg (3, cldum) ; READ(cldum,*) ilev IF ( chkfile (cf_in) ) STOP ! missing file npiglo = getdim (cf_in,cn_x) npjglo = getdim (cf_in,cn_y) npk = getdim (cf_in,cn_z) ipk(:) = 1 stypvar(1)%cname = 'lon' stypvar(1)%cunits = 'degrees' stypvar(1)%valid_min = -180. stypvar(1)%valid_max = 540. stypvar(1)%clong_name = 'longitude' stypvar(1)%cshort_name = 'lon' stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'YX' stypvar(2)%cname = 'lat' stypvar(2)%cunits = 'degrees' stypvar(2)%rmissing_value = 0. stypvar(2)%valid_min = -90. stypvar(2)%valid_max = 90. stypvar(2)%clong_name = 'latitude' stypvar(2)%cshort_name = 'lat' stypvar(2)%conline_operation = 'N/A' stypvar(2)%caxis = 'YX' stypvar(3)%cname = cv_in stypvar(3)%cunits = '' stypvar(3)%rmissing_value = 0. stypvar(3)%clong_name = '' stypvar(3)%cshort_name = cv_in stypvar(3)%conline_operation = 'N/A' stypvar(3)%caxis = 'TYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk npiglox2 = 2 * npiglo ALLOCATE( zvar(npiglo,npjglo), zlon(npiglo,npjglo), zlat(npiglo,npjglo) ) ALLOCATE( zvarout(npiglox2,npjglo), zlonout(npiglox2,npjglo), zlatout(npiglox2,npjglo) ) ncout = create (cf_out, cf_in, npiglox2, npjglo, 1 ) ierr = createvar (ncout, stypvar, 3, ipk, id_varout ) zlon(:,:) = getvar(cf_in, cn_vlon2d, 1, npiglo, npjglo) zlat(:,:) = getvar(cf_in, cn_vlat2d, 1, npiglo, npjglo) zvar(:,:) = getvar(cf_in, cv_in, ilev, npiglo, npjglo) DO jj=1,npjglo iindex = MINLOC( ABS(zlon(:,jj) + 180 ),1 ) ! find the discontinuity in lon array itmp = npiglo - iindex + 1 zlonout(1:itmp,jj) = zlon(iindex:npiglo,jj) ; zlonout(itmp+1:npiglo,jj) = zlon(1:iindex-1,jj) zlonout(npiglo+1:npiglo+itmp ,jj) = zlon(iindex:npiglo,jj) + 360. zlonout(npiglo+itmp+1:npiglox2,jj) = zlon(1:iindex-1, jj) + 360. zlatout(1:itmp,jj) = zlat(iindex:npiglo,jj) ; zlatout(itmp+1:npiglo,jj) = zlat(1:iindex-1,jj) zlatout(npiglo+1:npiglo+itmp, jj) = zlat(iindex:npiglo,jj) zlatout(npiglo+itmp+1:npiglox2,jj) = zlat(1:iindex-1, jj) zvarout(1:itmp,jj) = zvar(iindex:npiglo,jj) ; zvarout(itmp+1:npiglo,jj) = zvar(1:iindex-1,jj) zvarout(npiglo+1:npiglo+itmp, jj) = zvar(iindex:npiglo,jj) zvarout(npiglo+itmp+1:npiglox2,jj) = zvar(1:iindex-1, jj) END DO ! Special treatement for ORCA2 IF ( ( npiglo == 182 ) .AND. ( npjglo == 149 ) ) THEN PRINT *, 'Assuming that this config is ORCA2 !' ALLOCATE( zvarwork(npiglox2,npjglo), zlonwork(npiglox2,npjglo), zlatwork(npiglox2,npjglo) ) !! init the arryas zlonwork(:,:) = zlonout(:,:) zlatwork(:,:) = zlatout(:,:) zvarwork(:,:) = zvarout(:,:) !! swap values to keep lon increasing zlonwork(131,:) = zlonout(130,:) ; zlonwork(npiglo+131,:) = zlonout(npiglo+130,:) zlatwork(131,:) = zlatout(130,:) ; zlatwork(npiglo+131,:) = zlatout(npiglo+130,:) zvarwork(131,:) = zvarout(130,:) ; zvarwork(npiglo+131,:) = zvarout(npiglo+130,:) zlonwork(130,:) = zlonout(131,:) ; zlonwork(npiglo+130,:) = zlonout(npiglo+131,:) zlatwork(130,:) = zlatout(131,:) ; zlatwork(npiglo+130,:) = zlatout(npiglo+131,:) zvarwork(130,:) = zvarout(131,:) ; zvarwork(npiglo+130,:) = zvarout(npiglo+131,:) !! swapping the arrays zlonout(:,:) = zlonwork(:,:) zlatout(:,:) = zlatwork(:,:) zvarout(:,:) = zvarwork(:,:) ENDIF ierr = putvar(ncout,id_varout(1), zlonout, 1, npiglox2, npjglo) ierr = putvar(ncout,id_varout(2), zlatout, 1, npiglox2, npjglo) ierr = putvar(ncout,id_varout(3), zvarout, 1, npiglox2, npjglo) tim = getvar1d(cf_in, cn_vtimec, 1 ) ierr = putvar1d(ncout, tim, 1, 'T') ierr = closeout(ncout) PRINT *, 'Tip : in matlab, do not plot the last line (e.g. maximum northern latitude) ' END PROGRAM cdf2matlab cdftools-3.0/cdfhdy3d.f900000644000175000017500000001622712241227304016340 0ustar amckinstryamckinstryPROGRAM cdfhdy3d !!====================================================================== !! *** PROGRAM cdfhdy3d *** !!===================================================================== !! ** Purpose : Compute dynamical height anomaly field from gridT file !! at each levels. !! Store the results on a 3D cdf file. !! !! ** Method : the integral of (1/g) *10e4 * sum [ delta * dz ] !! with delta = (1/rho - 1/rho0) !! 10e4 factor is conversion decibar/pascal !! !! History : 2.1 : 05/2010 : R. Dussin : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos, ONLY : sigmai USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! browse arguments INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! " " INTEGER(KIND=4) :: nlev1, nlev2 ! limit of vertical integration INTEGER(KIND=4) :: ncout ! ncid of output fileset INTEGER(KIND=4), DIMENSION(1) :: ipk ! outptut variables : number of levels, INTEGER(KIND=4), DIMENSION(1) :: id_varout ! ncdf varid's REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp, zsal ! Temperature and salinity at current level REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp0, zsal0 ! reference temperature and salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! 2D mask at current level REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdep, rdepth ! depth at current level including SSH REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zssh ! Sea Surface Heigh REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim, e3t_1d ! time counter, vertical level spacing REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dhdy, dterm ! dynamic height, working array REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsig0, dsig ! In situ density (reference, local) REAL(KIND=8) :: drau0 = 1000.d0 ! density of fresh water REAL(KIND=8) :: dgrav = 9.81d0 ! gravity CHARACTER(LEN=256) :: cf_tfil ! input file name CHARACTER(LEN=256) :: cf_out='cdfhdy3d.nc' ! output file name CHARACTER(LEN=256) :: cv_out='vohdy' ! output file name TYPE(variable) , DIMENSION(1) :: stypvar ! structure for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg /= 1 ) THEN PRINT *,' usage : cdfhdy3d T-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute dynamic height anomaly from T-file given as argument.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with temperature and salinity.' PRINT *,' ' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fmsk),' and ', TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ', TRIM(cv_out),' ( m )' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfhdy' PRINT *,' ' STOP ENDIF CALL getarg (1, cf_tfil) npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) IF ( chkfile(cf_tfil) .OR. chkfile(cn_fmsk) .OR. chkfile(cn_fzgr) ) STOP ! missing files ipk(:) = npk stypvar(1)%cname = cv_out stypvar(1)%cunits = 'm' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -100. stypvar(1)%valid_max = 100. stypvar(1)%clong_name = 'Dynamical height anomaly' stypvar(1)%cshort_name = cv_out stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE (temp0(npiglo,npjglo), zsal0(npiglo,npjglo), dsig0(npiglo,npjglo) ,tmask(npiglo,npjglo)) ALLOCATE (temp(npiglo,npjglo), zsal(npiglo,npjglo), dsig(npiglo,npjglo) , dhdy(npiglo,npjglo), dterm(npiglo,npjglo)) ALLOCATE (rdep(npiglo,npjglo), rdepth(npiglo,npjglo), zssh(npiglo,npjglo), e3t_1d(npk)) ALLOCATE (tim(npt)) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) tim = getvar1d (cf_tfil, cn_vtimec, npt) ierr = putvar1d(ncout, tim, npt, 'T') ! Temperature and salinity for reference profile temp0(:,:) = 0. zsal0(:,:) = 35. zssh(:,:) = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo) e3t_1d(:) = getvare3(cn_fzgr, cn_ve3t, npk) DO jt = 1, npt PRINT *,' TIME = ', jt, tim(jt)/86400.,' days' dhdy(:,:) = 0. rdepth(:,:) = 0. DO jk = 1, npk !rdep(:,:) = getvar(cn_fzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.true.) ! we degrade the computation to smooth the results rdep(:,:) = e3t_1d(jk) tmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo) IF ( jk == 1 ) THEN rdep(:,:) = rdep(:,:) + zssh(:,:) ENDIF ! depth at current level, including ssh (used for computation of rho in situ) rdepth(:,:) = rdepth(:,:) + rdep(:,:) temp(:,:)= getvar(cf_tfil, cn_votemper, jk ,npiglo, npjglo, ktime=jt) zsal(:,:) = getvar(cf_tfil, cn_vosaline, jk ,npiglo, npjglo, ktime=jt) dsig0 = sigmai(temp0, zsal0, rdepth, npiglo, npjglo) dsig = sigmai(temp , zsal , rdepth, npiglo, npjglo) ! we compute the term of the integral : (1/g) *10e4 * sum [ delta * dz ] ! with delta = (1/rho - 1/rho0) ! 10e4 factor is conversion decibar/pascal ! dterm = ( ( 1.d0 / ( drau0 + dsig(:,:) ) ) - ( 1.d0 / ( drau0 + dsig0(:,:) ) ) ) * 10000.d0 * rdep / dgrav ! in land, it seems appropriate to stop the computation WHERE(zsal == 0 ) dterm = 0 dhdy(:,:) = dhdy(:,:) + dterm(:,:) ! masked dhdy(:,:) = dhdy(:,:) * tmask(:,:) ierr = putvar(ncout, id_varout(1) ,REAL(dhdy), jk, npiglo, npjglo, ktime=jt) END DO ! loop to next level END DO ! next time frame ierr = closeout(ncout) END PROGRAM cdfhdy3d cdftools-3.0/cdfzonalout.f900000644000175000017500000001150012241227304017165 0ustar amckinstryamckinstryPROGRAM cdfzonalout !!====================================================================== !! *** PROGRAM cdfzonalout *** !!===================================================================== !! ** Purpose : Output zonal mean/integral as ascii files !! !! ** Method : Read zonalmean or zonalsum file, determine 1D variable !! and dump them on the standard output. !! !! History : 2.1 : 02/2006 : J.M. Molines : Original code !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jj, jvar, jt ! dummy loop index INTEGER(KIND=4) :: ivar ! variable counter INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: npjglo, npt ! size of the domain INTEGER(KIND=4) :: nvarin, nvar ! variables count INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipki ! input ipk variables INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varin ! input variables id's REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdumlat ! latitude for i = north pole REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zv ! data values TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! dummy structure CHARACTER(LEN=256) :: cf_zonal ! input file name CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! input variable names !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfzonalout ZONAL-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' This is a formatting program for zonal files, either mean or integral.' PRINT *,' It displays results on the standard output from the input zonal file.' PRINT *,' It only works with 1D zonal variables, skipping 2D variables, that' PRINT *,' cannot be easily displayed !' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' ZONAL-file : input netcdf zonal file produced by one of the zonal' PRINT *,' tools.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' - Standard output, structured in columns:' PRINT *,' J LAT ( zonal mean, var = 1--> nvar) ' STOP ENDIF CALL getarg (1, cf_zonal) IF ( chkfile(cf_zonal) ) STOP ! missing file nvarin = getnvar(cf_zonal) ALLOCATE ( cv_names(nvarin), ipki(nvarin), id_varin(nvarin), stypvar(nvarin) ) cv_names(:) = getvarname(cf_zonal, nvarin, stypvar ) ipki(:) = getipk (cf_zonal, nvarin ) ! Open standard output with reclen 2048 for avoid wrapping with ifort OPEN(6,FORM='FORMATTED',RECL=2048) ! look for 1D var ( f(lat) ) nvar = 0 DO jvar = 1,nvarin ! skip variables such as nav_lon, nav_lat, time_counter deptht ... IF (ipki(jvar) == 0 .OR. ipki(jvar) > 1 ) THEN cv_names(jvar)='none' ELSE nvar = nvar + 1 ! count for elligible input variables id_varin(nvar) = jvar ! use indirect adressing for those variables ENDIF END DO WRITE(6,*) 'Number of 1D variables :', nvar DO jvar=1,nvar ivar=id_varin(jvar) WRITE(6,*) ' ',TRIM(cv_names(ivar)) ENDDO npjglo = getdim (cf_zonal,cn_y) npt = getdim (cf_zonal,cn_t) WRITE(6,*) 'npjglo =', npjglo WRITE(6,*) 'npt =', npt ! Allocate arrays ALLOCATE ( zv(1,npjglo,nvar), tim(npt) ) ALLOCATE ( zdumlat(1,npjglo) ) zdumlat(:,:) = getvar (cf_zonal, 'nav_lat', 1, 1, npjglo) tim(:) = getvar1d(cf_zonal, cn_vtimec, npt ) DO jt = 1, npt ! time loop ! main elligible variable loop DO jvar = 1, nvar ivar = id_varin(jvar) zv(:,:,jvar) = getvar(cf_zonal, cv_names(ivar), 1, 1, npjglo, ktime=jt) END DO ! next variable WRITE(6,*) ' JT = ', jt, ' TIME = ', tim(jt) WRITE(6,*) ' J LAT ', (TRIM(cv_names(id_varin(jvar))),' ',jvar=1,nvar) DO jj=npjglo,1,-1 WRITE(6,*) jj, zdumlat(1,jj), zv(1,jj,1:nvar) ENDDO ENDDO END PROGRAM cdfzonalout cdftools-3.0/Makefile0000644000175000017500000004422712241227304015771 0ustar amckinstryamckinstry# Makefile for CDFTOOLS_3.0 # ( make.macro is a link that points to the file macro.xxx where # xxx is representative of your machine ) # !!---------------------------------------------------------------------- # !! CDFTOOLS_3.0 , MEOM 2011 # !! $Id$ # !! Copyright (c) 2010, J.-M. Molines # !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) # !!---------------------------------------------------------------------- include make.macro BINDIR = ./bin VPATH = $(BINDIR) EXEC = cdfmoy cdfmoyt cdfstd cdfmoy_weighted cdfmoy_freq cdfvT \ cdfvsig cdfspeed cdfsum\ cdfmoyuvwt \ cdfeke cdfrmsssh cdfstdevw cdfstdevts cdflinreg cdfimprovechk\ cdfstats \ cdfbn2 cdfrichardson cdfsig0 cdfsigi cdfsiginsitu cdfbottomsig cdfbotpressure cdfspice\ cdfbottom cdfets cdfokubo-w cdfcurl cdfw cdfgeo-uv cdfmxl \ cdfrhoproj cdfzisot cdfsigintegr cdfpvor \ cdfmhst cdfvhst cdfvtrp cdftransport cdfvFWov \ cdfsigtrp cdftempvol-full\ cdfpsi cdfmoc cdfmocsig cdfmean \ cdfheatc cdfzonalmean cdfhflx cdfwflx cdfbuoyflx\ cdfmxlheatc cdfmxlsaltc cdfmxlhcsc cdfvertmean cdfvint \ cdfpendep cdfzonalsum cdficediags cdfzonalout\ cdfprofile cdfwhereij cdffindij cdfweight cdfmaxmoc cdfcensus cdfzoom cdfmax cdfprobe cdfinfo \ cdf16bit cdfvita cdfvita-geo cdfconvert cdfflxconv cdfclip cdfsstconv cdfstrconv cdfbathy cdfvar \ cdfcsp cdfcoloc cdfmltmask cdfstatcoord cdfpolymask cdfsmooth cdfmkmask cdfdifmask\ cdfkempemekeepe cdfbci cdfbti cdfnrjcomp cdfcofdis cdfsections cdfnorth_unfold cdfovide cdfmppini\ cdf2levitusgrid2d \ cdfpsi_level cdfhdy cdfhdy3d cdffracinv cdfmaskdmp cdfnan cdfscale cdfnamelist \ cdfisopsi cdf2matlab cdffixtime cdfgeostrophy cdfchgrid cdfcmp .PHONY: all help clean cleanexe install man installman all: $(EXEC) help: @echo "#-------------------------------------------------" @echo "# List of make targets:" @echo "# all : build cdftools binary" @echo "# man : build manual" @echo "# clean : remove building object (.o, .mod...)" @echo "# cleanexe : remove binary executable" @echo "# install : install binary in INSTALL folder" @echo "# install_man : install manual in INSTALL_MAN folder" @echo "#-------------------------------------------------" ## Statistical programs cdfmoy: cdfio.o cdfmoy.f90 $(F90) cdfmoy.f90 -o $(BINDIR)/cdfmoy cdfio.o modcdfnames.o $(FFLAGS) cdfmoyt: cdfio.o cdfmoyt.f90 $(F90) cdfmoyt.f90 -o $(BINDIR)/cdfmoyt cdfio.o modcdfnames.o $(FFLAGS) cdfmoy_freq: cdfio.o cdfmoy_freq.f90 $(F90) cdfmoy_freq.f90 -o $(BINDIR)/cdfmoy_freq cdfio.o modcdfnames.o $(FFLAGS) cdfmoyuvwt: cdfio.o cdfmoyuvwt.f90 $(F90) cdfmoyuvwt.f90 -o $(BINDIR)/cdfmoyuvwt cdfio.o modcdfnames.o $(FFLAGS) cdfstd: cdfio.o cdfstd.f90 $(F90) cdfstd.f90 -o $(BINDIR)/cdfstd cdfio.o modcdfnames.o $(FFLAGS) cdfmoy_weighted: cdfio.o cdfmoy_weighted.f90 $(F90) cdfmoy_weighted.f90 -o $(BINDIR)/cdfmoy_weighted cdfio.o modcdfnames.o $(FFLAGS) cdfeke: cdfio.o cdfeke.f90 $(F90) cdfeke.f90 -o $(BINDIR)/cdfeke cdfio.o modcdfnames.o $(FFLAGS) cdfrmsssh: cdfio.o cdfrmsssh.f90 $(F90) cdfrmsssh.f90 -o $(BINDIR)/cdfrmsssh cdfio.o modcdfnames.o $(FFLAGS) cdfstdevw: cdfio.o cdfstdevw.f90 $(F90) cdfstdevw.f90 -o $(BINDIR)/cdfstdevw cdfio.o modcdfnames.o $(FFLAGS) cdfstdevts: cdfio.o cdfstdevts.f90 $(F90) cdfstdevts.f90 -o $(BINDIR)/cdfstdevts cdfio.o modcdfnames.o $(FFLAGS) cdfvT: cdfio.o modutils.o cdfvT.f90 $(F90) cdfvT.f90 -o $(BINDIR)/cdfvT cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdfvsig: cdfio.o eos.o modutils.o cdfvsig.f90 $(F90) cdfvsig.f90 -o $(BINDIR)/cdfvsig cdfio.o eos.o modcdfnames.o modutils.o $(FFLAGS) cdfspeed: cdfio.o cdfspeed.f90 $(F90) cdfspeed.f90 -o $(BINDIR)/cdfspeed cdfio.o modcdfnames.o $(FFLAGS) cdfimprovechk: cdfio.o cdfimprovechk.f90 $(F90) cdfimprovechk.f90 -o $(BINDIR)/cdfimprovechk cdfio.o modcdfnames.o $(FFLAGS) cdfstats: cdfio.o cdfstats.f90 $(F90) cdfstats.f90 -o $(BINDIR)/cdfstats cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdflinreg: cdfio.o cdflinreg.f90 $(F90) cdflinreg.f90 -o $(BINDIR)/cdflinreg cdfio.o modcdfnames.o $(FFLAGS) ## Derived quantities programs cdfbn2: cdfio.o eos.o cdfbn2.f90 $(F90) cdfbn2.f90 -o $(BINDIR)/cdfbn2 cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfrichardson: cdfio.o eos.o cdfrichardson.f90 $(F90) cdfrichardson.f90 -o $(BINDIR)/cdfrichardson cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfsig0: cdfio.o eos.o cdfsig0.f90 $(F90) cdfsig0.f90 -o $(BINDIR)/cdfsig0 cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfspice: cdfio.o eos.o cdfspice.f90 $(F90) cdfspice.f90 -o $(BINDIR)/cdfspice cdfio.o modcdfnames.o $(FFLAGS) cdfsigi: cdfio.o eos.o cdfsigi.f90 $(F90) cdfsigi.f90 -o $(BINDIR)/cdfsigi cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfsiginsitu: cdfio.o eos.o cdfsiginsitu.f90 $(F90) cdfsiginsitu.f90 -o $(BINDIR)/cdfsiginsitu cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfbottomsig: cdfio.o eos.o cdfbottomsig.f90 $(F90) cdfbottomsig.f90 -o $(BINDIR)/cdfbottomsig cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfbotpressure: cdfio.o eos.o modutils.o cdfbotpressure.f90 $(F90) cdfbotpressure.f90 -o $(BINDIR)/cdfbotpressure cdfio.o eos.o modcdfnames.o modutils.o $(FFLAGS) cdfbottom: cdfio.o cdfbottom.f90 $(F90) cdfbottom.f90 -o $(BINDIR)/cdfbottom cdfio.o modcdfnames.o $(FFLAGS) cdfets: cdfio.o eos.o cdfets.f90 $(F90) cdfets.f90 -o $(BINDIR)/cdfets cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfokubo-w: cdfio.o cdfokubo-w.f90 $(F90) cdfokubo-w.f90 -o $(BINDIR)/cdfokubo-w cdfio.o modcdfnames.o $(FFLAGS) cdfmsk: cdfio.o cdfmsk.f90 $(F90) cdfmsk.f90 -o $(BINDIR)/cdfmsk cdfio.o modcdfnames.o $(FFLAGS) cdfmkmask: cdfio.o cdfmkmask.f90 $(F90) cdfmkmask.f90 -o $(BINDIR)/cdfmkmask cdfio.o modcdfnames.o $(FFLAGS) cdfmltmask: cdfio.o cdfmltmask.f90 $(F90) cdfmltmask.f90 -o $(BINDIR)/cdfmltmask cdfio.o modcdfnames.o $(FFLAGS) cdfdifmask: cdfio.o cdfdifmask.f90 $(F90) cdfdifmask.f90 -o $(BINDIR)/cdfdifmask cdfio.o modcdfnames.o $(FFLAGS) cdfcurl: cdfio.o cdfcurl.f90 $(F90) cdfcurl.f90 -o $(BINDIR)/cdfcurl cdfio.o modcdfnames.o $(FFLAGS) cdfw: cdfio.o cdfw.f90 $(F90) cdfw.f90 -o $(BINDIR)/cdfw cdfio.o modcdfnames.o $(FFLAGS) cdfgeo-uv: cdfio.o cdfgeo-uv.f90 $(F90) cdfgeo-uv.f90 -o $(BINDIR)/cdfgeo-uv cdfio.o modcdfnames.o $(FFLAGS) cdfgeostrophy: cdfio.o eos.o cdfgeostrophy.f90 $(F90) cdfgeostrophy.f90 -o $(BINDIR)/cdfgeostrophy cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfmxl: cdfio.o eos.o cdfmxl.f90 $(F90) cdfmxl.f90 -o $(BINDIR)/cdfmxl cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfrhoproj: cdfio.o cdfrhoproj.f90 $(F90) cdfrhoproj.f90 -o $(BINDIR)/cdfrhoproj cdfio.o modcdfnames.o $(FFLAGS) cdfzisot: cdfio.o cdfzisot.f90 $(F90) cdfzisot.f90 -o $(BINDIR)/cdfzisot cdfio.o modcdfnames.o $(FFLAGS) cdfsigintegr: cdfio.o modutils.o cdfsigintegr.f90 $(F90) cdfsigintegr.f90 -o $(BINDIR)/cdfsigintegr cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdfisopsi: cdfio.o eos.o cdfisopsi.f90 $(F90) cdfisopsi.f90 -o $(BINDIR)/cdfisopsi cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfpvor: eos.o cdfio.o cdfpvor.f90 $(F90) cdfpvor.f90 -o $(BINDIR)/cdfpvor cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfkempemekeepe: cdfio.o cdfkempemekeepe.f90 $(F90) cdfkempemekeepe.f90 -o $(BINDIR)/cdfkempemekeepe cdfio.o modcdfnames.o $(FFLAGS) cdfbci: cdfio.o cdfbci.f90 $(F90) cdfbci.f90 -o $(BINDIR)/cdfbci cdfio.o modcdfnames.o $(FFLAGS) cdfbti: cdfio.o cdfbti.f90 $(F90) cdfbti.f90 -o $(BINDIR)/cdfbti cdfio.o modcdfnames.o $(FFLAGS) cdfnrjcomp: cdfio.o cdfnrjcomp.f90 $(F90) cdfnrjcomp.f90 -o $(BINDIR)/cdfnrjcomp cdfio.o modcdfnames.o $(FFLAGS) cdfhdy: cdfio.o eos.o cdfhdy.f90 $(F90) cdfhdy.f90 -o $(BINDIR)/cdfhdy cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfhdy3d: cdfio.o eos.o cdfhdy3d.f90 $(F90) cdfhdy3d.f90 -o $(BINDIR)/cdfhdy3d cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfmaskdmp: cdfio.o eos.o cdfmaskdmp.f90 $(F90) cdfmaskdmp.f90 -o $(BINDIR)/cdfmaskdmp cdfio.o eos.o modcdfnames.o $(FFLAGS) ## Transport programs cdfmhst: cdfio.o cdfmhst.f90 $(F90) cdfmhst.f90 -o $(BINDIR)/cdfmhst cdfio.o modcdfnames.o $(FFLAGS) cdfvhst: cdfio.o cdfvhst.f90 $(F90) cdfvhst.f90 -o $(BINDIR)/cdfvhst cdfio.o modcdfnames.o $(FFLAGS) cdfvtrp: cdfio.o cdfvtrp.f90 $(F90) cdfvtrp.f90 -o $(BINDIR)/cdfvtrp cdfio.o modcdfnames.o $(FFLAGS) cdfpsi: cdfio.o modutils.o cdfpsi.f90 $(F90) cdfpsi.f90 -o $(BINDIR)/cdfpsi cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdfpsi_level: cdfio.o cdfpsi_level.f90 $(F90) cdfpsi_level.f90 -o $(BINDIR)/cdfpsi_level cdfio.o modcdfnames.o $(FFLAGS) cdftransport: cdfio.o modutils.o cdftransport.f90 $(F90) cdftransport.f90 -o $(BINDIR)/cdftransport cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdfvFWov: cdfio.o modutils.o cdfvFWov.f90 $(F90) cdfvFWov.f90 -o $(BINDIR)/cdfvFWov cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdfsigtrp: cdfio.o eos.o modutils.o cdfsigtrp.f90 $(F90) cdfsigtrp.f90 -o $(BINDIR)/cdfsigtrp cdfio.o eos.o modcdfnames.o modutils.o $(FFLAGS) cdftransig_xy3d: cdfio.o eos.o modutils.o cdftransig_xy3d.f90 $(F90) cdftransig_xy3d.f90 -o $(BINDIR)/cdftransig_xy3d cdfio.o eos.o modcdfnames.o modutils.o $(FFLAGS) cdftempvol-full: cdfio.o cdftempvol-full.f90 $(F90) cdftempvol-full.f90 -o $(BINDIR)/cdftempvol-full cdfio.o modcdfnames.o $(FFLAGS) cdfmoc: cdfio.o eos.o cdftools.o cdfmoc.f90 $(F90) cdfmoc.f90 -o $(BINDIR)/cdfmoc cdfio.o eos.o modcdfnames.o cdftools.o $(FFLAGS) cdfmht_gsop: cdfio.o eos.o cdfmht_gsop.f90 $(F90) cdfmht_gsop.f90 -o $(BINDIR)/cdfmht_gsop cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfmoc_rapid_26N_r8_ORCA025: cdfio.o eos.o cdfmoc_rapid_26N_r8_ORCA025.f90 $(F90) cdfmoc_rapid_26N_r8_ORCA025.f90 -o $(BINDIR)/cdfmoc_rapid_26N_r8_ORCA025 cdfio.o eos.o $(FFLAGS) cdfmocsig: cdfio.o eos.o modutils.o cdfmocsig.f90 $(F90) cdfmocsig.f90 -o $(BINDIR)/cdfmocsig cdfio.o eos.o modcdfnames.o modutils.o $(FFLAGS) cdfmean: cdfio.o cdfmean.f90 $(F90) cdfmean.f90 -o $(BINDIR)/cdfmean cdfio.o modcdfnames.o $(FFLAGS) cdfsum: cdfio.o cdfsum.f90 $(F90) cdfsum.f90 -o $(BINDIR)/cdfsum cdfio.o modcdfnames.o $(FFLAGS) cdfvertmean: cdfio.o modutils.o cdfvertmean.f90 $(F90) cdfvertmean.f90 -o $(BINDIR)/cdfvertmean cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdfvint: cdfio.o modutils.o cdfvint.f90 $(F90) cdfvint.f90 -o $(BINDIR)/cdfvint cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdfheatc: cdfio.o modutils.o cdfheatc.f90 $(F90) cdfheatc.f90 -o $(BINDIR)/cdfheatc cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdfmxlheatc: cdfio.o modutils.o cdfmxlheatc.f90 $(F90) cdfmxlheatc.f90 -o $(BINDIR)/cdfmxlheatc cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdfmxlsaltc: cdfio.o modutils.o cdfmxlsaltc.f90 $(F90) cdfmxlsaltc.f90 -o $(BINDIR)/cdfmxlsaltc cdfio.o modcdfnames.o modutils.o $(FFLAGS) cdfmxlhcsc: cdfio.o eos.o cdfmxlhcsc.f90 $(F90) cdfmxlhcsc.f90 -o $(BINDIR)/cdfmxlhcsc cdfio.o eos.o modcdfnames.o $(FFLAGS) cdficediags: cdfio.o cdficediags.f90 $(F90) cdficediags.f90 -o $(BINDIR)/cdficediags cdfio.o modcdfnames.o $(FFLAGS) cdfzonalmean: cdfio.o cdfzonalmean.f90 $(F90) cdfzonalmean.f90 -o $(BINDIR)/cdfzonalmean cdfio.o modcdfnames.o $(FFLAGS) cdfzonalsum: cdfio.o cdfzonalsum.f90 $(F90) cdfzonalsum.f90 -o $(BINDIR)/cdfzonalsum cdfio.o modcdfnames.o $(FFLAGS) cdfzonalout: cdfio.o cdfzonalout.f90 $(F90) cdfzonalout.f90 -o $(BINDIR)/cdfzonalout cdfio.o modcdfnames.o $(FFLAGS) cdfhflx: cdfio.o cdfhflx.f90 $(F90) cdfhflx.f90 -o $(BINDIR)/cdfhflx cdfio.o modcdfnames.o $(FFLAGS) cdfwflx: cdfio.o cdfwflx.f90 $(F90) cdfwflx.f90 -o $(BINDIR)/cdfwflx cdfio.o modcdfnames.o $(FFLAGS) cdfbuoyflx: cdfio.o eos.o cdfbuoyflx.f90 $(F90) cdfbuoyflx.f90 -o $(BINDIR)/cdfbuoyflx cdfio.o eos.o modcdfnames.o $(FFLAGS) ## Extracting tools, information tools cdfprofile: cdfio.o cdfprofile.f90 $(F90) cdfprofile.f90 -o $(BINDIR)/cdfprofile cdfio.o modcdfnames.o $(FFLAGS) cdfwhereij:cdfio.o cdfwhereij.f90 $(F90) cdfwhereij.f90 -o $(BINDIR)/cdfwhereij cdfio.o modcdfnames.o $(FFLAGS) cdffindij: cdfio.o cdftools.o cdffindij.f90 $(F90) cdffindij.f90 -o $(BINDIR)/cdffindij cdfio.o cdftools.o modcdfnames.o $(FFLAGS) cdf_use_lib: cdftools.o cdf_use_lib.f90 $(F90) cdf_use_lib.f90 -o $(BINDIR)/cdf_use_lib cdfio.o cdftools.o $(FFLAGS) cdfweight: cdfio.o cdftools.o cdfweight.f90 $(F90) cdfweight.f90 -o $(BINDIR)/cdfweight cdfio.o cdftools.o modcdfnames.o $(FFLAGS) cdfweight2D: cdfio.o cdfweight2D.f90 $(F90) cdfweight2D.f90 -o $(BINDIR)/cdfweight2D cdfio.o $(FFLAGS) cdfcoloc: cdfio.o cdfcoloc.f90 $(F90) cdfcoloc.f90 -o $(BINDIR)/cdfcoloc cdfio.o modcdfnames.o $(FFLAGS) cdfcoloc2D: cdfio.o cdfcoloc2D.f90 $(F90) cdfcoloc2D.f90 -o $(BINDIR)/cdfcoloc2D cdfio.o $(FFLAGS) cdfcoloc2: cdfio.o cdfcoloc2.f90 $(F90) cdfcoloc2.f90 -o $(BINDIR)/cdfcoloc2 cdfio.o $(FFLAGS) cdfcoloc3: cdfio.o cdfcoloc3.f90 $(F90) cdfcoloc3.f90 -o $(BINDIR)/cdfcoloc3 cdfio.o $(FFLAGS) cdf2levitusgrid2d: cdfio.o cdftools.o modutils.o cdf2levitusgrid2d.f90 $(F90) cdf2levitusgrid2d.f90 -o $(BINDIR)/cdf2levitusgrid2d cdfio.o modcdfnames.o cdftools.o modutils.o $(FFLAGS) cdfstatcoord: cdfio.o cdfstatcoord.f90 $(F90) cdfstatcoord.f90 -o $(BINDIR)/cdfstatcoord cdfio.o modcdfnames.o $(FFLAGS) cdfmaxmoc: cdfio.o cdfmaxmoc.f90 $(F90) cdfmaxmoc.f90 -o $(BINDIR)/cdfmaxmoc cdfio.o modcdfnames.o $(FFLAGS) cdfcensus: cdfio.o eos.o cdfcensus.f90 $(F90) cdfcensus.f90 -o $(BINDIR)/cdfcensus cdfio.o eos.o modcdfnames.o $(FFLAGS) cdfzoom: cdfio.o cdfzoom.f90 $(F90) cdfzoom.f90 -o $(BINDIR)/cdfzoom cdfio.o modcdfnames.o $(FFLAGS) cdfmax: cdfio.o cdfmax.f90 $(F90) cdfmax.f90 -o $(BINDIR)/cdfmax cdfio.o modcdfnames.o $(FFLAGS) cdfprobe: cdfio.o cdfprobe.f90 $(F90) cdfprobe.f90 -o $(BINDIR)/cdfprobe cdfio.o modcdfnames.o $(FFLAGS) cdfinfo: cdfio.o cdfinfo.f90 $(F90) cdfinfo.f90 -o $(BINDIR)/cdfinfo cdfio.o modcdfnames.o $(FFLAGS) cdfclip: cdfio.o cdfclip.f90 $(F90) cdfclip.f90 -o $(BINDIR)/cdfclip cdfio.o modcdfnames.o $(FFLAGS) cdfsmooth: cdfio.o cdfsmooth.f90 $(F90) cdfsmooth.f90 -o $(BINDIR)/cdfsmooth cdfio.o modcdfnames.o $(FFLAGS) cdfpendep: cdfio.o cdfpendep.f90 $(F90) cdfpendep.f90 -o $(BINDIR)/cdfpendep cdfio.o modcdfnames.o $(FFLAGS) cdffracinv: cdfio.o cdffracinv.f90 $(F90) cdffracinv.f90 -o $(BINDIR)/cdffracinv cdfio.o modcdfnames.o $(FFLAGS) cdfzgrv3: cdfio.o cdfzgrv3.f90 $(F90) cdfzgrv3.f90 -o $(BINDIR)/cdfzgrv3 cdfio.o $(FFLAGS) ## reformating programs cdf16bit: cdfio.o cdf16bit.f90 $(F90) cdf16bit.f90 -o $(BINDIR)/cdf16bit cdfio.o modcdfnames.o $(FFLAGS) cdf2matlab: cdfio.o cdf2matlab.f90 $(F90) cdf2matlab.f90 -o $(BINDIR)/cdf2matlab cdfio.o modcdfnames.o $(FFLAGS) cdfvita: cdfio.o cdfvita.f90 $(F90) cdfvita.f90 -o $(BINDIR)/cdfvita cdfio.o modcdfnames.o $(FFLAGS) cdfvita-geo: cdfio.o cdfvita-geo.f90 $(F90) cdfvita-geo.f90 -o $(BINDIR)/cdfvita-geo cdfio.o modcdfnames.o $(FFLAGS) cdfconvert: cdfio.o cdfconvert.f90 $(F90) cdfconvert.f90 -o $(BINDIR)/cdfconvert cdfio.o modcdfnames.o $(FFLAGS) cdfflxconv: cdfio.o cdfflxconv.f90 $(F90) cdfflxconv.f90 -o $(BINDIR)/cdfflxconv cdfio.o modcdfnames.o $(FFLAGS) cdfsstconv: cdfio.o cdfsstconv.f90 $(F90) cdfsstconv.f90 -o $(BINDIR)/cdfsstconv cdfio.o modcdfnames.o $(FFLAGS) cdfstrconv: cdfio.o cdfstrconv.f90 $(F90) cdfstrconv.f90 -o $(BINDIR)/cdfstrconv cdfio.o modcdfnames.o $(FFLAGS) cdfbathy: cdfio.o cdfbathy.f90 $(F90) cdfbathy.f90 -o $(BINDIR)/cdfbathy cdfio.o modcdfnames.o $(FFLAGS) cdfcofdis: cdfio.o cdfcofdis.f90 $(F90) cdfcofdis.f90 -o $(BINDIR)/cdfcofdis cdfio.o modcdfnames.o $(FFLAGS) cdfcoastline: cdfio.o cdfcoastline.f90 $(F90) cdfcoastline.f90 -o $(BINDIR)/cdfcoastline cdfio.o modcdfnames.o $(FFLAGS) cdfvar: cdfbathy ln -sf cdfbathy $(BINDIR)/cdfvar cdfcsp: cdfio.o cdfcsp.f90 $(F90) cdfcsp.f90 -o $(BINDIR)/cdfcsp cdfio.o modcdfnames.o $(FFLAGS) cdfnan: cdfio.o cdfnan.f90 $(F90) cdfnan.f90 -o $(BINDIR)/cdfnan cdfio.o modcdfnames.o $(FFLAGS) cdfscale: cdfio.o cdfscale.f90 $(F90) cdfscale.f90 -o $(BINDIR)/cdfscale cdfio.o modcdfnames.o $(FFLAGS) cdfnorth_unfold: cdfio.o cdfnorth_unfold.f90 $(F90) cdfnorth_unfold.f90 -o $(BINDIR)/cdfnorth_unfold cdfio.o modcdfnames.o $(FFLAGS) cdfpolymask: cdfio.o modpoly.o cdfpolymask.f90 $(F90) cdfpolymask.f90 -o $(BINDIR)/cdfpolymask cdfio.o modpoly.o modcdfnames.o $(FFLAGS) cdfovide: cdfio.o cdfovide.f90 $(F90) cdfovide.f90 -o $(BINDIR)/cdfovide cdfio.o modcdfnames.o $(FFLAGS) cdfmppini: cdfio.o cdfmppini.f90 $(F90) cdfmppini.f90 -o $(BINDIR)/cdfmppini cdfio.o modcdfnames.o $(FFLAGS) cdffixtime: cdfio.o cdffixtime.f90 $(F90) cdffixtime.f90 -o $(BINDIR)/cdffixtime cdfio.o modcdfnames.o $(FFLAGS) cdfnamelist: modcdfnames.o cdfnamelist.f90 $(F90) cdfnamelist.f90 -o $(BINDIR)/cdfnamelist modcdfnames.o $(FFLAGS) $(FDATE_FLAG) cdfchgrid: cdfio.o cdfchgrid.f90 $(F90) cdfchgrid.f90 -o $(BINDIR)/cdfchgrid cdfio.o modcdfnames.o $(FFLAGS) cdfcmp: cdfio.o cdfcmp.f90 $(F90) cdfcmp.f90 -o $(BINDIR)/cdfcmp cdfio.o modcdfnames.o $(FFLAGS) # OLD bimg/dimg stuff: use by the trpsig monitoring.... cdfsections: eos.o cdfsections.f90 $(F90) cdfsections.f90 -o $(BINDIR)/cdfsections eos.o modcdfnames.o $(FFLAGS) ## Modules cdfio.o: cdfio.f90 modcdfnames.o $(F90) -c cdfio.f90 $(FFLAGS) eos.o: eos.f90 $(F90) -c eos.f90 $(FFLAGS) cdftools.o: cdfio.o cdftools.f90 $(F90) -c cdftools.f90 $(FFLAGS) modpoly.o: modpoly.f90 $(F90) -c modpoly.f90 $(FFLAGS) modcdfnames.o: modcdfnames.f90 $(F90) -c modcdfnames.f90 $(FFLAGS) modutils.o: cdfio.o modutils.f90 $(F90) -c modutils.f90 $(FFLAGS) ## Utilities clean: \rm -f *.mod *.o *~ *.1 *.opod cleanexe: clean ( cd $(BINDIR) ; \rm -f $(EXEC) ) man: cdftools.1 cdftools.1: cdftools.opod pod2man --center "CDFTOOLS / NEMO Documentation" \ --release "SVN Revision $$(LANG=C svn update | grep '^At rev' | awk '{print $$3}' | cut -f 1 -d '.')" \ cdftools.opod > cdftools.1 cdftools.opod: $(EXEC) cdftools-begin.pod cdftools-end.pod cat cdftools-begin.pod > cdftools.opod for s in $$( cd $(BINDIR); ls -1 ); do echo ''; echo "=head2 $$s"; echo ''; $$s; done >> cdftools.opod cat cdftools-end.pod >> cdftools.opod install: @mkdir -p $(INSTALL) cd bin ; \cp $(EXEC) $(INSTALL) installman: @mkdir -p $(INSTALL_MAN)/man1; \cp -f cdftools.1 $(INSTALL_MAN)/man1/; for s in $$( cd $(BINDIR); ls -1 ); do ( cd $(INSTALL_MAN)/man1/; ln -sf cdftools.1 $$s.1 ); done; cdftools-3.0/cdfsum.f900000644000175000017500000002237212241227304016127 0ustar amckinstryamckinstryPROGRAM cdfsum !!====================================================================== !! *** PROGRAM cdfsum *** !!===================================================================== !! ** Purpose : Compute the sum of a variable over the ocean, or !! part of the ocean !! !! ** Method : this code is for partial steps configuration !! sum = sum ( V * e1 *e2 * e3 *mask ) !! CAUTION : this version is still tricky, as it does not !! compute the same thing in case of forcing field or !! model field. Need clarification ( JMM) !! !! History : 2.1 : 11/2008 : P. Mathiot : Original code (from cdfmean) !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ik ! dummy loop index INTEGER(KIND=4) :: iimin=0, iimax=0 ! domain limitation for computation INTEGER(KIND=4) :: ijmin=0, ijmax=0 ! domain limitation for computation INTEGER(KIND=4) :: ikmin=0, ikmax=0 ! domain limitation for computation INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvpk ! vertical levels in working variable INTEGER(KIND=4) :: numout=10 ! logical unit REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1, e2, e3, zv ! metrics, velocity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! npiglo x npjglo REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdep ! depth REAL(KIND=8) :: dvol, dvol2d ! volume of the ocean/ layer REAL(KIND=8) :: dsurf ! surface of the ocean REAL(KIND=8) :: dsum, dsum2d ! global sum /layer sum REAL(KIND=8) :: dsumt ! global sum over time CHARACTER(LEN=256) :: cldum ! dummy string CHARACTER(LEN=256) :: cf_in ! file name CHARACTER(LEN=256) :: cv_dep ! depth name CHARACTER(LEN=256) :: cv_in ! variable name CHARACTER(LEN=20) :: cv_e1, cv_e2, cv_e3 ! name of the horiz/vert metrics CHARACTER(LEN=20) :: cv_msk ! name of mask variable CHARACTER(LEN=20) :: cvartype ! variable type LOGICAL :: lforcing ! forcing flag LOGICAL :: lchk ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfsum IN-file IN-var T| U | V | F | W ... ' PRINT *,' ... [imin imax jmin jmax kmin kmax] [-full ] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Computes the sum value of the field (3D, weighted)' PRINT *,' This sum can be optionally limited to a sub-area.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : netcdf input file.' PRINT *,' IN-var : netcdf variable to work with.' PRINT *,' T| U | V | F | W : C-grid point where IN-var is located.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [imin imax jmin jmax kmin kmax] : limit of the sub area to work with.' PRINT *,' if imin=0 all i are taken' PRINT *,' if jmin=0 all j are taken' PRINT *,' if kmin=0 all k are taken' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fhgr),', ',TRIM(cn_fzgr),' and ',TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' Standard output.' STOP ENDIF CALL getarg (1, cf_in) CALL getarg (2, cv_in) CALL getarg (3, cvartype) lchk = chkfile(cn_fhgr) lchk = chkfile(cn_fzgr) .OR. lchk lchk = chkfile(cn_fmsk) .OR. lchk lchk = chkfile(cf_in ) .OR. lchk IF ( lchk ) STOP ! missing file IF (narg > 3 ) THEN IF ( narg /= 9 ) THEN PRINT *, ' ERROR : You must give 6 optional values (imin imax jmin jmax kmin kmax)' STOP ELSE ! input optional iimin iimax ijmin ijmax CALL getarg ( 4,cldum) ; READ(cldum,*) iimin CALL getarg ( 5,cldum) ; READ(cldum,*) iimax CALL getarg ( 6,cldum) ; READ(cldum,*) ijmin CALL getarg ( 7,cldum) ; READ(cldum,*) ijmax CALL getarg ( 8,cldum) ; READ(cldum,*) ikmin CALL getarg ( 9,cldum) ; READ(cldum,*) ikmax ENDIF ENDIF npiglo = getdim (cf_in,cn_x) npjglo = getdim (cf_in,cn_y) npk = getdim (cf_in,cn_z) nvpk = getvdim(cf_in,cv_in) npt = getdim (cf_in,cn_t) IF (iimin /= 0 ) THEN ; npiglo = iimax - iimin + 1; ELSE ; iimin = 1 ; ENDIF IF (ijmin /= 0 ) THEN ; npjglo = ijmax - ijmin + 1; ELSE ; ijmin = 1 ; ENDIF IF (ikmin /= 0 ) THEN ; npk = ikmax - ikmin + 1; ELSE ; ikmin = 1 ; ENDIF IF (nvpk == 2 ) nvpk = 1 IF (nvpk == 3 ) nvpk = npk PRINT *, 'Size of the extracted area :' PRINT *, ' npiglo = ', npiglo PRINT *, ' npjglo = ', npjglo PRINT *, ' npk = ', npk PRINT *, ' nvpk = ', nvpk PRINT *, ' npt = ', npt lforcing=.FALSE. IF ( (npk == 0) ) THEN lforcing = .TRUE. npk = 1 PRINT *, 'W A R N I N G : you used a forcing field' END IF IF (lforcing) OPEN(unit=numout, file='cdfsum.txt' , form='formatted', status='new', iostat=ierr) ! Allocate arrays ALLOCATE ( zmask(npiglo,npjglo) ) ALLOCATE ( zv (npiglo,npjglo) ) ALLOCATE ( e1 (npiglo,npjglo), e2(npiglo,npjglo), e3(npiglo,npjglo) ) ALLOCATE ( gdep (npk) ) SELECT CASE (TRIM(cvartype)) CASE ( 'T' ) cv_e1 = cn_ve1t cv_e2 = cn_ve2t cv_e3 = 'e3t_ps' cv_msk = 'tmask' cv_dep = cn_gdept CASE ( 'U' ) cv_e1 = cn_ve1u cv_e2 = cn_ve2u cv_e3 = 'e3t_ps' cv_msk = 'umask' cv_dep = cn_gdept CASE ( 'V' ) cv_e1 = cn_ve1v cv_e2 = cn_ve2v cv_e3 = 'e3t_ps' cv_msk = 'vmask' cv_dep = cn_gdept CASE ( 'F' ) cv_e1 = cn_ve1f cv_e2 = cn_ve2f cv_e3 = 'e3t_ps' cv_msk = 'fmask' cv_dep = cn_gdept CASE ( 'W' ) cv_e1 = cn_ve1t cv_e2 = cn_ve2t cv_e3 = 'e3w_ps' cv_msk = 'tmask' cv_dep = cn_gdepw CASE DEFAULT PRINT *, 'this type of variable is not known :', TRIM(cvartype) STOP END SELECT e1(:,:) = getvar (cn_fhgr, cv_e1, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin) e2(:,:) = getvar (cn_fhgr, cv_e2, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin) gdep(:) = getvare3(cn_fzgr, cv_dep, npk ) dsumt = 0.d0 DO jt = 1,npt dvol = 0.d0 dsum = 0.d0 zv = 0. DO jk = 1,nvpk ik = jk + ikmin -1 ! Get velocities v at ik zv (:,:) = getvar(cf_in, cv_in, ik, npiglo, npjglo, ktime=jt, kimin=iimin, kjmin=ijmin) zmask(:,:) = getvar(cn_fmsk, cv_msk, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin) ! zmask(:,npjglo)=0. ! get e3 at level ik ( ps...) e3(:,:) = getvar(cn_fzgr, cv_e3, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ldiom=.TRUE.) ! IF (.NOT. lforcing) THEN dsurf = SUM(DBLE(e1 * e2 * zmask)) dvol2d = SUM(DBLE(e1 * e2 * e3 * zmask)) dvol = dvol + dvol2d dsum2d = SUM(DBLE(zv)) dsum = dsum + dsum2d IF (dvol2d /= 0 )THEN PRINT *, ' Sum value at level ', ik, '(',gdep(ik),' m) ', dsum2d ELSE PRINT *, ' No points in the water at level ', ik, '(',gdep(ik),' m) ' ENDIF ELSE dsurf = SUM(DBLE( e1 * e2 * zmask)) dsum2d = SUM(DBLE(zv * e1 * e2 * zmask)) dsum = dsum + dsum2d PRINT *, ' Sum value at time ',jt,' = ', dsum2d PRINT *, ' Surface = ', dsurf/1.d6,' km^2' PRINT *, ' mean value = ', dsum2d/dsurf WRITE (numout,'(i4," ",1e12.6)') jt, dsum2d END IF END DO dsumt = dsumt + dsum IF (.NOT. lforcing) PRINT * ,' Sum value over the ocean: ', dsum END DO ! time loop PRINT *, ' mean Sum over time ', dsumt/npt CLOSE(numout) END PROGRAM cdfsum cdftools-3.0/cdfvT.f900000644000175000017500000002401712241227304015712 0ustar amckinstryamckinstryPROGRAM cdfvT !!====================================================================== !! *** PROGRAM cdfvT *** !!===================================================================== !! ** Purpose : Compute the average values for the products !! V.T, V.S, U.T and U.S, used afterward for heat and !! salt transport. !! !! ** Method : pass the CONFIG name and a series of tags as arguments. !! !! History : 2.1 : 11/2004 : J.M. Molines : Original code !! 2.1 : 02/2010 : J.M. Molines : handle multiframes input files. !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic. !! : 10/2012 : M. Balmaseda : Split T and S file eventually !!---------------------------------------------------------------------- USE cdfio USE modcdfnames USE modutils ! SetFileName function !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jj, jk, jt, jtt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ntframe ! Cumul of time frame INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout ! level and varid's of output vars REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp, zsal ! Array to read a layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, zv ! Velocity component REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zworku, zworkv ! working arrays REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmean ! temporary mean value for netcdf write REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter of individual files REAL(KIND=4), DIMENSION(1) :: timean ! mean time REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulut, dcumulus ! Arrays for cumulated values REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulvt, dcumulvs ! Arrays for cumulated values REAL(KIND=8) :: dtotal_time ! cumulated time CHARACTER(LEN=256) :: cf_tfil ! T file name CHARACTER(LEN=256) :: cf_sfil ! S file name [default: idem T file] CHARACTER(LEN=256) :: cf_ufil ! zonal velocity file CHARACTER(LEN=256) :: cf_vfil ! meridional velocity file CHARACTER(LEN=256) :: cf_out='vt.nc' ! output file CHARACTER(LEN=256) :: config ! configuration name CHARACTER(LEN=256) :: ctag ! current tag to work with TYPE (variable), DIMENSION(4) :: stypvar ! structure for attributes LOGICAL :: lcaltmean ! flag for mean time computation !!---------------------------------------------------------------------- CALL ReadCdfNames() !! Read command line narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfvT CONFIG-CASE ''list_of_tags'' ' PRINT *,' PURPOSE :' PRINT *,' Compute the time average values for second order products ' PRINT *,' V.T, V.S, U.T and U.S used in heat and salt transport computation.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' CONFIG-CASE is the config name of a given experiment (eg ORCA025-G70)' PRINT *,' The program will look for gridT, gridU and gridV files for' PRINT *,' this config ( grid_T, grid_U and grid_V are also accepted).' PRINT *,' Additionaly, if gridS or grid_S file is found, it will be taken' PRINT *,' in place of gridT for the salinity variable.' PRINT *,' list_of_tags : a list of time tags that will be used for time' PRINT *,' averaging. e.g. y2000m01d05 y2000m01d10 ...' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : ',TRIM(cn_vozout),', ',TRIM(cn_vozous),', ',TRIM(cn_vomevt),' and ',TRIM(cn_vomevs) STOP ENDIF !! Initialisation from 1st file (all file are assume to have the same geometry) CALL getarg (1, config) CALL getarg (2, ctag ) cf_tfil = SetFileName( config, ctag, 'T') npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) ipk(:)= npk ! all variables (input and output are 3D) ! define output variables stypvar%rmissing_value = 0. stypvar%valid_min = -100. stypvar%valid_max = 100. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TZYX' stypvar(1)%cname = cn_vomevt ; stypvar(1)%cunits = 'm.DegC.s-1' stypvar(2)%cname = cn_vomevs ; stypvar(2)%cunits = 'm.PSU.s-1' stypvar(3)%cname = cn_vozout ; stypvar(3)%cunits = 'm.DegC.s-1' stypvar(4)%cname = cn_vozous ; stypvar(4)%cunits = 'm.PSU.s-1' stypvar(1)%clong_name = 'Meridional_VT' ; stypvar(1)%cshort_name = cn_vomevt stypvar(2)%clong_name = 'Meridional_VS' ; stypvar(2)%cshort_name = cn_vomevs stypvar(3)%clong_name = 'Zonal_UT' ; stypvar(3)%cshort_name = cn_vozout stypvar(4)%clong_name = 'Zonal_US' ; stypvar(4)%cshort_name = cn_vozous PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk ALLOCATE( dcumulut(npiglo,npjglo), dcumulus(npiglo,npjglo) ) ALLOCATE( dcumulvt(npiglo,npjglo), dcumulvs(npiglo,npjglo) ) ALLOCATE( zu(npiglo,npjglo), zv(npiglo,npjglo) ) ALLOCATE( zworku(npiglo,npjglo), zworkv(npiglo,npjglo) ) ALLOCATE( ztemp(npiglo,npjglo), zsal(npiglo,npjglo) ) ALLOCATE( zmean(npiglo,npjglo)) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk, ld_xycoo=.TRUE. ) ierr = createvar (ncout , stypvar, 4, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk, ld_xycoo=.TRUE. ) lcaltmean=.TRUE. DO jk = 1, npk PRINT *,'level ',jk dcumulut(:,:) = 0.d0 ; dcumulvt(:,:) = 0.d0 ; dtotal_time = 0.d0 dcumulus(:,:) = 0.d0 ; dcumulvs(:,:) = 0.d0 ; ntframe = 0 DO jt = 2, narg ! loop on tags CALL getarg (jt, ctag) cf_tfil = SetFileName( config, ctag, 'T', ld_stop=.TRUE. ) cf_sfil = SetFileName( config, ctag, 'S', ld_stop=.FALSE.) ! do not stop if gridS/grid_S not found ! IF ( chkfile (cf_sfil, ld_verbose=.FALSE.) ) cf_sfil = cf_tfil ! do not complain if not found npt = getdim (cf_tfil, cn_t) IF ( lcaltmean ) THEN ALLOCATE ( tim(npt) ) tim = getvar1d(cf_tfil, cn_vtimec, npt) dtotal_time = dtotal_time + SUM(tim(1:npt) ) DEALLOCATE( tim ) END IF ! assume U and V file have same time span ... cf_ufil = SetFileName( config, ctag, 'U' ) cf_vfil = SetFileName( config, ctag, 'V' ) DO jtt = 1, npt ! loop on time frame in a single file ntframe = ntframe+1 zu(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jtt ) zv(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jtt ) ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jtt ) zsal(:,:) = getvar(cf_sfil, cn_vosaline, jk, npiglo, npjglo, ktime=jtt ) ! temperature at u point, v points zworku(:,:) = 0. ; zworkv(:,:) = 0. DO ji=1, npiglo-1 DO jj = 1, npjglo -1 zworku(ji,jj) = 0.5 * ( ztemp(ji,jj) + ztemp(ji+1,jj) ) ! temper at Upoint zworkv(ji,jj) = 0.5 * ( ztemp(ji,jj) + ztemp(ji,jj+1) ) ! temper at Vpoint END DO END DO dcumulut(:,:) = dcumulut(:,:) + zworku(:,:) * zu(:,:)*1.d0 dcumulvt(:,:) = dcumulvt(:,:) + zworkv(:,:) * zv(:,:)*1.d0 ! salinity at u points, v points zworku(:,:) = 0. ; zworkv(:,:) = 0. DO ji=1, npiglo-1 DO jj = 1, npjglo -1 zworku(ji,jj) = 0.5 * ( zsal(ji,jj) + zsal(ji+1,jj) ) ! salinity at Upoint zworkv(ji,jj) = 0.5 * ( zsal(ji,jj) + zsal(ji,jj+1) ) ! salinity at Vpoint END DO END DO dcumulus(:,:) = dcumulus(:,:) + zworku(:,:) * zu(:,:)*1.d0 dcumulvs(:,:) = dcumulvs(:,:) + zworkv(:,:) * zv(:,:)*1.d0 END DO !jtt END DO ! jt ! finish with level jk ; compute mean (assume spval is 0 ) zmean(:,:) = dcumulvt(:,:)/ntframe ierr = putvar(ncout, id_varout(1), zmean, jk,npiglo, npjglo, kwght=ntframe ) zmean(:,:) = dcumulvs(:,:)/ntframe ierr = putvar(ncout, id_varout(2), zmean, jk,npiglo, npjglo, kwght=ntframe ) zmean(:,:) = dcumulut(:,:)/ntframe ierr = putvar(ncout, id_varout(3), zmean, jk,npiglo, npjglo, kwght=ntframe ) zmean(:,:) = dcumulus(:,:)/ntframe ierr = putvar(ncout, id_varout(4), zmean, jk,npiglo, npjglo, kwght=ntframe ) IF (lcaltmean ) THEN timean(1) = dtotal_time/ntframe ierr = putvar1d(ncout, timean, 1, 'T') END IF lcaltmean=.FALSE. ! tmean already computed END DO ! loop to next level ierr = closeout(ncout) END PROGRAM cdfvT cdftools-3.0/cdfprobe.f900000644000175000017500000000504312241227304016426 0ustar amckinstryamckinstryPROGRAM cdfprobe !!====================================================================== !! *** PROGRAM cdfprobe *** !!===================================================================== !! ** Purpose : Display time series of a variable at a given point !! !! !! History : 2.1 : 12/2006 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: iilook, ijlook, ilevel ! point to look at CHARACTER(LEN=256) :: cf_in, cldum , cv_in ! file name variable name !!---------------------------------------------------------------------- CALL ReadCdfNames() narg=iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfprobe IN-file ilook jlook cdfvar [level]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Display a 2 columns output time (in days), value.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : input file to look for' PRINT *,' ilook jlook : i,j position of the probe.' PRINT *,' cdfvar : name of the cdf variabled to be displayed' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [level] : This optional last argument is used' PRINT *,' to specify a model level, instead of first.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' 2 columns ( time , value ) ASCII output on display' PRINT *,' time are given in days since the begining of the run.' STOP ENDIF ! Browse command line CALL getarg(1, cf_in ) CALL getarg(2, cldum ) ; READ(cldum,*) iilook CALL getarg(3, cldum ) ; READ(cldum,*) ijlook CALL getarg(4, cv_in ) IF ( chkfile(cf_in) ) STOP ! missing file IF ( narg == 5 ) THEN CALL getarg(5, cldum) ; READ(cldum,*) ilevel CALL gettimeseries(cf_in, cv_in, iilook, ijlook, klev=ilevel) ELSE CALL gettimeseries(cf_in, cv_in, iilook, ijlook ) ENDIF END PROGRAM cdfprobe cdftools-3.0/cdfsigtrp.f900000644000175000017500000012442212241227304016632 0ustar amckinstryamckinstryPROGRAM cdfsigtrp !!====================================================================== !! *** PROGRAM cdfsigtrp *** !!====================================================================== !! ** Purpose : Compute density class Mass transport across a section. !! !! ** Method :- The begining and end point of the section are given in !! term of f-points index. !! - The program works for zonal or meridional sections. !! - The section definitions are given in an ASCII FILE !! dens_section.dat: !! foreach sections, 2 lines : !! (i) : section name (String, no blank) !! (ii) : imin imax jmin jmax for the section !! - Only vertical slices corrsponding to the sections are !! read in the files. !! - read metrics, depth, etc !! - read normal velocity (either vozocrtx oy vomecrty ) !! - read 2 rows of T and S ( i i+1 or j j+1 ) !! - compute the mean value at velocity point !! - compute sigma0 (can be easily modified for sigmai ) !! - compute the depths of isopyncal surfaces !! - compute the transport from surface to the isopycn !! - compute the transport in each class of density !! - compute the total transport (for information) !! !! History : 2.1 : 03/2006 : J.M. Molines : Original code !! : 07/2009 : R. Dussin : add cdf output !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! section_init : initialize section names and positions !! print_out : routine which performs standard output if required !! bimg_writ : routine which performs bimg output if required !!---------------------------------------------------------------------- USE cdfio USE eos ! for sigma0, sigmai USE modcdfnames ! for ReadCdfNames USE modutils ! for SetGlobalAtt !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: ji, jk, jclass, jsec ! dummy loop index INTEGER(KIND=4) :: jiso, jbin, jarg ! dummy loop index INTEGER(KIND=4) :: nbins ! number of density classes INTEGER(KIND=4) :: ipos ! working variable INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npk, nk ! vertical size, number of wet layers INTEGER(KIND=4) :: numbimg=10 ! optional bimg logical unit INTEGER(KIND=4) :: numout=11 ! ascii output INTEGER(KIND=4) :: nsection ! number of sections (overall) INTEGER(KIND=4) :: iimin, iimax ! working section limits INTEGER(KIND=4) :: ijmin, ijmax ! working section limits INTEGER(KIND=4) :: npts ! number of points in section INTEGER(KIND=4) :: ikx=1, iky=1 ! dims of netcdf output file INTEGER(KIND=4) :: nboutput=2 ! number of values to write in cdf output INTEGER(KIND=4) :: ncout, ierr ! for netcdf output INTEGER(KIND=4) :: iweight ! weight of input file for further averaging INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: iimina, iimaxa ! sections limits INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ijmina, ijmaxa ! sections limits INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! variable levels and id REAL(KIND=4) :: refdep =0.e0 ! reference depth (m) REAL(KIND=4), DIMENSION(1) :: tim ! time counter REAL(KIND=4), DIMENSION(1) :: rdummy1, rdummy2 ! working variable REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept, gdepw ! depth of T and W points REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: eu ! either e1v or e2u REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e3t1d, e3w1d ! vertical metrics in case of full step REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rlonlat ! longitudes/latitudes if the section REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zs, zt ! salinity and temperature from file REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon, rdumlat ! dummy longitude and latitude for output REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu ! velocity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: tmpm, tmpz ! temporary arrays ! double precision for cumulative variables and densities REAL(KIND=8) :: dsigma_min ! minimum density for bining REAL(KIND=8) :: dsigma_max, dltsig ! maximum density for bining, step REAL(KIND=8) :: dsigma, dalfa ! working sigma, interpolation coeff. REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dsigma_lev ! built array with sigma levels REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: de3 ! vertical metrics REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: ddepu ! depth of vel points REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsig ! density REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dhiso ! depth of isopycns REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwtrp, dwtrpbin ! transport arrays REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtrpbin ! transport arrays TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output CHARACTER(LEN=256) :: cf_tfil ! temperature salinity file CHARACTER(LEN=256) :: cf_ufil ! zonal velocity file CHARACTER(LEN=256) :: cf_vfil ! meridional velocity file CHARACTER(LEN=256) :: cf_section='dens_section.dat' ! input section file CHARACTER(LEN=256) :: cf_out='trpsig.txt' ! output ascii file CHARACTER(LEN=256) :: cf_bimg ! output bimg file (2d) CHARACTER(LEN=256) :: cf_nc ! output netcdf file (2d) CHARACTER(LEN=256) :: cf_outnc ! output netcdf file (1d, 0d)) CHARACTER(LEN=256) :: cv_dep ! depth variable CHARACTER(LEN=256) :: cldum ! dummy string CHARACTER(LEN=256) :: cglobal ! global attribute CHARACTER(LEN=80 ) :: cfmt_9000 ! format string CHARACTER(LEN=80 ) :: cfmt_9001 ! format string CHARACTER(LEN=80 ) :: cfmt_9002 ! format string CHARACTER(LEN=80 ) :: cfmt_9003 ! format string CHARACTER(LEN=256) :: cl_vnam, cl_lname ! working variables CHARACTER(LEN=256) :: csuffixvarname ! CHARACTER(LEN=256) :: cprefixlongname ! CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! names of input variables CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: csection ! section name CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarname ! output variable name (root) CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: clongname ! output long name (root) LOGICAL :: l_merid ! flag for meridional section LOGICAL :: ltemp =.FALSE. ! flag for extra print LOGICAL :: lprint =.FALSE. ! flag for extra print LOGICAL :: lbimg =.FALSE. ! flag for bimg output LOGICAL :: lncdf =.FALSE. ! flag for bimg output LOGICAL :: lfull =.FALSE. ! flag for bimg output LOGICAL :: lchk =.FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg < 6 ) THEN PRINT *,' usage : cdfsigtrp T-file U-file V-file sigma_min sigma_max nbins ...' PRINT *,' ... [-print ] [-bimg ] [-full ] [ -refdep ref_depth] ...' PRINT *,' ... [-section file ] [-temp ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute density class transports, according to the density class' PRINT *,' definition ( minimum, maximum and number of bins) given in arguments.' PRINT *,' Section position are given in ',TRIM(cf_section),', an ASCII file ' PRINT *,' with pairs of lines giving section name and section location as' PRINT *,' imin imax jmin jmax. Only zonal or meridional section are allowed.' PRINT *,' The name of this file can be specified with the -section option, if' PRINT *,' it differs from the standard name. Optionaly, a netcdf root variable ' PRINT *,' name and a netcdf root long-name can be provided on the line giving ' PRINT *,' the section name.' PRINT *,' ' PRINT *,' This program can also be used to compute transport by class of ' PRINT *,' temperatures, provided the temperatures decreases monotonically ' PRINT *,' downward. In this case, use -temp option and of course specify' PRINT *,' sigma_min, sigma_max as temperatures.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file with temperature and salinity' PRINT *,' U-file : netcdf file with zonal velocity component' PRINT *,' V-file : netcdf file with meridional velocity component' PRINT *,' sigma_min : minimum density for binning' PRINT *,' sigma_max : maximum density for binning' PRINT *,' nbins : number of bins. This will fix the bin ''width'' ' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [ -full ] : for full step configuration' PRINT *,' [ -bimg ] : produce extra bimg output file which shows the details' PRINT *,' of the sections (normal velocity, density, temperature, ' PRINT *,' salinity, transports, isopycnal depths. (to be change to ' PRINT *,' netcdf files for more common use.' PRINT *,' [ -ncdf ] : produce extra netcdf output file which shows the details' PRINT *,' of the sections (normal velocity, density, temperature, ' PRINT *,' salinity, transports, isopycnal depths. ' PRINT *,' [ -print ]: write the binned transports on standard output, for each' PRINT *,' sections.' PRINT *,' [ -refdep ref_depth ]: give a reference depths for the computation of' PRINT *,' potential density. Sigma_min, sigma_max must be adapted ' PRINT *,' accordingly.' PRINT *,' [ -section file] : give the name of section file.' PRINT *,' Default is ', TRIM(cf_section) PRINT *,' [ -temp ] : use temperature instead of density for binning' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fhgr),', ', TRIM(cn_fzgr),' and ', TRIM(cf_section) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' Netcdf file : There is 1 netcdf file per section. File name is build' PRINT *,' from section name : Section_name_trpsig.nc' PRINT *,' variables : sigma_class (upper limit of the bin)' PRINT *,' sigtrp : transport (Sv per bin)' PRINT *,' ' PRINT *,' ascii file : ', TRIM(cf_out) PRINT *,' ' PRINT *,' bimg file : There are 2 bimg files whose name is build from section' PRINT *,' name : section_name_trpdep.bimg and section_name_trpsig.bimg.' PRINT *,' This file is written only if -bimg option is used.' PRINT *,' ' PRINT *,' Standard output : the results are written on standard output only if ' PRINT *,' the -print option is used.' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfrhoproj, cdftransport, cdfsigintegr ' PRINT *,' ' STOP ENDIF ! browse command line ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg ) CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 SELECT CASE ( cldum ) CASE ( '-full' ) ; lfull = .TRUE. CASE ( '-bimg' ) ; lbimg = .TRUE. CASE ( '-ncdf' ) ; lncdf = .TRUE. CASE ( '-print') ; lprint = .TRUE. CASE ( '-temp') ; ltemp = .TRUE. CASE ( '-refdep' ) ; CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) refdep CASE ( '-section') ; CALL getarg(ijarg, cf_section ) ; ijarg=ijarg+1 CASE DEFAULT ireq=ireq+1 SELECT CASE ( ireq) CASE ( 1 ) ; cf_tfil = cldum CASE ( 2 ) ; cf_ufil = cldum CASE ( 3 ) ; cf_vfil = cldum CASE ( 4 ) ; READ(cldum,*) dsigma_min CASE ( 5 ) ; READ(cldum,*) dsigma_max CASE ( 6 ) ; READ(cldum,*) nbins CASE DEFAULT PRINT *,' Too many arguments ' ; STOP END SELECT END SELECT END DO ! check for file existence lchk = lchk .OR. chkfile( cn_fzgr ) lchk = lchk .OR. chkfile( cn_fhgr ) lchk = lchk .OR. chkfile( cf_section ) lchk = lchk .OR. chkfile( cf_tfil ) lchk = lchk .OR. chkfile( cf_ufil ) lchk = lchk .OR. chkfile( cf_vfil ) IF ( lchk ) STOP ! missing file IF ( ltemp) THEN ! temperature decrease downward. Change sign and swap min/max refdep = -10. ! flag value dltsig = dsigma_max ! use dltsig as dummy variable for swapping dsigma_max = -dsigma_min dsigma_min = -dltsig ENDIF ! define global attribute with command line CALL SetGlobalAtt( cglobal) ! get the attribute iweight from vozocrtx iweight = getatt(cf_ufil, cn_vozocrtx, 'iweight') IF ( iweight == 0 ) iweight = 1 ! if 0 means that it is not defined. ALLOCATE ( stypvar(nboutput), ipk(nboutput), id_varout(nboutput) ) ALLOCATE ( rdumlon(ikx,iky), rdumlat(ikx,iky) ) rdumlon(:,:)=0. rdumlat(:,:)=0. ipk(1)=nbins ! sigma for each level ipk(2)=nbins ! transport for each level ! initialisation of variable names etc... is done according to section name ! Initialise sections from file ! first call to get nsection and allocate arrays nsection = 0 ; CALL section_init(cf_section, csection,cvarname,clongname,iimina, iimaxa, ijmina, ijmaxa, nsection) ALLOCATE ( csection(nsection), cvarname(nsection), clongname(nsection) ) ALLOCATE ( iimina(nsection), iimaxa(nsection), ijmina(nsection),ijmaxa(nsection) ) CALL section_init(cf_section, csection,cvarname,clongname, iimina,iimaxa,ijmina,ijmaxa, nsection) ! Allocate and build sigma levels and section array ALLOCATE ( dsigma_lev (nbins+1) , dtrpbin(nsection,nbins) ) dsigma_lev(1)=dsigma_min dltsig=( dsigma_max - dsigma_min) / nbins DO jclass =2, nbins+1 dsigma_lev(jclass)= dsigma_lev(1) + (jclass-1) * dltsig END DO ! Look for vertical size of the domain npk = getdim (cf_tfil,cn_z) ALLOCATE ( gdept(npk), gdepw(npk) ) IF ( lfull ) ALLOCATE ( e3t1d(npk), e3w1d(npk)) ! read gdept, gdepw : it is OK even in partial cells, as we never use the bottom gdep gdept(:) = getvare3(cn_fzgr, cn_gdept, npk) gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk) IF ( lfull ) THEN e3t1d(:) = getvare3(cn_fzgr, cn_ve3t, npk) e3w1d(:) = getvare3(cn_fzgr, cn_ve3w, npk) ENDIF !! * Main loop on sections DO jsec=1,nsection iimin=iimina(jsec) ; iimax=iimaxa(jsec) ijmin=ijmina(jsec) ; ijmax=ijmaxa(jsec) IF (iimin == iimax ) THEN ! meridional section npts = ijmax - ijmin ! number of segments l_merid = .TRUE. ELSE IF ( ijmin == ijmax ) THEN ! zonal section npts = iimax - iimin ! number of segments l_merid = .FALSE. ELSE PRINT *,' Section ',TRIM(csection(jsec)),' is neither zonal nor meridional :(' PRINT *,' We skip this section .' CYCLE ENDIF ALLOCATE ( zu(npts,npk), zt(npts,npk), zs(npts,npk), dsig(npts,0:npk) ) ALLOCATE ( eu(npts), de3(npts,npk), ddepu(npts, 0:npk), zmask(npts,npk) ) ALLOCATE ( tmpm(1,npts,2), tmpz(npts,1,2) ) ALLOCATE ( dwtrp(npts, nbins+1), dhiso(npts,nbins+1), dwtrpbin(npts,nbins) ) ALLOCATE ( rlonlat(npts,1) ) zt = 0. ; zs = 0. ; zu = 0. ; ddepu= 0. ; zmask = 0. ; dsig=0.d0 IF (l_merid ) THEN ! meridional section at i=iimin=iimax tmpm(:,:,1) = getvar(cn_fhgr, cn_ve2u, 1, 1, npts, kimin=iimin, kjmin=ijmin+1) eu(:) = tmpm(1,:,1) ! metrics varies only horizontally tmpm(:,:,1) = getvar(cn_fhgr, cn_vlat2d, 1, 1, npts, kimin=iimin, kjmin=ijmin+1) rlonlat(:,1) = tmpm(1,:,1) ! latitude in this case DO jk = 1,npk ! initiliaze ddepu to gdept() ddepu(:,jk) = gdept(jk) IF ( lfull ) THEN de3(:,jk) = e3t1d(jk) tmpm(1,:,1) = e3w1d(jk) tmpm(1,:,2) = e3w1d(jk) ELSE ! vertical metrics (PS case) tmpm(:,:,1) = getvar(cn_fzgr, 'e3u_ps', jk, 1, npts, kimin=iimin, kjmin=ijmin+1, ldiom=.TRUE.) de3(:,jk) = tmpm(1,:,1) tmpm(:,:,1) = getvar(cn_fzgr, 'e3w_ps', jk, 1, npts, kimin=iimin, kjmin=ijmin+1, ldiom=.TRUE.) tmpm(:,:,2) = getvar(cn_fzgr, 'e3w_ps', jk, 1, npts, kimin=iimin+1, kjmin=ijmin+1, ldiom=.TRUE.) ENDIF IF (jk >= 2 ) THEN DO ji=1,npts ddepu(ji,jk)= ddepu(ji,jk-1) + MIN(tmpm(1,ji,1), tmpm(1,ji,2)) END DO ENDIF ! Normal velocity tmpm(:,:,1) = getvar(cf_ufil,cn_vozocrtx,jk,1,npts, kimin=iimin, kjmin=ijmin+1) zu(:,jk) = tmpm(1,:,1) ! salinity and deduce umask for the section tmpm(:,:,1) = getvar(cf_tfil,cn_vosaline,jk,1,npts, kimin=iimin , kjmin=ijmin+1) tmpm(:,:,2) = getvar(cf_tfil,cn_vosaline,jk,1,npts, kimin=iimin+1, kjmin=ijmin+1) zmask(:,jk) = tmpm(1,:,1)*tmpm(1,:,2) WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1 ! do not take special care for land value, as the corresponding velocity point is masked zs(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) ) ! limitation to 'wet' points IF ( SUM(zs(:,jk)) == 0 ) THEN nk=jk ! first vertical point of the section full on land EXIT ! as soon as all the points are on land ENDIF ! temperature tmpm(:,:,1) = getvar(cf_tfil, cn_votemper, jk, 1, npts, kimin=iimin, kjmin=ijmin+1) tmpm(:,:,2) = getvar(cf_tfil, cn_votemper, jk, 1, npts, kimin=iimin+1, kjmin=ijmin+1) zt(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) ) END DO ELSE ! zonal section at j=ijmin=ijmax tmpz(:,:,1) = getvar(cn_fhgr, cn_ve1v, 1, npts, 1, kimin=iimin, kjmin=ijmin) eu(:) = tmpz(:,1,1) tmpz(:,:,1) = getvar(cn_fhgr, cn_vlon2d, 1, npts, 1, kimin=iimin, kjmin=ijmin) rlonlat(:,1) = tmpz(:,1,1) ! longitude in this case DO jk=1,npk ! initiliaze ddepu to gdept() ddepu(:,jk) = gdept(jk) IF ( lfull ) THEN de3(:,jk) = e3t1d(jk) tmpm(:,1,1) = e3w1d(jk) tmpm(:,1,2) = e3w1d(jk) ELSE ! vertical metrics (PS case) tmpz(:,:,1)=getvar(cn_fzgr,'e3v_ps',jk, npts, 1, kimin=iimin+1, kjmin=ijmin, ldiom=.TRUE.) de3(:,jk) = tmpz(:,1,1) tmpz(:,:,1)=getvar(cn_fzgr,'e3w_ps',jk,npts,1, kimin=iimin+1, kjmin=ijmin, ldiom=.TRUE.) tmpz(:,:,2)=getvar(cn_fzgr,'e3w_ps',jk,npts,1, kimin=iimin+1, kjmin=ijmin+1, ldiom=.TRUE.) ENDIF IF (jk >= 2 ) THEN DO ji=1,npts ddepu(ji,jk)= ddepu(ji,jk-1) + MIN(tmpz(ji,1,1), tmpz(ji,1,2)) END DO ENDIF ! Normal velocity tmpz(:,:,1)=getvar(cf_vfil,cn_vomecrty,jk,npts,1, kimin=iimin+1, kjmin=ijmin) zu(:,jk)=tmpz(:,1,1) ! salinity and mask tmpz(:,:,1)=getvar(cf_tfil,cn_vosaline,jk, npts, 1, kimin=iimin+1, kjmin=ijmin) tmpz(:,:,2)=getvar(cf_tfil,cn_vosaline,jk, npts, 1, kimin=iimin+1, kjmin=ijmin+1) zmask(:,jk)=tmpz(:,1,1)*tmpz(:,1,2) WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1 ! do not take special care for land value, as the corresponding velocity point is masked zs(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) ) ! limitation to 'wet' points IF ( SUM(zs(:,jk)) == 0 ) THEN nk=jk ! first vertical point of the section full on land EXIT ! as soon as all the points are on land ENDIF ! temperature tmpz(:,:,1)=getvar(cf_tfil,cn_votemper,jk, npts, 1, kimin=iimin+1, kjmin=ijmin) tmpz(:,:,2)=getvar(cf_tfil,cn_votemper,jk, npts, 1, kimin=iimin+1, kjmin=ijmin+1) zt(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) ) END DO ENDIF ! compute density only for wet points IF ( refdep == -10. ) THEN dsig(:,1:nk)= -zt(:,:) ! change sign ELSEIF ( refdep == 0. ) THEN dsig(:,1:nk)=sigma0( zt, zs, npts, nk)*zmask(:,:) ELSE dsig(:,1:nk)=sigmai( zt, zs, refdep, npts, nk)*zmask(:,:) ENDIF dsig(:,0)=dsig(:,1)-1.e-4 ! dummy layer for easy interpolation ! compute depth of isopynals (nbins+1 ) DO jiso =1, nbins+1 dsigma=dsigma_lev(jiso) !!! REM : I and K loop can be inverted if necessary DO ji=1,npts dhiso(ji,jiso) = gdept(npk) DO jk=1,nk IF ( dsig(ji,jk) < dsigma ) THEN ELSE ! interpolate between jk-1 and jk dalfa=(dsigma - dsig(ji,jk-1)) / ( dsig(ji,jk) -dsig(ji,jk-1) ) IF (ABS(dalfa) > 1.1 .OR. dalfa < 0 ) THEN ! case dsig(0) = dsig(1)-1.e-4 dhiso(ji,jiso)= 0.d0 ELSE dhiso(ji,jiso)= ddepu(ji,jk)*dalfa + (1.d0-dalfa)* ddepu(ji,jk-1) ENDIF EXIT ENDIF END DO END DO END DO ! compute transport between surface and isopycn DO jiso = 1, nbins + 1 dsigma=dsigma_lev(jiso) DO ji=1,npts dwtrp(ji,jiso) = 0.d0 DO jk=1, nk-1 IF ( gdepw(jk+1) < dhiso(ji,jiso) ) THEN dwtrp(ji,jiso)= dwtrp(ji,jiso) + eu(ji)*de3(ji,jk)*zu(ji,jk)*1.d0 ELSE ! last box ( fraction) dwtrp(ji,jiso)= dwtrp(ji,jiso) + eu(ji)*(dhiso(ji,jiso)-gdepw(jk))*zu(ji,jk)*1.d0 EXIT ! jk loop ENDIF END DO END DO END DO ! binned transport : difference between 2 isopycns DO jbin=1, nbins dsigma=dsigma_lev(jbin) DO ji=1, npts dwtrpbin(ji,jbin) = dwtrp(ji,jbin+1) - dwtrp(ji,jbin) END DO dtrpbin(jsec,jbin)=SUM(dwtrpbin(:,jbin) ) END DO ! output of the code for 1 section IF (lprint) CALL print_out(jsec) IF (lbimg ) CALL bimg_writ(jsec) IF (lncdf ) CALL cdf_writ(jsec) PRINT *,' Total transport in all bins :',TRIM(csection(jsec)),' ',SUM(dtrpbin(jsec,:) )/1.d6 ! free memory for the next section DEALLOCATE ( zu, zt, zs, dsig, ddepu, dhiso, dwtrp, dwtrpbin ) DEALLOCATE ( eu, de3, tmpm, tmpz, zmask, rlonlat ) END DO ! next section !! Global Output OPEN( numout, FILE=cf_out) ipos=INDEX(cf_tfil,'_gridT.nc') WRITE(numout,9006) TRIM(cf_tfil(1:ipos-1)) WRITE(numout,9005) ' sigma ', (csection(jsec),jsec=1,nsection) DO jiso=1,nbins WRITE(numout,9004) dsigma_lev(jiso), (dtrpbin(jsec,jiso),jsec=1,nsection) ENDDO CLOSE(numout) cv_dep='levels' ! need to call section_init again in order to reset cvarname, clongname if they where modified ! previously in cdf_writ( case lncdf=true ) IF (lncdf) THEN CALL section_init(cf_section, csection,cvarname,clongname, iimina,iimaxa,ijmina,ijmaxa, nsection) ENDIF DO jsec=1,nsection ! setup output variables (section dependant for adaptative variable name (if possible) ! define new variables for output IF ( cvarname(jsec) /= 'none' ) THEN csuffixvarname='_'//TRIM(cvarname(jsec)) ELSE csuffixvarname='' ENDIF IF ( clongname(jsec) /= 'none' ) THEN cprefixlongname=TRIM(clongname(jsec))//'_' ELSE cprefixlongname='' ENDIF stypvar%rmissing_value = 99999. stypvar%scale_factor = 1. stypvar%add_offset = 0. stypvar%savelog10 = 0. stypvar%iwght = iweight stypvar%conline_operation = 'N/A' stypvar%caxis = 'ZT' IF ( ltemp ) THEN stypvar(1)%cname = 'temp_class' stypvar(1)%cunits = '[]' stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 100. stypvar(1)%clong_name = 'class of potential temperature' stypvar(1)%cshort_name = 'temp_class' stypvar(2)%cname = 'temptrp'//TRIM(csuffixvarname) stypvar(2)%cunits = 'Sv' stypvar(2)%valid_min = -1000. stypvar(2)%valid_max = 1000. stypvar(2)%clong_name = TRIM(cprefixlongname)//'transport in temperature class' stypvar(2)%cshort_name = 'temptrp' ELSE stypvar(1)%cname = 'sigma_class' stypvar(1)%cunits = '[]' stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 100. stypvar(1)%clong_name = 'class of potential density' stypvar(1)%cshort_name = 'sigma_class' stypvar(2)%cname = 'sigtrp'//TRIM(csuffixvarname) stypvar(2)%cunits = 'Sv' stypvar(2)%valid_min = -1000. stypvar(2)%valid_max = 1000. stypvar(2)%clong_name = TRIM(cprefixlongname)//'transport in sigma class' stypvar(2)%cshort_name = 'sigtrp' ENDIF ! create output fileset IF (ltemp) THEN cf_outnc = TRIM(csection(jsec))//'_trptemp.nc' ELSE cf_outnc = TRIM(csection(jsec))//'_trpsig.nc' ENDIF ncout = create (cf_outnc, 'none', ikx, iky, nbins, cdep=cv_dep ) ierr = createvar (ncout, stypvar, nboutput, ipk, id_varout, cdglobal=TRIM(cglobal)) ierr = putheadervar(ncout, cf_tfil, ikx, iky, nbins, & & pnavlon=rdumlon, pnavlat=rdumlat, pdep=REAL(dsigma_lev), cdep=cv_dep ) tim = getvar1d(cf_tfil, cn_vtimec, 1 ) ierr = putvar1d(ncout, tim, 1, 'T') DO jiso=1,nbins rdummy1 = dsigma_lev(jiso) rdummy2 = dtrpbin(jsec,jiso)/1.d6 ! Sv ierr = putvar(ncout, id_varout(1), rdummy1, jiso, ikx, iky ) ierr = putvar(ncout, id_varout(2), rdummy2, jiso, ikx, iky ) END DO ierr = closeout(ncout) END DO 9004 FORMAT(f9.4, 20e16.7) 9005 FORMAT('#',a9, 20(2x,a12,2x) ) 9006 FORMAT('# ',a) CONTAINS SUBROUTINE section_init(cdfile, cdsection, cdvarname, cdlongname, kimin, kimax, kjmin, kjmax, knumber) !!--------------------------------------------------------------------- !! *** ROUTINE section_init *** !! !! ** Purpose : Read input ASCII file that defines section names and limit of !! sections. !! !! ** Method : At fisrt call only return the number of sections for further !! allocation. !! !!---------------------------------------------------------------------- CHARACTER(LEN=*), INTENT(in ) :: cdfile CHARACTER(LEN=256), DIMENSION(knumber), INTENT(out ) :: cdsection CHARACTER(LEN=256), DIMENSION(knumber), INTENT(out ) :: cdvarname CHARACTER(LEN=256), DIMENSION(knumber), INTENT(out ) :: cdlongname INTEGER(KIND=4), INTENT(inout) :: knumber INTEGER(KIND=4), DIMENSION(knumber), INTENT(out ) :: kimin, kimax, kjmin, kjmax ! Local variables INTEGER(KIND=4) :: jsec INTEGER(KIND=4) :: ii, inum=10 INTEGER(KIND=4) :: ipos CHARACTER(LEN=256) :: cline CHARACTER(LEN=80), DIMENSION(3) :: cldum LOGICAL :: llfirst !!---------------------------------------------------------------------- llfirst=.FALSE. IF ( knumber == 0 ) llfirst=.TRUE. OPEN(inum, FILE=cdfile) REWIND(inum) ii = 0 ! read the file just to count the number of sections DO READ(inum,'(a)') cline IF (INDEX(cline,'EOF') == 0 ) THEN READ(inum,*) ! skip one line ii = ii + 1 ELSE EXIT ENDIF END DO knumber=ii IF ( llfirst ) RETURN REWIND(inum) DO jsec=1,knumber READ(inum,'(a)') cline ii = 0 cldum(:) = 'none' ipos = index(cline,' ') DO WHILE ( ipos > 1 ) ii = ii + 1 cldum(ii) = cline(1:ipos - 1 ) cline = TRIM ( cline(ipos+1:) ) ipos = index( cline,' ' ) IF ( ii >= 3 ) EXIT END DO cdsection(jsec) = TRIM(cldum(1) ) cdvarname(jsec) = TRIM(cldum(2) ) cdlongname(jsec) = TRIM(cldum(3) ) READ(inum,* ) kimin(jsec), kimax(jsec), kjmin(jsec), kjmax(jsec) END DO CLOSE(inum) END SUBROUTINE section_init SUBROUTINE bimg_writ( ksec) !!--------------------------------------------------------------------- !! *** ROUTINE bimg_writ *** !! !! ** Purpose : Write output bimg files if required !! !! ** Method : Most of the variables are global !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: ksec ! number of the section INTEGER(KIND=4) :: ji, jk !!---------------------------------------------------------------------- ! (along section, depth ) 2D variables cf_bimg=TRIM(csection(ksec))//'_trpdep.bimg' OPEN(numbimg,FILE=cf_bimg,FORM='UNFORMATTED') cldum=' 4 dimensions in this isopycnal file ' WRITE(numbimg) cldum cldum=' 1: T ; 2: S ; 3: sigma ; 4: Velocity ' WRITE(numbimg) cldum WRITE(cldum,'(a,4i5.4)') ' from '//TRIM(csection(ksec)), iimin,iimax,ijmin,ijmax WRITE(numbimg) cldum cldum=' file '//TRIM(cf_tfil) WRITE(numbimg) cldum WRITE(numbimg) npts,nk,1,1,4,0 WRITE(numbimg) 1.,-float(nk),1.,1., 0. WRITE(numbimg) 0. WRITE(numbimg) 0. WRITE(numbimg) (( REAL(zt(ji,jk) ), ji=1,npts), jk=nk,1,-1 ) ! temperature WRITE(numbimg) (( REAL(zs(ji,jk) ), ji=1,npts), jk=nk,1,-1 ) ! salinity WRITE(numbimg) (( REAL(dsig(ji,jk)), ji=1,npts), jk=nk,1,-1 ) ! density WRITE(numbimg) (( REAL(zu(ji,jk) ), ji=1,npts), jk=nk,1,-1 ) ! normal velocity CLOSE(numbimg) ! (along section, sigma ) 2D variables cf_bimg=TRIM(csection(ksec))//'_trpsig.bimg' OPEN(numbimg,FILE=cf_bimg,FORM='UNFORMATTED') cldum=' 3 dimensions in this isopycnal file ' WRITE(numbimg) cldum cldum=' 1: hiso ; 2: bin trp ; 3: cumulated trp ' WRITE(numbimg) cldum WRITE(cldum,'(a,4i5.4)') ' from '//TRIM(csection(ksec)), iimin,iimax,ijmin,ijmax WRITE(numbimg) cldum cldum=' file '//TRIM(cf_tfil) WRITE(numbimg) cldum WRITE(numbimg) npts,nbins,1,1,3,0 WRITE(numbimg) 1.,-REAL(dsigma_lev(nbins)),1.,REAL(dltsig), 0. WRITE(numbimg) 0. WRITE(numbimg) 0. WRITE(numbimg) (( REAL(dhiso(ji,jiso) ), ji=1,npts), jiso=nbins,1,-1) ! isopyc depth WRITE(numbimg) (( REAL(dwtrpbin(ji,jiso))/1.e6, ji=1,npts), jiso=nbins,1,-1) ! binned transport WRITE(numbimg) (( REAL(dwtrp(ji,jiso) )/1.e6, ji=1,npts), jiso=nbins,1,-1) ! cumulated transport CLOSE(numbimg) END SUBROUTINE bimg_writ SUBROUTINE cdf_writ( ksec) !!--------------------------------------------------------------------- !! *** ROUTINE cdf_writ *** !! !! ** Purpose : Write output cdf files if required !! !! ** Method : Most of the variables are global !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: ksec ! number of the section INTEGER(KIND=4) :: ji, jk INTEGER(KIND=4) :: ivar INTEGER(KIND=4) :: icout INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zdum TYPE(variable), DIMENSION(4) :: sl_typvar CHARACTER(LEN=255) :: csuffixvarnam CHARACTER(LEN=255) :: cprefixlongnam !!---------------------------------------------------------------------- IF ( cvarname(ksec) /= 'none' ) THEN csuffixvarnam = '_'//TRIM(cvarname(ksec)) ELSE csuffixvarnam = '' ENDIF IF ( clongname(ksec) /= 'none' ) THEN cprefixlongnam = TRIM(clongname(ksec))//'_' ELSE cprefixlongnam = '' ENDIF ALLOCATE ( zdum(npts,1)) ! (along section, depth ) 2D variables cf_nc=TRIM(csection(ksec))//'_secdep.nc' ! define variables ipk(:)=nk sl_typvar%rmissing_value = 0. sl_typvar%rmissing_value = 0. sl_typvar%scale_factor = 1. sl_typvar%add_offset = 0. sl_typvar%savelog10 = 0. sl_typvar%iwght = iweight sl_typvar%conline_operation = 'N/A' sl_typvar%caxis = 'XZT' ivar=1 sl_typvar(ivar)%cname = 'temperature'//TRIM(csuffixvarnam) sl_typvar(ivar)%cunits = 'Celsius' sl_typvar(ivar)%valid_min = -2. sl_typvar(ivar)%valid_max = 45. sl_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'Potential_temperature' sl_typvar(ivar)%cshort_name = 'temperature' ivar=ivar+1 sl_typvar(ivar)%cname = 'salinity'//TRIM(csuffixvarnam) sl_typvar(ivar)%cunits = 'PSU' sl_typvar(ivar)%valid_min = 0. sl_typvar(ivar)%valid_max = 45. sl_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'Salinity' sl_typvar(ivar)%cshort_name = 'salinity' ivar=ivar+1 sl_typvar(ivar)%cname = 'density'//TRIM(csuffixvarnam) sl_typvar(ivar)%cunits = 'kg/m3 -1000' sl_typvar(ivar)%valid_min = 0. sl_typvar(ivar)%valid_max = 45. sl_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'potential_density' sl_typvar(ivar)%cshort_name = 'density' ivar=ivar+1 sl_typvar(ivar)%cname = 'velocity'//TRIM(csuffixvarnam) sl_typvar(ivar)%cunits = 'm/s' sl_typvar(ivar)%valid_min = -3. sl_typvar(ivar)%valid_max = 3. sl_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'Normal_velocity' sl_typvar(ivar)%cshort_name = 'velocity' icout = create (cf_nc, 'none', npts, 1, nk, cdep=cn_vdeptht ) ierr = createvar (icout, sl_typvar, ivar, ipk, id_varout, cdglobal=TRIM(cglobal) ) ierr = putheadervar(icout, cf_tfil, npts, 1, nk, & & pnavlon=rlonlat, pnavlat=rlonlat, cdep=cn_vdeptht ) ! tim = getvar1d(cf_tfil, cn_vtimec, 1 ) ! ierr = putvar1d(icout, tim, 1, 'T') DO jk = 1, nk zdum(:,1)=zt(:,jk) ; ierr = putvar ( icout, id_varout(1), zdum, jk, npts, 1 ) zdum(:,1)=zs(:,jk) ; ierr = putvar ( icout, id_varout(2), zdum, jk, npts, 1 ) zdum(:,1)=dsig(:,jk) ; ierr = putvar ( icout, id_varout(3), zdum, jk, npts, 1 ) zdum(:,1)=zu(:,jk) ; ierr = putvar ( icout, id_varout(4), zdum, jk, npts, 1 ) END DO ierr = closeout(icout) ! (along section, sigma ) 2D variables cf_nc=TRIM(csection(ksec))//'_secsig.nc' ! define variables ipk(:)=nbins sl_typvar%rmissing_value = 99999. sl_typvar%rmissing_value = 99999. sl_typvar%scale_factor = 1. sl_typvar%add_offset = 0. sl_typvar%savelog10 = 0. sl_typvar%iwght = iweight sl_typvar%conline_operation = 'N/A' sl_typvar%caxis = 'XST' ivar=1 ipk(ivar)=nbins-1 sl_typvar(ivar)%cname = 'isodep'//TRIM(csuffixvarnam) sl_typvar(ivar)%cunits = 'm' sl_typvar(ivar)%valid_min = 0. sl_typvar(ivar)%valid_max = 6000. sl_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'isopycnal_depth' sl_typvar(ivar)%cshort_name = 'isodep' ivar=ivar+1 sl_typvar(ivar)%cname = 'bintrp'//TRIM(csuffixvarnam) sl_typvar(ivar)%cunits = 'SV' sl_typvar(ivar)%valid_min = -5. sl_typvar(ivar)%valid_max = 5. sl_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'Binned_transport' sl_typvar(ivar)%cshort_name = 'bintrp' ivar=ivar+1 sl_typvar(ivar)%cname = 'sumtrp'//TRIM(csuffixvarnam) sl_typvar(ivar)%cunits = 'SV' sl_typvar(ivar)%valid_min = -20. sl_typvar(ivar)%valid_max = 20. sl_typvar(ivar)%clong_name = TRIM(cprefixlongnam)//'cumulated_transport' sl_typvar(ivar)%cshort_name = 'sumtrp' icout = create (cf_nc, 'none', npts, 1, nbins, cdep='levels' ) ierr = createvar (icout, sl_typvar, ivar, ipk, id_varout, cdglobal=TRIM(cglobal) ) ierr = putheadervar(icout, cf_tfil, npts, 1, nbins, & & pnavlon=rlonlat, pnavlat=rlonlat, pdep=REAL(dsigma_lev), cdep='levels' ) PRINT *, 'NBINS', nbins, npts DO jk = 1, nbins-1 zdum(:,1)=dhiso (:,jk) ; ierr = putvar ( icout, id_varout(1), zdum, jk, npts, 1 ) END DO DO jk = 1, nbins zdum(:,1)=dwtrpbin(:,jk)/1.e6 ; ierr = putvar ( icout, id_varout(2), zdum, jk, npts, 1 ) zdum(:,1)=dwtrp (:,jk)/1.e6 ; ierr = putvar ( icout, id_varout(3), zdum, jk, npts, 1 ) END DO ierr = closeout(icout) DEALLOCATE ( zdum ) END SUBROUTINE cdf_writ SUBROUTINE print_out(ksec) !!--------------------------------------------------------------------- !! *** ROUTINE print_out *** !! !! ** Purpose : Print results on standard output !! !! ** Method : Most of the variables are global and already known !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: ksec ! number of the section INTEGER(KIND=4) :: ji, jk, jiso, jbin !!---------------------------------------------------------------------- WRITE(cfmt_9000,'(a,i4,a)') '(i7, ',npts,'f8.3)' WRITE(cfmt_9001,'(a,i4,a)') '(i7, ',npts,'f8.0)' WRITE(cfmt_9002,'(a,i4,a)') '(f7.3,',npts,'f8.0)' WRITE(cfmt_9003,'(a,i4,a)') '(f7.3,',npts,'f8.3)' PRINT *,' T (deg C)' DO jk=1,nk PRINT cfmt_9000, jk, (zt(ji,jk),ji=1,npts) END DO PRINT *,' S (PSU)' DO jk=1,nk PRINT cfmt_9000, jk, (zs(ji,jk),ji=1,npts) END DO PRINT *,' SIG (kg/m3 - 1000 )' DO jk=1,nk PRINT cfmt_9000, jk, (dsig(ji,jk),ji=1,npts) END DO PRINT *,' VELOCITY (cm/s ) ' DO jk=1,nk PRINT cfmt_9000, jk, (zu(ji,jk)*100,ji=1,npts) END DO PRINT *,' GDEPU (m) ' DO jk=1,nk PRINT cfmt_9001,jk, (ddepu(ji,jk)*zmask(ji,jk),ji=1,npts) END DO PRINT *, 'E3 (m)' DO jk=1,nk PRINT cfmt_9001,jk, (de3(ji,jk)*zmask(ji,jk),ji=1,npts) END DO PRINT *,' DEP ISO ( m )' DO jiso =1, nbins+1 PRINT cfmt_9002, dsigma_lev(jiso),(dhiso(ji,jiso),ji=1,npts) END DO PRINT *,' TRP SURF --> ISO (SV)' DO jiso =1, nbins+1 PRINT cfmt_9003, dsigma_lev(jiso),(dwtrp(ji,jiso)/1.d6,ji=1,npts) END DO PRINT *,' TRP bins (SV)' DO jbin =1, nbins PRINT cfmt_9003, dsigma_lev(jbin),(dwtrpbin(ji,jbin)/1.d6,ji=1,npts), dtrpbin(ksec,jbin)/1.d6 END DO END SUBROUTINE print_out END PROGRAM cdfsigtrp cdftools-3.0/cdfimprovechk.f900000644000175000017500000001475312241227304017476 0ustar amckinstryamckinstryPROGRAM cdfimprovechk !!====================================================================== !! *** PROGRAM cdfimprovechk *** !!===================================================================== !! ** Purpose : Estimate the improvement/deterioration of a test run, !! compared with a reference run relative to some observations !! !! ** Method : Given zobs (observed field), zref (reference run field) !! and ztst (test run field), compute zchk as the ratio: !! zchk=(zref - ztst) / (zref - zobs ) !! !! Where 0 < zchk <=1 correction act in the right direction !! Where 1 < zchk correction is too strong, in the right way !! Where zchk < 0 correction is in the wrong way (deterioration) !! !! History : 2.1 : 11/2005 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: nvpk ! dim of the working variable INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid of output vars REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zobs ! observation array REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zref ! reference array REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztst ! test array REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at surface REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zchk ! check index output REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter CHARACTER(LEN=256) :: cf_obs ! observation-file name CHARACTER(LEN=256) :: cf_ref ! reference-file name CHARACTER(LEN=256) :: cf_tst ! test-file name CHARACTER(LEN=256) :: cv_in ! cdf variable name CHARACTER(LEN=256) :: cf_out='chk.nc' ! output filename TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfimprovechk IN-var OBS-file REF-file TST-file' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Estimate the improvement/deterioration of a test run,' PRINT *,' compared with a reference run relative to some observations' PRINT *,' This program computes the quantity zchk= ( REF - TEST )/(REF - OBS)' PRINT *,' Where 0 < zchk <= 1, the TST is better than the reference' PRINT *,' Where 1 < zchk, the TST was corrected in the right sense but too much' PRINT *,' Where zchk < 0, the TST was corrected was corrected in the wrong way.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-var : netcdf input variable' PRINT *,' OBS-file : netcdf observation file' PRINT *,' REF-file : netcdf reference file' PRINT *,' TST-file : netcdf test file' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : same as input variable.' STOP ENDIF CALL getarg (1, cv_in ) CALL getarg (2, cf_obs) CALL getarg (3, cf_ref) CALL getarg (4, cf_tst) IF ( chkfile(cf_obs) .OR. chkfile(cf_ref) .OR. chkfile(cf_tst) ) STOP ! missing files npiglo = getdim(cf_ref, cn_x) npjglo = getdim(cf_ref, cn_y) npk = getdim(cf_ref, cn_z) npt = getdim(cf_ref, cn_t) nvpk = getvdim(cf_ref, cv_in) IF (nvpk == 2 ) nvpk = 1 IF (nvpk == 3 ) nvpk = npk ipk(:) = nvpk ! all variables stypvar(1)%cname = TRIM(cv_in) stypvar(1)%cunits = '%' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 100. stypvar(1)%clong_name = 'Checking ratio for'//TRIM(cv_in) stypvar(1)%cshort_name = cv_in stypvar(1)%conline_operation = 'N/A' IF (nvpk == npk ) stypvar(1)%caxis='TZYX' IF (nvpk == 1 ) stypvar(1)%caxis='TYX' PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE (zobs(npiglo,npjglo), zref(npiglo,npjglo), ztst(npiglo,npjglo), zmask(npiglo,npjglo)) ALLOCATE (zchk(npiglo,npjglo), tim(npt) ) ! create output fileset ncout = create (cf_out, cf_ref, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_ref, npiglo, npjglo, npk ) zref = 0. ; zobs = 0. ; zmask = 1. DO jt = 1,npt DO jk = 1,npk PRINT *,'level ',jk zchk = 0. zobs(:,:) = getvar(cf_obs, cv_in, jk ,npiglo, npjglo, ktime=jt) zref(:,:) = getvar(cf_ref, cv_in, jk ,npiglo, npjglo, ktime=jt) ztst(:,:) = getvar(cf_tst, cv_in, jk ,npiglo, npjglo, ktime=jt) IF (jk == 1 ) THEN WHERE( zref == 0. ) zmask = 0. END IF WHERE ( (zref - zobs ) /= 0 ) zchk = (zref - ztst ) / ( zref - zobs) * zmask END WHERE ierr = putvar(ncout, id_varout(1), zchk, jk, npiglo, npjglo, ktime=jt) END DO END DO tim = getvar1d(cf_ref, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdfimprovechk cdftools-3.0/cdfkempemekeepe.f900000644000175000017500000001337012241227304017756 0ustar amckinstryamckinstryPROGRAM cdfkempemekeepe !!====================================================================== !! *** PROGRAM cdfkempemekeepe *** !!===================================================================== !! ** Purpose : Compute the term of energetic transfert from mean kinetic !! energy to mean potential energy (T1) and from eddy !! potential energy to eddy kinetic energy (T3) !! !! History : 2.1 : 03/2008 : A. Melet : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jj, jk ! dummy loop index INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: narg, iargc ! browse line INTEGER(KIND=4) :: ncout, ierr ! ncid of outputfile, error status INTEGER(KIND=4), DIMENSION(2) :: ipk, id_varout ! levels and varid's of output vars REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: wbartbar REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: anowt REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: t1mask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: w1mask REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: txz REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: wxz REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: wtxz REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: wbartbarxz REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: anowtxz REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter (dummy) CHARACTER(LEN=256) :: cf_uvwtfil ! input file CHARACTER(LEN=256) :: cf_out='transfertst1t3.nc' TYPE (variable), DIMENSION(2) :: stypvar ! structure for attibutes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg /= 1 ) THEN PRINT *,'usage : cdfkempemekeepe file' PRINT *,' Produce a cdf file transfertst1t3.nc with wT and anowT variables' PRINT *,' file is from cdfmoyuvwt' PRINT *,' the mean must have been computed on a period long enough' PRINT *,' for the statistics to be meaningful' PRINT *,' ' STOP ENDIF CALL getarg(1, cf_uvwtfil) IF (chkfile(cf_uvwtfil) ) STOP ! missing file npiglo = getdim(cf_uvwtfil, cn_x) npjglo = getdim(cf_uvwtfil, cn_y) npk = getdim(cf_uvwtfil, cn_z) npt = getdim(cf_uvwtfil, cn_t) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ! define new variables for output ( must update att.txt) ipk(:) = npk stypvar(1)%cname = 'wT' stypvar(1)%clong_name = 'temporal mean of w times temporal mean of T on T point (*1000)' stypvar(1)%cshort_name = 'wT' stypvar(2)%cname = 'anowT' stypvar(2)%clong_name = 'temporal mean of anomaly of w times ano of T on T point (*1000)' stypvar(2)%cshort_name = 'anowT' stypvar%cunits = '1000 m.K' stypvar%rmissing_value = 0. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TYX' ! create output fileset ncout = create (cf_out, cf_uvwtfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 2, ipk, id_varout ) ierr = putheadervar(ncout, cf_uvwtfil, npiglo, npjglo, npk ) ! Allocate the memory ALLOCATE ( wbartbar( npiglo, npjglo, npk) ) ! 3D can be huge ! ALLOCATE ( anowt( npiglo, npjglo, npk) ) ! 3D can be huge ALLOCATE ( t1mask( npiglo,npk) ) ALLOCATE ( w1mask( npiglo,npk) ) ALLOCATE ( txz( npiglo,npk) ) ALLOCATE ( wxz( npiglo,npk) ) ALLOCATE ( wtxz( npiglo,npk) ) ALLOCATE ( anowtxz( npiglo,npk) ) ALLOCATE ( wbartbarxz(npiglo,npk) ) ALLOCATE ( tim(npt) ) tim = getvar1d(cf_uvwtfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') DO jj = 1, npjglo wbartbarxz(:,:) = 0.0 anowtxz(:,:) = 0.0 wtxz(:,:) = 0.0 wxz(:,:) = 0.0 txz(:,:) = 0.0 txz( :,:) = getvarxz(cf_uvwtfil, 'tbar', jj, npiglo, npk, kimin=1, kkmin=1, ktime=1) wxz( :,:) = getvarxz(cf_uvwtfil, 'wbar', jj, npiglo, npk, kimin=1, kkmin=1, ktime=1) wtxz(:,:) = getvarxz(cf_uvwtfil, 'wtbar', jj, npiglo, npk, kimin=1, kkmin=1, ktime=1) DO jk=1, npk-1 w1mask(:,jk) = wxz(:,jk) * wxz(:,jk+1) t1mask(:,jk) = txz(:,jk) WHERE ( w1mask(:,jk) /= 0.) w1mask(:,jk)=1. WHERE ( t1mask(:,jk) /= 0.) t1mask(:,jk)=1. wbartbarxz(:,jk) = 1000. * t1mask(:,jk) * txz(:,jk) * 0.5 * w1mask(:,jk) * ( wxz(:,jk) + wxz(:,jk+1) ) anowtxz( :,jk) = 1000. * ( wtxz(:,jk) - wbartbarxz(:,jk)*0.001 ) END DO wbartbar(:,jj,:) = wbartbarxz(:,:) anowt( :,jj,:) = anowtxz( :,:) END DO DO jk=1,npk ierr = putvar(ncout, id_varout(1), wbartbar(:,:,jk), jk, npiglo, npjglo ) ierr = putvar(ncout, id_varout(2), anowt( :,:,jk), jk, npiglo, npjglo ) END DO ierr = closeout(ncout) END PROGRAM cdfkempemekeepe cdftools-3.0/cdfweight.f900000644000175000017500000005060612241227304016613 0ustar amckinstryamckinstryPROGRAM cdfweight !!====================================================================== !! *** PROGRAM cdfweight *** !!===================================================================== !! ** Purpose : Compute a wheight file for further bi-linear colocalisation !! done with cdfcoloc. !! !! ** Method : Use Greg Holloway iyxz.txt file type as input, to specify !! the points to search in the model grid. !! Read the coordinate/mesh_hgr file and look !! for the glam, gphi variables !! Then use a search algorithm to find the corresponding I J !! The point type ( T U V F ) is specified on the command line !! as well as the name of the coordinate/mesh hgr file. !! If -2d option is used, only horizontal weight are produced. !! !! History : 2.0 : 11/2005 : J.M. Molines : Original code !! : 05/2007 : J.M. Molines : for weight !! 3.0 : 03/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! SUBROUTINE localcoord( palpha, pbeta, plam, pphi) !! FUNCTION det(p1,p2,p3,p4) !! FUNCTION heading(plona, plonb, plata, platb) !!---------------------------------------------------------------------- USE cdfio USE cdftools ! cdf_find_ij USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk ! dummy loop counter INTEGER(KIND=4) :: idum ! dummy working integer INTEGER(KIND=4) :: narg, iargc, iarg ! Argument management INTEGER(KIND=4) :: iimin, ijmin ! i j position of target point INTEGER(KIND=4) :: ikloc ! k position of target point INTEGER(KIND=4) :: npiglo, npjglo, npk ! domain size INTEGER(KIND=4) :: iquadran ! quadran INTEGER(KIND=4) :: numgreg=10 ! logical unit of ASCII input file INTEGER(KIND=4) :: numbin=20 ! logical unit of BINARY weight file INTEGER(KIND=4) :: ios ! iostat variable ! Greg Holloway input data ( 5 variables) INTEGER(KIND=4) :: id ! station ID REAL(KIND=4) :: xmin, ymin, rdep ! longitude, latitude, depth REAL(KIND=8) :: dl_xmin, dl_ymin REAL(KIND=8) :: dl_hPp ! local maximum metrics REAL(KIND=8) :: dl_lam0 ! longitude of grid point ji=1 REAL(KIND=8) :: dl_lamin, dl_phimin ! coordinates of the nearest point (NP) REAL(KIND=8) :: dl_lamN, dl_phiN, dl_hN ! grid point North of NP, true heading from NP REAL(KIND=8) :: dl_lamE, dl_phiE, dl_hE ! grid point East of NP, true heading from NP REAL(KIND=8) :: dl_lamS, dl_phiS, dl_hS ! grid point South of NP, true heading from NP REAL(KIND=8) :: dl_lamW, dl_phiW, dl_hW ! grid point West of NP, true heading from NP REAL(KIND=8), DIMENSION(0:4) :: dl_lami, dl_phii ! the 4 grid points around target (1-4) ! + the target (0) REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_lam, dl_phi ! grid layout and metrics REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dl_dept ! vertical depth REAL(KIND=8) :: dl_hP ! true heading of target point from NP REAL(KIND=8) :: dl_alpha, dl_beta ! reduced coordinates (0-1) in the NP gridcell REAL(KIND=8) :: dl_gam ! vertical weight CHARACTER(LEN=256) :: cf_coord, cf_in ! file names (in) CHARACTER(LEN=256) :: cf_weight ! weight file name (out) CHARACTER(LEN=256) :: ctype, cldum ! C-grid type point, dummy character LOGICAL :: lldebug = .FALSE. ! verbose/debug flag LOGICAL :: ll2d = .FALSE. ! 2D field flag LOGICAL :: llchk = .FALSE. ! for checking missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() ! default values cf_coord = cn_fcoo ctype = 'F' narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfweight [-f] IN-file [-c COORD-file] ... ' PRINT *,' ... [-t point_type] [-2d] [-v] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Produce a weight file for further bilinear collocalisation ' PRINT *,' with cdfcoloc program. It takes the position of the points' PRINT *,' to be collocated into a simple ascii file. ' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' [-f ] IN-file : input file is a iyxz ASCII file, 1 line per point.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-c COORD-file] : coordinate file [',TRIM(cf_coord),']' PRINT *,' [-t point_type] : point type on C-grid (either T U V or F ) [',TRIM(ctype),']' PRINT *,' [-2d ] : tell cdfweight that only 2D weights are to be computed.' PRINT *,' [-v ] : Verbose mode for extra information (debug mode).' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cf_coord),' file if not passed as argument.' PRINT *,' If working with 3D files, ',TRIM(cn_fzgr),' is required.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' binary weight file : weight_point_type.bin' PRINT *,' standard output : almost the same info that is saved in the binary file' PRINT *,' When using -v option, even more informations !' STOP ENDIF iarg=1 DO WHILE (iarg <= narg ) CALL getarg(iarg, cldum) ; iarg=iarg+1 SELECT CASE ( cldum ) CASE ('-f' ) ; CALL getarg(iarg, cf_in ) ; iarg=iarg+1 CASE ('-c' ) ; CALL getarg(iarg, cf_coord) ; iarg=iarg+1 CASE ('-t' ) ; CALL getarg(iarg, ctype ) ; iarg=iarg+1 CASE ('-2d') ; ll2d = .TRUE. CASE ('-v' ) ; lldebug = .TRUE. CASE DEFAULT ; CALL getarg(iarg, cf_in ) ; iarg=iarg+1 ! if no switch assume file name END SELECT END DO llchk = llchk .OR. chkfile(cf_in) llchk = llchk .OR. chkfile(cf_coord) IF ( .NOT. ll2d ) llchk = llchk .OR. chkfile(cn_fzgr) IF ( llchk ) STOP ! missing files npiglo = getdim (cf_coord,cn_x) npjglo = getdim (cf_coord,cn_y) IF ( .NOT. ll2d ) THEN npk = getdim (cn_fzgr,cn_z ) ALLOCATE (dl_dept(npk) ) ! read depth of model T points (hence U and V) dl_dept(:)=getvare3(cn_fzgr, cn_gdept, npk) ENDIF ALLOCATE (dl_lam(npiglo,npjglo), dl_phi(npiglo,npjglo) ) ! set name and open output weight file WRITE(cf_weight,'("weight_",a,".bin")') TRIM(ctype) OPEN(numbin, FILE=cf_weight,FORM='unformatted') SELECT CASE ( ctype ) CASE ('T' , 't' ) dl_lam(:,:) = getvar(cf_coord, cn_glamt, 1, npiglo, npjglo) dl_phi(:,:) = getvar(cf_coord, cn_gphit, 1, npiglo, npjglo) CASE ('U','u' ) dl_lam(:,:) = getvar(cf_coord, cn_glamu, 1, npiglo, npjglo) dl_phi(:,:) = getvar(cf_coord, cn_gphiu, 1, npiglo, npjglo) CASE ('V','v' ) dl_lam(:,:) = getvar(cf_coord, cn_glamv, 1, npiglo, npjglo) dl_phi(:,:) = getvar(cf_coord, cn_gphiv, 1, npiglo, npjglo) CASE ('F','f' ) dl_lam(:,:) = getvar(cf_coord, cn_glamf, 1, npiglo, npjglo) dl_phi(:,:) = getvar(cf_coord, cn_gphif, 1, npiglo, npjglo) CASE DEFAULT PRINT *,' ERROR : type of point not known: ', TRIM(ctype) END SELECT ! work with longitude between 0 and 360 to avoid the date line. WHERE( dl_lam < 0 ) dl_lam(:,:)=dl_lam(:,:)+360.d0 ! For Orca grid, the longitude of ji=1 is about 70 E dl_lam0 = dl_lam(1, npjglo/2) WHERE( dl_lam < dl_lam0 ) dl_lam=dl_lam+360.d0 OPEN(numgreg,FILE=cf_in) ! Greg (Holloway) files are iyxz.txt file ios=0 ! loop for each line of Greg File DO WHILE (ios == 0 ) READ(numgreg,*,iostat=ios) id,ymin,xmin,rdep dl_xmin=xmin ; dl_ymin=ymin IF( ios == 0 ) THEN ! EOF not reached IF ( .NOT. ll2d ) THEN ! Look for vertical position ! ikloc = k index of point above rdep ikloc=1 DO WHILE ( dl_dept(ikloc) <= rdep .AND. ikloc < npk ) ikloc = ikloc+1 ENDDO ikloc = ikloc -1 ! up one level ! compute dl_gam such that Vint= (1-dl_gam) x V(ikloc) + dl_gam x V(ikloc +1) dl_gam=(rdep - dl_dept(ikloc))/(dl_dept(ikloc+1)-dl_dept(ikloc) ) IF (ikloc == npk -1 ) dl_gam = 0.d0 IF ( dl_gam < 0 ) THEN ikloc=1 dl_gam = 0.d0 ENDIF IF ( dl_gam > 1 ) THEN ikloc=npk -1 dl_gam = 0.d0 ENDIF ELSE dl_gam = 0.d0 ENDIF IF ( lldebug) PRINT '("DEP", f8.1,i8,f8.0,f8.4)', dl_dept(ikloc), rdep, dl_dept(ikloc+1), dl_gam ! Now deal with horizontal interpolation CALL cdf_findij ( xmin, xmin, ymin, ymin, iimin, idum, ijmin, idum, cd_coord=cf_coord, cd_point=ctype) IF ( iimin /= -1000 .AND. ijmin /= -1000 ) THEN ! Latitude and longitude of the neighbours on the grid ! define longitudes between 0 and 360 deg dl_lamin = MOD(dl_lam(iimin ,ijmin ),360.d0) ; dl_phimin = dl_phi(iimin ,ijmin ) ! nearest point dl_lamN = MOD(dl_lam(iimin ,ijmin+1),360.d0) ; dl_phiN = dl_phi(iimin ,ijmin+1) ! N (grid) dl_lamE = MOD(dl_lam(iimin+1,ijmin ),360.d0) ; dl_phiE = dl_phi(iimin+1,ijmin ) ! E (grid) dl_lamS = MOD(dl_lam(iimin ,ijmin-1),360.d0) ; dl_phiS = dl_phi(iimin ,ijmin-1) ! S (grid) dl_lamW = MOD(dl_lam(iimin-1,ijmin ),360.d0) ; dl_phiW = dl_phi(iimin-1,ijmin ) ! W (grid) ! Compute heading of target point and neighbours from the nearest point dl_hP = heading(dl_lamin, dl_xmin, dl_phimin, dl_ymin) ! target point dl_hN = heading(dl_lamin, dl_lamN, dl_phimin, dl_phiN) ! 'north' on the grid dl_hE = heading(dl_lamin, dl_lamE, dl_phimin, dl_phiE) ! 'east' on the grid dl_hS = heading(dl_lamin, dl_lamS, dl_phimin, dl_phiS) ! 'south' on the grid dl_hW = heading(dl_lamin, dl_lamW, dl_phimin, dl_phiW) ! 'west' on the grid ! determine the sector in wich the target point is located: ! ( from 1, to 4 resp. NE, SE, SW, NW of the grid) iquadran = 4 ! to avoid problem with the GW meridian, pass to -180, 180 when working around GW IF ( dl_hP > 180.d0 ) THEN dl_hPp = dl_hP - 360.d0 dl_hPp = dl_hP ENDIF IF ( dl_hN > dl_hE ) dl_hN = dl_hN - 360.d0 IF ( dl_hPp > dl_hN .AND. dl_hPp <= dl_hE ) iquadran = 1 IF ( dl_hP > dl_hE .AND. dl_hP <= dl_hS ) iquadran = 2 IF ( dl_hP > dl_hS .AND. dl_hP <= dl_hW ) iquadran = 3 IF ( dl_hP > dl_hW .AND. dl_hPp <= dl_hN ) iquadran = 4 dl_lami(0) = xmin ; dl_phii(0) = ymin ! fill dl_lami, dl_phii for 0 = target point dl_lami(1) = dl_lamin ; dl_phii(1) = dl_phimin ! 1 = nearest point SELECT CASE ( iquadran ) ! point 2 3 4 are counter clockwise in the respective sector CASE ( 1 ) dl_lami(2) = dl_lamE ; dl_phii(2) = dl_phiE dl_lami(3) = MOD(dl_lam(iimin+1,ijmin+1), 360.d0) ; dl_phii(3) = dl_phi(iimin+1,ijmin+1) dl_lami(4) = dl_lamN ; dl_phii(4) = dl_phiN CASE ( 2 ) dl_lami(2) = dl_lamS ; dl_phii(2) = dl_phiS dl_lami(3) = MOD(dl_lam(iimin+1,ijmin-1), 360.d0) ; dl_phii(3) = dl_phi(iimin+1,ijmin-1) dl_lami(4) = dl_lamE ; dl_phii(4) = dl_phiE CASE ( 3 ) dl_lami(2) = dl_lamW ; dl_phii(2) = dl_phiW dl_lami(3) = MOD(dl_lam(iimin-1,ijmin-1), 360.d0) ; dl_phii(3) = dl_phi(iimin-1,ijmin-1) dl_lami(4) = dl_lamS ; dl_phii(4) = dl_phiS CASE ( 4 ) dl_lami(2) = dl_lamN ; dl_phii(2) = dl_phiN dl_lami(3) = MOD(dl_lam(iimin-1,ijmin+1), 360.d0) ; dl_phii(3) = dl_phi(iimin-1,ijmin+1) dl_lami(4) = dl_lamW ; dl_phii(4) = dl_phiW END SELECT ! resolve a non linear system of equation for dl_alpha and dl_beta !( the non dimensional coordinates of target point) CALL localcoord( dl_alpha, dl_beta, dl_lami, dl_phii) ELSE ! point is outside the domaine, put dummy values dl_alpha=-1000.d0 ; dl_beta=-1000.d0 ENDIF IF (lldebug) THEN PRINT 9001, id, ymin, xmin, rdep ,iimin, ijmin, dl_hP, dl_hPp, dl_hN, & & dl_hE, dl_hS, dl_hW, iquadran, dl_alpha, dl_beta ENDIF ! output both on std output and binary weight file (same info). PRINT 9002, id, ymin, xmin, rdep ,iimin, ijmin, ikloc, iquadran, dl_alpha, dl_beta, dl_gam WRITE(numbin) id, ymin, xmin, rdep ,iimin, ijmin, ikloc, iquadran, dl_hN, dl_alpha, dl_beta, dl_gam ENDIF ENDDO 9001 FORMAT(i10, 3f10.4,2i6,6f10.4,I4,2f8.4) 9002 FORMAT(i10, 3f10.4,3i6,I4,3f11.4) CLOSE(numbin) CONTAINS SUBROUTINE localcoord( dpalpha, dpbeta, dplam, dpphi) !!--------------------------------------------------------------------- !! *** ROUTINE localcoord *** !! !! ** Purpose : compute the local coordinate in a grid cell !! !! ** Method : See reference !! !! References : from N. Daget Web page : !! http://aton.cerfacs.fr/~daget/TECHREPORT/TR_CMGC_06_18_html/node8.html !!---------------------------------------------------------------------- REAL(KIND=8), DIMENSION(0:4), INTENT(in) :: dplam, dpphi REAL(KIND=8) , INTENT(out) :: dpalpha, dpbeta INTEGER(KIND=4) :: itermax=200 ! maximum of iteration INTEGER(KIND=4) :: iter=0 ! iteration counter REAL(KIND=8) :: dlalpha=0.d0 ! working variable, initialized to 1rst guess REAL(KIND=8) :: dlbeta=0.d0 ! "" "" REAL(KIND=8) :: dlresmax=0.001 ! Convergence criteria REAL(KIND=8) :: dlres ! residual REAL(KIND=8) :: dldeta REAL(KIND=8) :: dldalp REAL(KIND=8) :: dldbet REAL(KIND=8) :: dldlam REAL(KIND=8) :: dldphi REAL(KIND=8) :: dl1, dl2, dl3, dl4 REAL(KIND=8), DIMENSION(2,2) :: dla REAL(KIND=8), DIMENSION(0:4) :: dlplam !!---------------------------------------------------------------------- dlplam=dplam !: save input longitude in working array IF ( lldebug ) THEN PRINT *,dplam(0), dpphi(0) PRINT *,9999,9999 PRINT *,dplam(1), dpphi(1) PRINT *,dplam(2), dpphi(2) PRINT *,dplam(3), dpphi(3) PRINT *,dplam(4), dpphi(4) PRINT *,dplam(1), dpphi(1) PRINT *,9999,9999 ENDIF IF ( ABS( dlplam(1) -dlplam(4) ) >= 180.d0 .OR. ABS( dlplam(1) -dlplam(2) ) >=180.d0) THEN ! then we are near the 0 deg line and we must work in the frame -180 180 WHERE ( dlplam >= 180.d0 ) dlplam=dlplam -360.d0 ENDIF dlres=1000.; dldlam=0.5; dldphi=0.5 ; dlalpha=0.d0 ; dlbeta=0.d0; iter=0 DO WHILE (dlres > dlresmax .AND. iter < itermax) dl1=(dlplam(2)- dlplam(1) ) dl2=(dlplam(1) -dlplam(4) ) dl3=(dlplam(3) -dlplam(2) ) dla(1,1) = dl1 + (dl2 + dl3 )* dlbeta dla(1,2) = -dl2 + (dl2 + dl3 )* dlalpha dla(2,1) = dpphi(2)-dpphi(1) + (dpphi(1) -dpphi(4) +dpphi(3) -dpphi(2))* dlbeta dla(2,2) = dpphi(4)-dpphi(1) + (dpphi(1) -dpphi(4) +dpphi(3) -dpphi(2))* dlalpha ! determinant dldeta=det(dla(1,1), dla(1,2), dla(2,1), dla(2,2) ) ! solution of ! | zdlam | | zdalp | ! | | = za .| | ! | zdphi | | zdbet | dldalp=det(dldlam, dla(1,2), dldphi, dla(2,2))/dldeta dldbet=det(dla(1,1), dldlam, dla(2,1), dldphi )/dldeta ! compute residual ( loop criteria) dlres=SQRT(dldalp*dldalp + dldbet*dldbet ) ! Compute alpha and beta from 1rst guess : dlalpha = dlalpha + dldalp dlbeta = dlbeta + dldbet ! compute corresponding lon/lat for this alpha, beta dldlam = dlplam(0) - ((1.-dlalpha)*(1-dlbeta)*dlplam(1) + dlalpha*(1-dlbeta)*dlplam(2) + & & dlalpha*dlbeta*dlplam(3) + (1-dlalpha)*dlbeta*dlplam(4)) dldphi = dpphi(0) - ((1.-dlalpha)*(1-dlbeta)*dpphi(1) + dlalpha*(1-dlbeta)*dpphi(2) + & & dlalpha*dlbeta*dpphi(3) + (1-dlalpha)*dlbeta*dpphi(4)) iter=iter + 1 ! increment iteration counter END DO ! loop until dlres small enough (or itermax reach ) dpalpha = dlalpha dpbeta = dlbeta END SUBROUTINE localcoord FUNCTION det(dp1,dp2,dp3,dp4) !!--------------------------------------------------------------------- !! *** FUNCTION det *** !! !! ** Purpose : compute determinant !! !! ** Method : just multiply and add ! !! !!---------------------------------------------------------------------- REAL(KIND=8), INTENT(in) :: dp1, dp2, dp3, dp4 ! matrix elements REAL(KIND=8) :: det ! return value !!---------------------------------------------------------------------- det = dp1*dp4 - dp2*dp3 END FUNCTION det FUNCTION heading(dplona, dplonb, dplata, dplatb) !!--------------------------------------------------------------------- !! *** FUNCTION heading *** !! !! ** Purpose : Compute true heading between point a and b !! !! ** Method : Suppose that the 2 points are not too far away !! from each other so that heading can be computed !! with loxodromy. !! !!---------------------------------------------------------------------- REAL(KIND=8), INTENT(in) :: dplata, dplona ! lat lon of point a REAL(KIND=8), INTENT(in) :: dplatb, dplonb ! lat lon of point b REAL(KIND=8) :: heading ! return value in degree REAL(KIND=8) :: dlpi, dlconv ! pi and conversion factor REAL(KIND=8) :: dlxa,dlya ! working variable REAL(KIND=8) :: dlxb,dlyb ! working variable REAL(KIND=8) :: dlxb_xa ! "" "" !!---------------------------------------------------------------------- dlpi = ACOS(-1.d0) dlconv = dlpi/180.d0 ! for degree to radian conversion ! there is a problem if the Greenwich meridian pass between a and b IF ( lldebug) PRINT *,' Plonb Plona ' , dplonb, dplona dlxa = dplona*dlconv dlxb = dplonb*dlconv dlya = -LOG(TAN(dlpi/4.-dlconv*dplata/2.d0)) dlyb = -LOG(TAN(dlpi/4.-dlconv*dplatb/2.d0)) IF (lldebug) PRINT *,' dlxa_xb , modulo 2pi', dlxb-dlxa, MOD((dlxb-dlxa),2*dlpi) dlxb_xa = MOD((dlxb-dlxa),2*dlpi) IF ( dlxb_xa >= dlpi ) dlxb_xa = dlxb_xa -2*dlpi IF ( dlxb_xa <= -dlpi ) dlxb_xa = dlxb_xa +2*dlpi IF (lldebug) PRINT *, 'dlyb -dlya, dlxb_xa ',dlyb -dlya , dlxb_xa heading=ATAN2(dlxb_xa,(dlyb-dlya))*180.d0/dlpi IF (heading < 0) heading=heading+360.d0 END FUNCTION heading END PROGRAM cdfweight cdftools-3.0/cdfcmp.f900000644000175000017500000001441112241227304016075 0ustar amckinstryamckinstryPROGRAM cdfcmp !!====================================================================== !! *** PROGRAM cdfcmp *** !!====================================================================== !! ** Purpose : Find the differences between one same variable in two different files !! Indicate where are located these differences !! Indicate the relative difference !! !! ** Method : Compare var1 and var2 !! If it differs, print in standard output where are located diff !! Spatial sub-area restriction can be defined !! !! History : 3.0 ! 08/2012 A. Lecointre : Original code + Full Doctor form + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id: cdfcmp.f90 XXX YYYY-MM-DD HH:MM:SSZ molines $ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk,jj,ji, jvar, jjvar ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! argument on line INTEGER(KIND=4) :: npiglo, npjglo ! size fo the domain INTEGER(KIND=4) :: iimin=1, iimax=0 ! i-limit of the domain INTEGER(KIND=4) :: ijmin=1, ijmax=0 ! j-limit of the domain INTEGER(KIND=4) :: ikmin=1, ikmax=0 ! k-limit of the domain INTEGER(KIND=4) :: nvars ! Number of variables in a file INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of var id's REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: var1, var2 ! variables to compare REAL(KIND=4) :: dvar ! relative difference CHARACTER(LEN=256) :: cf1_in,cf2_in ! input file name CHARACTER(LEN=256) :: cv_in ! variable name CHARACTER(LEN=256) :: cldum ! working string CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! Type variable is defined in cdfio. !!-------------------------------------------------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cmp_var -f1 IN-file1 -f2 IN-file2 -var IN-var ...' PRINT *,' ... [-lev kmin kmax ] [-zoom imin imax jmin jmax] ...' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Find where IN-var is different between IN-file1 and IN-file2 ' PRINT *,' Options allow to restrict the finding to a sub area in space' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' -f1 IN-file1 : input file1' PRINT *,' -f2 IN-file2 : input file2' PRINT *,' -var IN-var : input variable' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-lev kmin kmax ] : restrict to level between kmin and kmax. ' PRINT *,' [-zoom imin imax jmin jmax] : restrict to sub area specified' PRINT *,' by the given limits. ' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none ' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' output is done on standard output.' STOP ENDIF !! ijarg = 1 ! Read command line DO WHILE (ijarg <= narg) CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-f1' ) CALL getarg(ijarg, cf1_in) ; ijarg = ijarg + 1 CASE ( '-f2' ) CALL getarg(ijarg, cf2_in) ; ijarg = ijarg + 1 CASE ( '-var' ) CALL getarg(ijarg,cv_in) ; ijarg = ijarg + 1 CASE ( '-lev' ) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmin CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmax CASE ( '-zoom' ) CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimin CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax CASE DEFAULT PRINT *, TRIM(cldum),' : unknown option ' STOP END SELECT END DO IF ( chkfile(cf1_in) .OR. chkfile(cf2_in) ) STOP ! missing file IF ( chkvar(cf1_in, cv_in) .OR. chkvar(cf2_in, cv_in) ) STOP ! missing var npiglo = getdim (cf1_in, cn_x) npjglo = getdim (cf1_in, cn_y) IF ( iimax == 0 ) iimax = npiglo IF ( ijmax == 0 ) ijmax = npjglo ! get the number of vertical levels of cv_in variable nvars = getnvar(cf1_in) ALLOCATE (ipk(nvars),cv_names(nvars),stypvar(nvars)) cv_names(:)=getvarname(cf1_in,nvars,stypvar) ipk(:) = getipk (cf1_in,nvars) DO jvar=1,nvars IF ( cv_names(jvar) == cv_in ) jjvar=jvar ENDDO IF ( ikmax == 0 ) ikmax = ipk(jjvar) ! Allocate memory. ALLOCATE(var1(npiglo, npjglo)) ALLOCATE(var2(npiglo, npjglo)) PRINT *,' Working with ', TRIM(cv_in),' defined on ', ipk(jjvar),' level(s)' DO jk = ikmin, ikmax PRINT *,'# -------------------------------------------' PRINT '(A19,I3)','# Checking level: ',jk PRINT *,'# i j k var1 var2 %reldiff' var1(:,:)=9999.0 var2(:,:)=9999.0 var1(:,:) = getvar(cf1_in, cv_in, jk, npiglo, npjglo) var2(:,:) = getvar(cf2_in, cv_in, jk, npiglo, npjglo) DO jj=ijmin, ijmax DO ji=iimin, iimax IF ( var1(ji,jj) /= var2(ji,jj) ) THEN dvar = 100.0*(var1(ji,jj)-var2(ji,jj))/var1(ji,jj) PRINT '(I4,2X,I4,2X,I3,2X,F8.3,2X,F8.3,2X,F8.3)',ji,jj,jk,var1(ji,jj),var2(ji,jj),dvar ENDIF ENDDO ENDDO ENDDO END PROGRAM cdfcmp cdftools-3.0/cdfbottomsig.f900000644000175000017500000001561012241227304017327 0ustar amckinstryamckinstryPROGRAM cdfbottomsig !!====================================================================== !! *** PROGRAM cdfbottomsig *** !!===================================================================== !! ** Purpose : Compute the bottom sigma from gridT file. !! Store the results on a 'similar' cdf file. !! !! ** Method: Uses vosaline do determine the bottom points. A depth !! reference can be specify to compute density refered to !! this depth. !! !! History : 2.1 : 11/2005 : J.M. Molines : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(1) :: ipk ! outptut variables : number of levels, INTEGER(KIND=4), DIMENSION(1) :: id_varout ! ncdf varid's INTEGER(KIND=4), DIMENSION(2) :: ismin, ismax ! location of min and max sigmabot REAL(KIND=4) :: zsigmn, zsigmx ! value of min and max of sigmabot REAL(KIND=4) :: zref ! value of min and max of sigmabot REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp, zsal ! Array to read a layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp0, zsal0 ! temporary array to read temp, sal REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsig ! potential density REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at surface REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter CHARACTER(LEN=256) :: cf_out='botsig.nc' ! Output file name CHARACTER(LEN=256) :: cf_tfil ! input filename CHARACTER(LEN=256) :: cv_sig ! output variable name CHARACTER(LEN=256) :: cref ! message for depth reference CHARACTER(LEN=256) :: cldum ! dummy char variable TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes LOGICAL :: lsigi=.FALSE. ! flag for sigma-i computation !!---------------------------------------------------------------------- CALL ReadCdfNames() !! Read command line narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfbottomsig T-file [zref]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Create a 2D file with bottom density. In case a depth reference' PRINT *,' is given, the density is refered to this depth. By default sigma-0' PRINT *,' is used. Bottom most point is determined from the last non zero ' PRINT *,' salinity point in the water column.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : input file with temperature and salinity ' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [zref] : depth reference for potential density' PRINT *,' If not given assume sigma-0' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : sobotsig0 or sobotsigi ( kg/m3 - 1000 )' STOP ENDIF cv_sig = 'sobotsig0' cref='' CALL getarg (1, cf_tfil) IF ( chkfile(cf_tfil) ) STOP ! missing file IF ( narg == 2 ) THEN lsigi = .TRUE. CALL getarg (2, cldum) ; READ(cldum,*) zref cv_sig = 'sobotsigi' WRITE(cref,'("_refered_to_",i4.4,"_m")') NINT(zref) ENDIF npiglo = getdim (cf_tfil,cn_x) npjglo = getdim (cf_tfil,cn_y) npk = getdim (cf_tfil,cn_z) npt = getdim (cf_tfil,cn_t) ipk(:)= 1 ! all variables (input and output are 3D) stypvar(1)%cname = cv_sig stypvar(1)%cunits = 'kg/m3' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0.001 stypvar(1)%valid_max = 40. stypvar(1)%clong_name = 'Bottom_Potential_density'//TRIM(cref) stypvar(1)%cshort_name = cv_sig stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TYX' PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt ALLOCATE (ztemp( npiglo,npjglo), zsal( npiglo,npjglo), zsig(npiglo,npjglo) ,zmask(npiglo,npjglo)) ALLOCATE (ztemp0(npiglo,npjglo), zsal0(npiglo,npjglo) ) ALLOCATE ( tim (npt) ) ! create output fileset ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, 1 , ipk , id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) zsal = 0. ztemp = 0. zmask = 1. DO jt = 1, npt DO jk = 1, npk PRINT *,'level ',jk zsal0(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt) ztemp0(:,:)= getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt) IF (jk == 1 ) THEN WHERE( zsal0 == 0. ) zmask=0. END IF WHERE ( zsal0 /= 0 ) zsal=zsal0 ; ztemp=ztemp0 END WHERE ENDDO IF (lsigi ) THEN zsig(:,:) = sigmai ( ztemp, zsal, zref, npiglo, npjglo ) * zmask(:,:) ELSE zsig(:,:) = sigma0 ( ztemp, zsal, npiglo, npjglo ) * zmask(:,:) ENDIF zsigmn=minval(zsig(2:npiglo-1,2:npjglo-1), zmask(2:npiglo-1,2:npjglo-1)==1) zsigmx=maxval(zsig(2:npiglo-1,2:npjglo-1), zmask(2:npiglo-1,2:npjglo-1)==1) ismin= minloc(zsig(2:npiglo-1,2:npjglo-1), zmask(2:npiglo-1,2:npjglo-1)==1) ismax= maxloc(zsig(2:npiglo-1,2:npjglo-1), zmask(2:npiglo-1,2:npjglo-1)==1) PRINT *,'Bottom density : min = ', zsigmn,' at ', ismin(1), ismin(2) PRINT *,' : max = ', zsigmx,' at ', ismax(1), ismax(2) ierr = putvar(ncout, id_varout(1), zsig, 1, npiglo, npjglo, ktime=jt) ENDDO tim = getvar1d(cf_tfil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim , npt, 'T') ierr = closeout(ncout) END PROGRAM cdfbottomsig cdftools-3.0/cdficediags.f900000644000175000017500000002733412241227304017076 0ustar amckinstryamckinstryPROGRAM cdficediag !!====================================================================== !! *** PROGRAM cdficediag *** !!===================================================================== !! ** Purpose : Compute the Ice volume, area and extend for each !! hemisphere !! !! ** Method : Use the icemod files for input and determine the !! hemisphere with sign of the coriolis parameter. !! !! History : 2.1 : 01/2006 : J.M. Molines : Original code !! : 2.1 : 07/2009 : R. Dussin : Add Ncdf output !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !! Modified: 3.0 : 08/2011 : P. Mathiot : Add LIM3 option !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jj, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: npiglo, npjglo, npt ! size of the domain INTEGER(KIND=4) :: nvpk ! vertical levels in working variable INTEGER(KIND=4) :: nperio = 4 ! boundary condition ( periodic, north fold) INTEGER(KIND=4) :: ikx=1, iky=1, ikz=1 ! dims of netcdf output file INTEGER(KIND=4) :: nboutput=8 ! number of values to write in cdf output INTEGER(KIND=4) :: ncout ! for netcdf output INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1, e2 ! metrics REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask, ff ! npiglo x npjglo REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ricethick, riceldfra ! thickness, leadfrac (concentration) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon, rdumlat ! dummy lon lat for output REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=8) :: dvols, dareas ! volume, area extend South hemisphere REAL(KIND=8) :: dextends, dextends2 ! volume, area extend South hemisphere REAL(KIND=8) :: dvoln, darean ! volume, area extend North hemisphere REAL(KIND=8) :: dextendn, dextendn2 ! volume, area extend North hemisphere TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output ! CHARACTER(LEN=256) :: cf_ifil ! input ice file CHARACTER(LEN=256) :: cf_out='icediags.nc' ! output file CHARACTER(LEN=256) :: cldum ! dummy string ! LOGICAL :: lchk = .false. ! missing file flag LOGICAL :: llim3 = .false. ! LIM3 flag !!---------------------------------------------------------------------- CALL ReadCdfNames() narg = iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdficediag ICE-file [-lim3] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the ice volume, area and extent for each hemisphere.' PRINT *,' The extent is computed in a similar way to NSIDC for easy ' PRINT *,' comparison : the extent is the surface of the grid cells covered' PRINT *,' by ice when the ice concentration is above 0.15' PRINT *,' ' PRINT *,' For compatibility with previous version, another estimate of ' PRINT *,' the extend is computed using grid cell surfaces weighted by the' PRINT *,' ice concentration, but it will be deprecated soon.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' ICE-file : netcdf icemod file (LIM2 by default)' PRINT *,' ' PRINT *,' OPTION :' PRINT *,' [-lim3 ] : LIM3 variable name convention is used' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fmsk) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : [NS]Volume (10^9 m3 )' PRINT *,' [NS]Area (10^9 m2 )' PRINT *,' [NS]Extent (10^9 m2 ) -- obsolete --' PRINT *,' [NS]Exnsidc (10^9 m2 )' PRINT *,' N = northern hemisphere' PRINT *,' S = southern hemisphere' PRINT *,' standard output' STOP ENDIF CALL getarg (1, cf_ifil) lchk = lchk .OR. chkfile(cn_fhgr) lchk = lchk .OR. chkfile(cn_fmsk) lchk = lchk .OR. chkfile(cf_ifil) IF ( lchk ) STOP ! missing file IF ( narg == 2 ) THEN CALL getarg (2, cldum) IF (TRIM(cldum) == '-lim3') THEN llim3 = .true. ELSE IF (TRIM(cldum) == '-lim2') THEN ELSE PRINT *,' For this sea-ice data format use a namelist ' END IF END IF npiglo = getdim (cf_ifil,cn_x) npjglo = getdim (cf_ifil,cn_y) npt = getdim (cf_ifil,cn_t) ALLOCATE ( tmask(npiglo,npjglo) ,ff(npiglo,npjglo) ) ALLOCATE ( ricethick(npiglo,npjglo) ) ALLOCATE ( riceldfra(npiglo,npjglo) ) ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo) ) ALLOCATE ( tim(npt) ) ALLOCATE ( stypvar(nboutput), ipk(nboutput), id_varout(nboutput) ) ALLOCATE ( rdumlon(1,1), rdumlat(1,1) ) rdumlon(:,:) = 0. rdumlat(:,:) = 0. ipk(:) = 1 ! define new variables for output stypvar%scale_factor = 1. stypvar%add_offset = 0. stypvar%savelog10 = 0. stypvar%conline_operation = 'N/A' stypvar%caxis = 'T' stypvar(1)%cname = 'NVolume' stypvar(1)%cunits = '10^9 m3' stypvar(1)%clong_name = 'Ice_volume_in_Northern_Hemisphere' stypvar(1)%cshort_name = 'NVolume' stypvar(2)%cname = 'NArea' stypvar(2)%cunits = '10^9 m2' stypvar(2)%clong_name = 'Ice_area_in_Northern_Hemisphere' stypvar(2)%cshort_name = 'NArea' stypvar(3)%cname = 'NExtent' stypvar(3)%cunits = '10^9 m2' stypvar(3)%clong_name = 'Ice_extent_in_Northern_Hemisphere' stypvar(3)%cshort_name = 'NExtent' stypvar(4)%cname = 'NExnsidc' stypvar(4)%cunits = '10^9 m2' stypvar(4)%clong_name = 'Ice_extent_similar_to_NSIDC_in_Northern_Hemisphere' stypvar(4)%cshort_name = 'NExnsidc' stypvar(5)%cname = 'SVolume' stypvar(5)%cunits = '10^9 m3' stypvar(5)%clong_name = 'Ice_volume_in_Southern_Hemisphere' stypvar(5)%cshort_name = 'SVolume' stypvar(6)%cname = 'SArea' stypvar(6)%cunits = '10^9 m2' stypvar(6)%clong_name = 'Ice_area_in_Southern_Hemisphere' stypvar(6)%cshort_name = 'SArea' stypvar(7)%cname = 'SExtent' stypvar(7)%cunits = '10^9 m2' stypvar(7)%clong_name = 'Ice_extent_in_Southern_Hemisphere' stypvar(7)%cshort_name = '' stypvar(8)%cname = 'SExnsidc' stypvar(8)%cunits = '10^9 m2' stypvar(8)%clong_name = 'Ice_extent_similar_to_NSIDC_in_Southern_Hemisphere' stypvar(8)%cshort_name = 'SExnsidc' e1(:,:) = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e2(:,:) = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) ff(:,:) = getvar(cn_fhgr, cn_gphit, 1, npiglo, npjglo) ! only the sign of ff is important ! modify the mask for periodic and north fold condition (T pivot, F Pivot ...) ! in fact should be nice to use jperio as in the code ... tmask(:,:)=getvar(cn_fmsk,'tmask',1,npiglo,npjglo) SELECT CASE (nperio) CASE (0) ! closed boundaries ! nothing to do CASE (4) ! ORCA025 type boundary tmask(1:2,:)=0. tmask(:,npjglo)=0. tmask(npiglo/2+1:npiglo,npjglo-1)= 0. CASE (6) tmask(1:2,:)=0. tmask(:,npjglo)=0. CASE DEFAULT PRINT *,' Nperio=', nperio,' not yet coded' STOP END SELECT ricethick(:,:)=0. riceldfra(:,:)=0. IF (llim3) THEN cn_iicethic = cn_iicethic3 cn_ileadfra = cn_ileadfra3 END IF ! Check variable IF (chkvar(cf_ifil, cn_iicethic)) THEN cn_iicethic='missing' PRINT *,'' PRINT *,' WARNING, ICE THICKNESS IS SET TO 0. ' PRINT *,' ' END IF IF (chkvar(cf_ifil, cn_ileadfra)) STOP ! DO jt = 1, npt IF (TRIM(cn_iicethic) .NE. 'missing') ricethick(:,:) = getvar(cf_ifil, cn_iicethic, 1, npiglo, npjglo, ktime=jt) riceldfra(:,:) = getvar(cf_ifil, cn_ileadfra, 1, npiglo, npjglo, ktime=jt) ! North : ff > 0 dvoln = SUM( ricethick (:,:)* e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (ff > 0 ) ) darean = SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (ff > 0 ) ) dextendn = SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (riceldfra > 0.15 .AND. ff > 0 ) ) ! JMM added 22/01/2007 : to compute same extent than the NSIDC dextendn2 = SUM( e1(:,:) * e2(:,:) * tmask (:,:), (riceldfra > 0.15 .AND. ff > 0 ) ) ! South : ff < 0 dvols = SUM( ricethick (:,:)* e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (ff < 0 ) ) dareas = SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (ff < 0 ) ) dextends = SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (riceldfra > 0.15 .AND. ff < 0 ) ) dextends2 = SUM( e1(:,:) * e2(:,:) * tmask (:,:), (riceldfra > 0.15 .AND. ff < 0 ) ) PRINT *,' TIME = ', jt,' ( ',tim(jt),' )' PRINT *,' Northern Hemisphere ' PRINT *,' NVolume (10^9 m3) ', dvoln /1.d9 PRINT *,' NArea (10^9 m2) ', darean /1.d9 PRINT *,' NExtend (10^9 m2) ', dextendn /1.d9 PRINT *,' NExnsidc (10^9 m2) ', dextendn2 /1.d9 PRINT * PRINT *,' Southern Hemisphere ' PRINT *,' SVolume (10^9 m3) ', dvols /1.d9 PRINT *,' SArea (10^9 m2) ', dareas /1.d9 PRINT *,' SExtend (10^9 m2) ', dextends /1.d9 PRINT *,' SExnsidc (10^9 m2) ', dextends2 /1.d9 IF ( jt == 1 ) THEN ! create output fileset ncout = create (cf_out, 'none', ikx, iky, ikz, cdep='depthw' ) ierr = createvar (ncout, stypvar, nboutput, ipk, id_varout ) ierr = putheadervar(ncout, cf_ifil, ikx, iky, ikz, pnavlon=rdumlon, pnavlat=rdumlat) tim = getvar1d(cf_ifil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ENDIF ! netcdf output ierr = putvar0d(ncout,id_varout(1), REAL(dvoln /1.d9), ktime=jt) ierr = putvar0d(ncout,id_varout(2), REAL(darean /1.d9), ktime=jt) ierr = putvar0d(ncout,id_varout(3), REAL(dextendn /1.d9), ktime=jt) ierr = putvar0d(ncout,id_varout(4), REAL(dextendn2 /1.d9), ktime=jt) ierr = putvar0d(ncout,id_varout(5), REAL(dvols /1.d9), ktime=jt) ierr = putvar0d(ncout,id_varout(6), REAL(dareas /1.d9), ktime=jt) ierr = putvar0d(ncout,id_varout(7), REAL(dextends /1.d9), ktime=jt) ierr = putvar0d(ncout,id_varout(8), REAL(dextends2 /1.d9), ktime=jt) END DO ! time loop ierr = closeout(ncout) END PROGRAM cdficediag cdftools-3.0/cdfpvor.f900000644000175000017500000003617012241227304016312 0ustar amckinstryamckinstryPROGRAM cdfpvor !!====================================================================== !! *** PROGRAM cdfpvor *** !!===================================================================== !! ** Purpose : Compute the Ertel Potential vorticity !! !! ** Method : Formula : !! Qpot = drho/dz * ( f + xsi ) = Qstr + Qrel !! * f is the Coriolis factor, computed from the latitudes of the T-grid : !! f(i,j) = 2 * omega * sin ( phit(i,j) * pi / 180 ) !! !! * xsi is the relative vorticity (vertical component of the velocity curl), !! computed from the relative vorticity of the F-points interpolated at !! the T-points : !! xsif(i,j) = ( ue(i,j) - ue(i,j+1) - ve(i,j) + ve(i+1,j) ) / areaf(i,j) !! with : ue(i,j) = U(i,j) * e1u(i,j) !! ve(i,j) = V(i,j) * e2v(i,j) !! areaf(i,j) = e1f(i,j) * e2f(i,j) !! xsi(i,j) = ( xsif(i-1,j-1) + xsif(i-1,j) + xsif(i,j-1) + xsif(i,j) ) / 4 !! = ( ue(i-1,j-1) + ue(i,j-1) - ue(i-1,j+1) - ue(i,j+1) !! - ve(i-1,j-1) - ve(i-1,j) + ve(i+1,j-1) + ve(i+1,j) ) !! / 4 / areat(i,j) !! with : areat(i,j) = e1t(i,j) * e2t(i,j) !! units : U, V in m.s-1 !! e1u, e2v, e1f, e2f in m !! f, xsi in s-1 !! Qpot, Qrel, Qstr in kg.m-4.s-1 !! !! History : 2.1 : 12/2005 : A.M. Treguier : Original code !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic., merge with cdfpv !!------------------------------------------------------------------- USE cdfio USE eos USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jj, ji, jt ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! command line INTEGER(KIND=4) :: ijarg, ireq ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: iup=1, idown=2, itmp ! working interger INTEGER(KIND=4) :: ncout ! ncid for output file INTEGER(KIND=4) :: nvar=3 ! number of output variable INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! output variable id's REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: ztemp, zsal, zwk ! array to ead 2 layer of data REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zn2 ! Brunt Vaissala frequency REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! tmask from salinity REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3w ! vertical metric REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1u, e2v ! horizontal metric REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t ! horizontal metric at T point REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: gphit ! latitude of t point REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! deptht REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! metric for full step REAL(KIND=4) :: zpi, zomega, rau0sg ! physical constant REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dun, dvn ! velocity component and flx REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: drotn ! curl of the velocity REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: d2fcor ! coriolis term at T point REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dstretch ! stretching vorticity REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dareat ! area of T cells CHARACTER(LEN=256) :: cf_tfil ! input T file CHARACTER(LEN=256) :: cf_ufil ! input U file CHARACTER(LEN=256) :: cf_vfil ! input V file CHARACTER(LEN=256) :: cf_out='pvor.nc' ! output file CHARACTER(LEN=256) :: cldum ! dummy character variable TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for attribute LOGICAL :: lfull = .FALSE. ! flag for full step LOGICAL :: lertel = .TRUE. ! flag for large scale pv LOGICAL :: lchk = .FALSE. ! flag for missing files !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg < 2 ) THEN PRINT *,' usage : cdfpvor T-file U-file V-file [-full] [-lspv ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the Ertel potential vorticity and save the relative ' PRINT *,' vorticity, the stretching and the total potential vorticity. ' PRINT *,' Qtot = ( f + xsi ) . D(rho)/D(z) = Qstrech + Qrel ' PRINT *,' With -lspv option, compute only Qstretch or Large Scale P V ' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : netcdf file for temperature and salinity. ' PRINT *,' U-file : netcdf file for zonal component of the velocity. ' PRINT *,' V-file : netcdf file for meridional component of the velocity.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [-full ] : indicate a full step configuration. ' PRINT *,' [-lspv ] : calculate only the large scale potential vorticity.' PRINT *,' ( replace the old cdflspv tool).' PRINT *,' If used only T-file is required, no need for velocities.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fhgr),' and ',TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : vorelvor (kg.m-4.s-1 ) relative vorticity' PRINT *,' vostrvor (kg.m-4.s-1 ) stretching vorticity' PRINT *,' vototvor (kg.m-4.s-1 ) total potential vorticity' PRINT *,' Ertel PV are located at T points.' PRINT *,' ' PRINT *,' With option -lspv :' PRINT *,' netcdf file : lspv.nc' PRINT *,' variables : volspv (kg.m-4.s-1 ) large scale potential vorticity' PRINT *,' LSPV is located at W points.' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfcurl ( compute only the curl on 1 level)' PRINT *,' ' STOP ENDIF ijarg = 1 ; ireq = 0 DO WHILE ( ijarg <= narg ) CALL getarg( ijarg, cldum ) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-full' ) ; lfull = .TRUE. CASE ( '-lspv' ) ; lertel = .FALSE. ; nvar = 1 ; cf_out = 'lspv.nc' CASE DEFAULT ireq=ireq+1 SELECT CASE ( ireq ) CASE ( 1 ) ; cf_tfil = cldum CASE ( 2 ) ; cf_ufil = cldum CASE ( 3 ) ; cf_vfil = cldum CASE DEFAULT PRINT *,' Too many arguments '; STOP END SELECT END SELECT END DO lchk = lchk .OR. chkfile( cn_fzgr) lchk = lchk .OR. chkfile( cn_fhgr) lchk = lchk .OR. chkfile( cf_tfil) IF ( lertel ) THEN lchk = lchk .OR. chkfile( cf_ufil) lchk = lchk .OR. chkfile( cf_vfil) ENDIF IF ( lchk ) STOP ! missing file npiglo = getdim (cf_tfil, cn_x) npjglo = getdim (cf_tfil, cn_y) npk = getdim (cf_tfil, cn_z) npt = getdim (cf_tfil, cn_t) PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk PRINT *, 'npt = ', npt ALLOCATE ( e1u(npiglo,npjglo), e1t(npiglo,npjglo) ) ALLOCATE ( e2v(npiglo,npjglo), e2t(npiglo,npjglo) ) ALLOCATE ( gphit(npiglo,npjglo), d2fcor(npiglo,npjglo) ) ALLOCATE ( tmask(npiglo,npjglo) ) ALLOCATE ( gdepw(npk), tim(npt) ) ALLOCATE ( dstretch(npiglo,npjglo) ) IF ( lertel ) THEN ALLOCATE ( dareat(npiglo,npjglo) ) ALLOCATE ( dun(npiglo,npjglo), dvn(npiglo,npjglo) ) ALLOCATE ( drotn(npiglo,npjglo) ) ENDIF IF ( lfull ) ALLOCATE ( e31d(npk) ) e1u = getvar(cn_fhgr, cn_ve1u, 1, npiglo, npjglo) e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo) e2v = getvar(cn_fhgr, cn_ve2v, 1, npiglo, npjglo) e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo) gphit = getvar(cn_fhgr, cn_gphit, 1, npiglo, npjglo) rau0sg = 1020./9.81 zpi = ACOS(-1.) zomega = 2.0 * zpi /(3600*24) d2fcor(:,:) = 2.d0 * zomega * SIN(gphit(:,:)*zpi/180.0) dareat(:,:) = 4.d0 * e1t(:,:) * e2t(:,:) ! factor of 4 to normalize relative vorticity gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk) ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2)) ALLOCATE (zwk(npiglo,npjglo,2) ) ALLOCATE (zn2(npiglo,npjglo) , e3w(npiglo,npjglo) ) ALLOCATE ( stypvar(nvar), ipk(nvar), id_varout(nvar) ) ! create output fileset ipk(:)= npk ! Those three variables are 3D stypvar%cunits = 'kg.m-4.s-1' stypvar%rmissing_value = 0. stypvar%valid_min = -1000. stypvar%valid_max = 1000. stypvar%conline_operation = 'N/A' stypvar%caxis = 'TZYX' IF (lertel ) THEN ! define variable name and attribute stypvar(1)%cname = 'vorelvor' ; stypvar(1)%clong_name = 'Relative_component_of_Ertel_PV' stypvar(2)%cname = 'vostrvor' ; stypvar(2)%clong_name = 'Stretching_component_of_Ertel_PV' stypvar(3)%cname = 'vototvor' ; stypvar(3)%clong_name = 'Ertel_potential_vorticity' stypvar(1)%cshort_name = 'vorelvor' stypvar(2)%cshort_name = 'vostrvor' stypvar(3)%cshort_name = 'vototvor' ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk ) ierr = createvar (ncout, stypvar, nvar, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk ) ELSE stypvar(1)%cname = 'volspv' ; stypvar(1)%clong_name = 'Large Scale Potential_vorticity' stypvar(1)%cshort_name = 'volspv' ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk, cdep=TRIM(cn_vdepthw) ) ierr = createvar (ncout, stypvar, nvar, ipk, id_varout ) ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk, pdep=gdepw ) ENDIF IF ( lfull ) e31d = getvare3( cn_fzgr, cn_ve3w, npk ) tim = getvar1d(cf_ufil, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T' ) DO jt=1,npt ! 2 levels of T and S are required : iup,idown (with respect to W level) ! Compute from bottom to top (for vertical integration) PRINT *,'time=',jt,'(days:',tim(jt)/86400.,')' ztemp(:,:,idown) = getvar(cf_tfil, cn_votemper, npk-1, npiglo, npjglo, ktime=jt) zsal( :,:,idown) = getvar(cf_tfil, cn_vosaline, npk-1, npiglo, npjglo, ktime=jt) ! -------------------------------- LOOP OVER LEVELS DO jk = npk-1, 1, -1 PRINT *,' level ',jk IF ( lertel ) THEN ! ------------------------------------RELATIVE VORTICITY FIRST dun(:,:) = getvar(cf_ufil, cn_vozocrtx, jk ,npiglo, npjglo, ktime=jt) dvn(:,:) = getvar(cf_vfil, cn_vomecrty, jk ,npiglo, npjglo, ktime=jt) dun(:,:) = dun(:,:)*e1u(:,:) dvn(:,:) = dvn(:,:)*e2v(:,:) ! relative vorticity at T point drotn(:,:) = 0.d0 DO jj = 2, npjglo -1 DO ji = 2, npiglo -1 drotn(ji,jj) = ( dun(ji-1,jj-1) + dun(ji,jj-1) & & -dun(ji-1,jj+1) - dun(ji,jj+1) & & -dvn(ji-1,jj-1) - dvn(ji-1,jj) & & +dvn(ji+1,jj-1) + dvn(ji+1,jj)) & / dareat(ji,jj) END DO END DO ENDIF ! now tmask and Vaisala Frequency bn2 IF ( jk > 1) THEN tmask(:,:)=1. ztemp(:,:,iup) = getvar(cf_tfil, cn_votemper, jk-1 ,npiglo, npjglo, ktime=jt) zsal(:,:,iup) = getvar(cf_tfil, cn_vosaline, jk-1 ,npiglo, npjglo, ktime=jt) WHERE(zsal(:,:,idown) == 0 ) tmask = 0 IF ( lfull ) THEN e3w(:,:) = e31d(jk) ELSE e3w(:,:) = getvar(cn_fzgr, 'e3w_ps', jk, npiglo, npjglo ,ldiom=.TRUE.) ENDIF WHERE (e3w == 0 ) e3w = 1. zwk(:,:,iup) = eosbn2 ( ztemp, zsal, gdepw(jk), e3w, npiglo, npjglo ,iup, idown)* tmask(:,:) ! IF ( lertel ) THEN ! put zn2 at T level (k ) WHERE ( zwk(:,:,idown) == 0 ) zn2(:,:) = zwk(:,:,iup) ELSEWHERE zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * tmask(:,:) END WHERE ELSE ! keep bn2 at w points zn2(:,:) = zwk(:,:,iup) * tmask(:,:) ENDIF ENDIF ! ! now rotn will be converted to relative vorticity and zn2 to stretching dstretch(:,:) = d2fcor(:,:)* rau0sg * zn2(:,:) IF ( lertel ) THEN drotn(:,:) = drotn(:,:) * rau0sg * zn2(:,:) ! write the three variables on file at level k ierr = putvar(ncout, id_varout(1), REAL( drotn )*1.e7, jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(2), REAL( dstretch )*1.e7, jk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(3), REAL((drotn+dstretch))*1.e7, jk, npiglo, npjglo, ktime=jt) ELSE ! save absolute value of dstretch, as in olf cdflspv ierr = putvar(ncout, id_varout(1), REAL( ABS(dstretch) )*1.e7, jk, npiglo, npjglo, ktime=jt) ENDIF itmp = idown ; idown = iup ; iup = itmp END DO ! loop to next level ! set zero at bottom and surface zwk(:,:,1) = 0.e0 ierr = putvar(ncout, id_varout(1), zwk(:,:,1), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(1), zwk(:,:,1), npk, npiglo, npjglo, ktime=jt) IF (lertel ) THEN ierr = putvar(ncout, id_varout(2), zwk(:,:,1), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(3), zwk(:,:,1), 1, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(2), zwk(:,:,1), npk, npiglo, npjglo, ktime=jt) ierr = putvar(ncout, id_varout(3), zwk(:,:,1), npk, npiglo, npjglo, ktime=jt) ENDIF END DO ! loop on time ierr = closeout(ncout) END PROGRAM cdfpvor cdftools-3.0/cdfstats.f900000644000175000017500000003375412241227304016467 0ustar amckinstryamckinstryPROGRAM cdfstats !!====================================================================== !! *** PROGRAM cdfstats *** !!===================================================================== !! ** Purpose : Compute RMS/CORREL between 2 files. !! Seasonal cycle removed !! !! ** Method : !! !! History : 2.1 : 2009 : M.A. Balmaseda : original code from cdfrmsssh.f90 !! 3.0 : 10/2012 : M.A. Balmaseda : Merged into CDFTOOLS_3.0 !! 3.0 : 11/2012 : J.M. Molines : Dr norm + licence !!---------------------------------------------------------------------- USE cdfio USE modcdfnames USE modutils, ONLY : SetGlobalAtt !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2012 !! $Id$ !! Copyright (c) 2012, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jt, jm ! dummy loop index INTEGER(KIND=4) :: narg, iargc, ijarg, ij ! browse command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, nt ! size of the domain INTEGER(KIND=4), PARAMETER :: jpvar=4 ! number of output variables INTEGER(KIND=4), DIMENSION(jpvar) :: ipk, id_varout TYPE(variable), DIMENSION(jpvar) :: stypvar ! structure for attribute REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: u, v ! input variables from file 1 and 2 REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask, e1t, e2t ! mask and metrics REAL(KIND=4), DIMENSION(1) :: timean ! time for output (dummy) REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_er, dl_uv ! rms, correlation REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_sn, dl_sg ! signal/noise signal ratios REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_du, dl_dv ! variable anomaly REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_u2, dl_v2 ! quadratic sum REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_um, dl_vm ! linear sum REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_area ! cell areas REAL(KIND=8) :: dl_spma ! total area of the ocean ( info only) REAL(KIND=8) :: dl_spmu, dl_spmv ! global mean (info only) REAL(KIND=8) :: dl_fct, dl_fcts ! scaling coefficients CHARACTER(LEN=256) :: cf_in, cf_ref ! input and reference file names CHARACTER(LEN=256) :: cf_msk, cf_hgr ! current mask and hgr file CHARACTER(LEN=256) :: cf_out = 'stats.nc' ! output file CHARACTER(LEN=256) :: cglobal ! Global attribute CHARACTER(LEN=256) :: cldum ! dummy string for arguments CHARACTER(LEN=20) :: cv_name1, cv_name2 ! variable name CHARACTER(LEN=2) :: cy ! (1 or 12 ) INTEGER(KIND=4) :: ncy ! 1/12 for annual/seasonal statistics INTEGER(KIND=4) :: ncout ! ID of netcdf output file INTEGER(KIND=4) :: ierr ! error status for ncdf LOGICAL :: lchk ! flag for checking missing files !!-------------------------------------------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg < 3 ) THEN PRINT *,' usage : cdfstats IN-file REF-file ncy [VAR-name1 [VAR-name2]] ...' PRINT *,' [-m mesh_mask file ]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' This tool computes some statistics (rms, correlation, ' PRINT *,' signal/noise ratio and signal ratio [ratio of std ' PRINT *,' deviation]) between to files. In this tool, the files' PRINT *,' are supposed to hold monthly averages values, for many ' PRINT *,' years. Specifying ncy=12, allows to remove the seasonal' PRINT *,' cycle of the data.' PRINT *,' This program was initially written for SSH statistics' PRINT *,' between model output and AVISO files (default variable' PRINT *,' names are ',TRIM(cn_sossheig),' for this reason ). It can' PRINT *,' now be used with any variables.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : First data file ( usually model output) ' PRINT *,' REF-file : Second data file ( usually observation file) ' PRINT *,' ncy : 1 or 12. If set to 12, annual cycle is removed ' PRINT *,' from the data ' PRINT *,' [VAR-name1 [VAR-name2]] : If variable names of input files' PRINT *,' are not ', TRIM(cn_sossheig),' they can be specified' PRINT *,' on the command line. If only one name is given, it is' PRINT *,' assumed that both file use same variable name.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' -m mesh_mask file : specify a mesh_mask file holding the tmaskutil' PRINT *,' and the horizontal metrics. If this option is not used,' PRINT *,' mask are taken in ',TRIM(cn_fmsk), ' and horizontal metric' PRINT *,' is taken in ',TRIM(cn_fhgr) PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ' , TRIM(cn_fmsk),' and ', TRIM(cn_fhgr) PRINT *,' or mesh_mask file specified in -m option' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables are : ' PRINT *,' rms : RMS between the input files' PRINT *,' correl : CORREL between the input files' PRINT *,' rrat : Signal to noise ratio ' PRINT *,' srat : Signal ratio (stdev ratio) ' PRINT *,' ' STOP ENDIF ! default values cf_msk = cn_fmsk cf_hgr = cn_fhgr cv_name1 = cn_sossheig cv_name2 = cn_sossheig CALL SetGlobalAtt( cglobal ) ! global attribute for history : command line ! Browse command line ijarg = 1 ; ij = 0 DO WHILE (ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum ) CASE ( '-m ' ) ! non default mesh-mask file CALL getarg (ijarg, cldum ) ; ijarg = ijarg + 1 cf_msk = cldum cf_hgr = cldum CASE DEFAULT ! the order of arguments does matter ! ij = ij + 1 SELECT CASE (ij) CASE ( 1 ) ; cf_in = cldum CASE ( 2 ) ; cf_ref = cldum CASE ( 3 ) ; cy = cldum ; READ(cy, * ) ncy CASE ( 4 ) ; cv_name1 = cldum CASE ( 5 ) ; cv_name2 = cldum CASE DEFAULT PRINT *, ' Too many arguments ...' STOP END SELECT END SELECT END DO IF (ij == 4 ) cv_name2 = cv_name1 ! if only one variable name given, take the same for both ! Security check for files lchk = chkfile ( cf_in ) lchk = chkfile ( cf_ref ) .OR. lchk lchk = chkfile ( cf_msk ) .OR. lchk lchk = chkfile ( cf_hgr ) .OR. lchk IF (lchk ) STOP ! missing files ! log arguments do far PRINT *,'IN-file : ', TRIM(cf_in ) PRINT *,'REF-file : ', TRIM(cf_ref) PRINT *,'NCY : ', ncy PRINT *,'VAR-name1 : ', TRIM(cv_name1) PRINT *,'VAR_name2 : ', TRIM(cv_name2) PRINT *,'MASK file : ', TRIM(cf_msk ) PRINT *,'HGR file : ', TRIM(cf_hgr ) ! define domain size from IN-file npiglo = getdim (cf_in, cn_x ) npjglo = getdim (cf_in, cn_y ) nt = getdim (cf_in, cn_t ) ! read time dimension npk = 1 PRINT *, 'NPIGLO =', npiglo PRINT *, 'NPJGLO =', npjglo PRINT *, 'NPK =', npk ! Allocate arrays from domain size ALLOCATE( u(npiglo,npjglo), v(npiglo,npjglo) ) ALLOCATE( tmask(npiglo,npjglo), e1t(npiglo,npjglo), e2t(npiglo,npjglo) ) ALLOCATE( dl_er(npiglo,npjglo), dl_uv(npiglo,npjglo) ) ALLOCATE( dl_sn(npiglo,npjglo), dl_sg(npiglo,npjglo) ) ALLOCATE( dl_u2(npiglo,npjglo), dl_v2(npiglo,npjglo) ) ALLOCATE( dl_du(npiglo,npjglo), dl_dv(npiglo,npjglo) ) ALLOCATE( dl_um(npiglo,npjglo), dl_vm(npiglo,npjglo) ) ALLOCATE( dl_area(npiglo,npjglo) ) ! prepare output file ! common features to all variables ipk (:) = 1 stypvar(:)%conline_operation = 'N/A' stypvar(:)%caxis = 'TYX' ! specific features stypvar(1)%cname = 'rms' stypvar(1)%cunits = 'm' stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = 0. stypvar(1)%valid_max = 100. stypvar(1)%clong_name = 'RMS_'//TRIM(cv_name1)//'_'//TRIM(cv_name2)//'_'//cy stypvar(1)%cshort_name = 'rms' stypvar(2)%cname = 'correl' stypvar(2)%cunits = 'ndim' stypvar(2)%rmissing_value = 0. stypvar(2)%valid_min = -1. stypvar(2)%valid_max = 1. stypvar(2)%clong_name = 'CORREL_'//TRIM(cv_name1)//'_'//TRIM(cv_name2)//'_'//cy stypvar(2)%cshort_name = 'correl' stypvar(3)%cname = 'rrat' stypvar(3)%cunits = 'N/A' stypvar(3)%rmissing_value = 0. stypvar(3)%valid_min = 0. stypvar(3)%valid_max = 100. stypvar(3)%clong_name = 'RMS/signal_'//TRIM(cv_name1)//'_'//TRIM(cv_name2)//'_'//cy stypvar(3)%cshort_name = 'rrat' stypvar(4)%cname = 'srat' stypvar(4)%cunits = 'N/A' stypvar(4)%rmissing_value = 0. stypvar(4)%valid_min = 0. stypvar(4)%valid_max = 100. stypvar(4)%clong_name = 'sdvm/sdvo_'//TRIM(cv_name1)//'_'//TRIM(cv_name2)//'_'//cy stypvar(4)%cshort_name = 'srat' ! Read mask and metrics tmask= getvar(cf_msk, 'tmaskutil', 1, npiglo, npjglo) e1t = getvar(cf_hgr, cn_ve1t, 1, npiglo, npjglo) e2t = getvar(cf_hgr, cn_ve2t, 1, npiglo, npjglo) dl_area(:,:) = tmask(:,:)*e1t(:,:)*e2t(:,:)*1.d0 ! masked cell area dl_spma = SUM(dl_area) ! model ocean area dl_fct = 1.d0/float(nt) dl_fcts = 1.d0*float(ncy)*dl_fct PRINT *, 'dl_spma = ',dl_spma, SUM(tmask) PRINT *,' creating output file' ncout = create (cf_out, cf_in, npiglo, npjglo, npk ) ierr = createvar(ncout, stypvar, jpvar, ipk, id_varout, cdglobal=TRIM(cglobal)) PRINT *,' output file created' dl_er(:,:) = 0.d0 ! rms dl_uv(:,:) = 0.d0 ! correlation dl_u2(:,:) = 0.d0 ! variance var1 dl_v2(:,:) = 0.d0 ! variance var2 dl_sn(:,:) = 0.d0 ! signal to noise ratio (rms/sdv) dl_sg(:,:) = 0.d0 ! signal ratio (sdv(1)/sdv(2)) DO jm = 1, ncy ! loop on month (ncy=12) or no loop if annual file (ncy=1) dl_um(:,:) = 0.d0 dl_vm(:,:) = 0.d0 PRINT *,' computing mean for month ',jm DO jt = jm, nt, ncy u(:,:) = getvar(cf_in , cv_name1, 1, npiglo, npjglo, ktime=jt) v(:,:) = getvar(cf_ref, cv_name2, 1, npiglo, npjglo, ktime=jt) dl_um(:,:) = dl_um(:,:) + u(:,:)*tmask(:,:)*1.d0 dl_vm(:,:) = dl_vm(:,:) + v(:,:)*tmask(:,:)*1.d0 ENDDO dl_um(:,:) = dl_um(:,:)*dl_fcts dl_vm(:,:) = dl_vm(:,:)*dl_fcts PRINT *,'MIN MAX UM ',MINVAL(dl_um), MAXVAL(dl_um) PRINT *,'MIN MAX VM ',MINVAL(dl_vm), MAXVAL(dl_vm) PRINT *,'computing 2nd order statistics' DO jt = jm, nt, ncy u(:,:) = getvar(cf_in , cv_name1, 1, npiglo, npjglo, ktime = jt) v(:,:) = getvar(cf_ref, cv_name2, 1, npiglo, npjglo, ktime = jt) ! anomaly dl_du(:,:) = (u(:,:) - dl_um(:,:))*tmask(:,:) dl_dv(:,:) = (v(:,:) - dl_vm(:,:))*tmask(:,:) ! REM no used if print below commented out (jmm ?) ! dl_spmu = SUM(u(:,:)*dl_area(:,:))/dl_spma ! dl_spmv = SUM(v(:,:)*dl_area(:,:))/dl_spma ! PRINT *,' jt, dl_spmu, dl_spmv ', jt, dl_spmu,dl_spmv dl_u2(:,:)=dl_u2(:,:) + dl_du(:,:) * dl_du(:,:) dl_v2(:,:)=dl_v2(:,:) + dl_dv(:,:) * dl_dv(:,:) dl_er(:,:)=dl_er(:,:) + (dl_du(:,:)-dl_dv(:,:)) * (dl_du(:,:)-dl_dv(:,:)) dl_uv(:,:)=dl_uv(:,:) + dl_du(:,:) * dl_dv(:,:) ENDDO ENDDO ! loop on month dl_u2(:,:) = dl_u2(:,:)*dl_fct dl_v2(:,:) = dl_v2(:,:)*dl_fct dl_uv(:,:) = dl_uv(:,:)*dl_fct dl_er(:,:) = SQRT(dl_er(:,:)*dl_fct) WHERE (tmask(:,:) > 0 ) dl_uv(:,:) = dl_uv(:,:)/SQRT(dl_u2(:,:)*dl_v2(:,:)) WHERE (tmask(:,:) > 0 ) dl_sn(:,:) = dl_er(:,:)/SQRT(dl_v2(:,:)) WHERE (tmask(:,:) > 0 ) dl_sg(:,:) = SQRT(dl_u2(:,:)/dl_v2(:,:)) ! some print on standard output PRINT *,'MIN MAX RMS ', MINVAL(dl_er), MAXVAL(dl_er) PRINT *,'MIN MAX CORREL ', MINVAL(dl_uv), MAXVAL(dl_uv) PRINT *,'MIN MAX SIGNAL/NOISE ', MINVAL(dl_sn), MAXVAL(dl_sn) PRINT *,'MIN MAX SIGNAL RATIO ', MINVAL(dl_sg), MAXVAL(dl_sg) ! output on NC file ierr = putvar(ncout, id_varout(1), REAL(dl_er), 1, npiglo, npjglo) ierr = putvar(ncout, id_varout(2), REAL(dl_uv), 1, npiglo, npjglo) ierr = putvar(ncout, id_varout(3), REAL(dl_sn), 1, npiglo, npjglo) ierr = putvar(ncout, id_varout(4), REAL(dl_sg), 1, npiglo, npjglo) timean(1) = 1.e0 ierr = putvar1d(ncout,timean,1,'T') ierr = closeout(ncout ) END PROGRAM cdfstats cdftools-3.0/cdftools.f900000644000175000017500000003506512241227304016466 0ustar amckinstryamckinstryMODULE cdftools !!====================================================================== !! *** MODULE cdftools *** !! This module holds subroutine that corresponds to cdftools. !! For example cdf_findij is the subroutine equivalent to cdffindij !!===================================================================== !! History : 2.1 ! 05/2010 : J.M. Molines, A. Melet : Original !! 3.0 ! 12/2010 : J.M. Molines : Doctor + Lic. !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! cdf_findij : the routine version of cdffindij !! NearestPoint : determine the nearest point from a lon lat location !! dist : compute the distance along othodromic route !!---------------------------------------------------------------------- USE cdfio USE modcdfnames IMPLICIT NONE PRIVATE ! list of public subroutines that can be called PUBLIC :: cdf_findij PRIVATE :: NearestPoint PRIVATE :: dist !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE cdf_findij ( pxmin, pxmax, pymin, pymax, & & kimin, kimax, kjmin, kjmax, cd_coord, cd_point, cd_verbose) !!--------------------------------------------------------------------- !! *** ROUTINE cdf_findij *** !! !! ** Purpose : the routine equivalent of cdffindij !! !!---------------------------------------------------------------------- REAL(KIND=4), INTENT(in) :: pxmin, pxmax, pymin, pymax !: geographical window in lon-lat INTEGER(KIND=4), INTENT(out) :: kimin, kimax, kjmin, kjmax !: equivalent in model coordinates CHARACTER(*), OPTIONAL, INTENT(in) :: cd_coord !: coordinate file name (D: cn_fcoo) CHARACTER(*), OPTIONAL, INTENT(in) :: cd_point !: point type (D: F ) CHARACTER(*), OPTIONAL, INTENT(in) :: cd_verbose !: verbose flag (D: N ) Y INTEGER(KIND=4) :: initer INTEGER(KIND=4) :: imin, imax, jmin, jmax INTEGER(KIND=4), SAVE :: iloc, jloc INTEGER(KIND=4) :: ipiglo, ipjglo INTEGER(KIND=4), PARAMETER :: jp_itermax=15 REAL(KIND=8) :: dl_xmin, dl_xmax, dl_ymin, dl_ymax REAL(KIND=8) :: dl_dis REAL(KIND=8) :: dl_glam0, dl_emax REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_glam, dl_gphi, dl_e1, dl_e2 REAL(KIND=4) :: zglamfound, zglamin, zglamax CHARACTER(LEN=256) :: cl_type='F' CHARACTER(LEN=256) :: clcoo LOGICAL :: ll_again, ll_bnd, ll_verbose=.false. !!-------------------------------------------------------------------------- CALL ReadCdfNames() dl_xmin = pxmin dl_xmax = pxmax dl_ymin = pymin dl_ymax = pymax IF ( PRESENT( cd_coord) ) clcoo=cd_coord IF ( PRESENT( cd_point) ) cl_type=cd_point IF ( PRESENT( cd_verbose)) THEN IF ( cd_verbose(1:1) == 'Y' .OR. cd_verbose(1:1) == 'y' ) ll_verbose=.true. ENDIF IF (chkfile (clcoo) ) STOP ! missing file ipiglo= getdim (clcoo, cn_x) ipjglo= getdim (clcoo, cn_y) ALLOCATE (dl_glam(ipiglo,ipjglo), dl_gphi(ipiglo,ipjglo) ) ALLOCATE (dl_e1 (ipiglo,ipjglo), dl_e2 (ipiglo,ipjglo) ) SELECT CASE ( cl_type ) CASE ('T' , 't' ) dl_glam(:,:) = getvar(clcoo, cn_glamt, 1, ipiglo, ipjglo) dl_gphi(:,:) = getvar(clcoo, cn_gphit, 1, ipiglo, ipjglo) dl_e1 (:,:) = getvar(clcoo, cn_ve1t, 1, ipiglo, ipjglo) dl_e2 (:,:) = getvar(clcoo, cn_ve2t, 1, ipiglo, ipjglo) CASE ('U','u' ) dl_glam(:,:) = getvar(clcoo, cn_glamu, 1, ipiglo, ipjglo) dl_gphi(:,:) = getvar(clcoo, cn_gphiu, 1, ipiglo, ipjglo) dl_e1 (:,:) = getvar(clcoo, cn_ve1u, 1, ipiglo, ipjglo) dl_e2 (:,:) = getvar(clcoo, cn_ve2u, 1, ipiglo, ipjglo) CASE ('V','v' ) dl_glam(:,:) = getvar(clcoo, cn_glamv, 1, ipiglo, ipjglo) dl_gphi(:,:) = getvar(clcoo, cn_gphiv, 1, ipiglo, ipjglo) dl_e1 (:,:) = getvar(clcoo, cn_ve1v, 1, ipiglo, ipjglo) dl_e2 (:,:) = getvar(clcoo, cn_ve2v, 1, ipiglo, ipjglo) CASE ('F','f' ) dl_glam(:,:) = getvar(clcoo, cn_glamf, 1, ipiglo, ipjglo) dl_gphi(:,:) = getvar(clcoo, cn_gphif, 1, ipiglo, ipjglo) dl_e1 (:,:) = getvar(clcoo, cn_ve1f, 1, ipiglo, ipjglo) dl_e2 (:,:) = getvar(clcoo, cn_ve2f, 1, ipiglo, ipjglo) CASE DEFAULT PRINT *,' ERROR : type of point not known: ', TRIM(cl_type) END SELECT ! work with longitude between 0 and 360 to avoid the date line. WHERE( dl_glam < 0 ) dl_glam = dl_glam + 360.d0 ! For Orca grid, the longitude of ji=1 is about 70 E dl_glam0 = dl_glam(1, ipjglo/2) WHERE( dl_glam < dl_glam0 ) dl_glam =dl_glam + 360.d0 IF (dl_xmin < 0.) dl_xmin = dl_xmin + 360.d0 IF (dl_xmax < 0.) dl_xmax = dl_xmax + 360.d0 IF (dl_xmin < dl_glam0) dl_xmin = dl_xmin + 360.d0 IF (dl_xmax < dl_glam0) dl_xmax = dl_xmax + 360.d0 ! deal with xmin, ymin ll_again = .TRUE. initer = 1 DO WHILE (ll_again) CALL NearestPoint(dl_xmin, dl_ymin, ipiglo, ipjglo, dl_glam, dl_gphi, iloc, jloc, ll_bnd) ! distance between the target point and the nearest point dl_dis = dist(dl_xmin, dl_glam(iloc,jloc), dl_ymin, dl_gphi(iloc,jloc) ) ! in km ! typical grid size (diagonal) in the vicinity of nearest point dl_emax= MAX(dl_e1(iloc,jloc), dl_e2(iloc,jloc))/1000.*SQRT(2.) ! in km IF (dl_dis > dl_emax ) THEN zglamfound = dl_glam(iloc,jloc) ; IF (zglamfound > 180.) zglamfound=zglamfound - 360. PRINT 9000, 'Long= ',zglamfound,' Lat = ',dl_gphi(iloc,jloc) , iloc, jloc PRINT *,' Algorithm does''nt converge ', dl_dis IF ( initer >= jp_itermax ) THEN PRINT *, ' no convergence after ', jp_itermax,' iterations' iloc = -1000 jloc = -1000 ll_again = .FALSE. ELSE ll_again = .TRUE. initer = initer +1 jloc = (initer -1)* ipjglo/initer iloc = (initer -1)* ipiglo/jp_itermax ENDIF ELSE IF ( ll_verbose ) THEN PRINT '("# dl_dis= ",f8.3," km")', dl_dis ENDIF ll_again = .FALSE. END IF END DO IF (ll_bnd .AND. ll_verbose ) THEN WRITE (*,*)'Point Out of domain or on boundary' ELSE imin=iloc jmin=jloc ENDIF ! deal with xmax, ymax IF ( pxmin == pxmax .AND. pymin == pymax ) THEN ! job already done with first point imax=imin jmax=jmin ELSE ll_again = .TRUE. initer = 1 iloc=ipiglo/2 ; jloc=ipjglo/2 DO WHILE (ll_again) CALL NearestPoint(dl_xmax, dl_ymax, ipiglo, ipjglo, dl_glam, dl_gphi, iloc, jloc, ll_bnd) ! distance between the target point and the nearest point dl_dis = dist(dl_xmax, dl_glam(iloc,jloc), dl_ymax, dl_gphi(iloc,jloc) ) ! in km ! typical grid size (diagonal) in the vicinity of nearest point dl_emax = MAX(dl_e1(iloc,jloc),dl_e2(iloc,jloc))/1000.*SQRT(2.) ! in km IF (dl_dis > dl_emax ) THEN zglamfound=dl_glam(iloc,jloc) ; IF (zglamfound > 180.) zglamfound=zglamfound -360. PRINT 9000, 'Long= ',zglamfound,' Lat = ',dl_gphi(iloc,jloc), iloc, jloc PRINT *,' Algorithm does''nt converge ', dl_dis IF ( initer >= jp_itermax ) THEN PRINT *, ' no convergence after ', jp_itermax,' iterations' iloc = -1000 jloc = -1000 ll_again = .FALSE. ELSE ll_again = .TRUE. initer = initer +1 jloc = (initer -1)* ipjglo/initer iloc = (initer -1)* ipiglo/jp_itermax ENDIF ELSE IF ( ll_verbose ) THEN PRINT '("# dl_dis= ",f8.3," km")', dl_dis ENDIF ll_again = .FALSE. END IF END DO IF (ll_bnd .AND. ll_verbose ) THEN WRITE (*,*) 'Point Out of domain or on boundary' ELSE imax=iloc jmax=jloc ENDIF ENDIF IF (ll_verbose) PRINT 9001, imin, imax, jmin, jmax kimin = imin ; kimax = imax ; kjmin = jmin ; kjmax = jmax zglamin = dl_glam(imin,jmin) ; zglamax = dl_glam(imax,jmax) IF ( zglamin > 180 ) zglamin=zglamin-360. IF ( zglamax > 180 ) zglamax=zglamax-360. IF ( ll_verbose) PRINT 9002, zglamin, zglamax, dl_gphi(imin,jmin),dl_gphi(imax,jmax) 9000 FORMAT(a,f8.2,a,f8.2,2i5) 9001 FORMAT(4i10) 9002 FORMAT(4f10.4) END SUBROUTINE cdf_findij SUBROUTINE NearestPoint(ddlon, ddlat, kpi, kpj, ddlam, ddphi, kpiloc, kpjloc, ld_bnd) !!--------------------------------------------------------------------- !! *** ROUTINE NearestPoint *** !! !! ** Purpose : Computes the positions of the nearest i,j in the grid !! from the given longitudes and latitudes !! !! ** Method : Starts on the middle of the grid, search in a 20x20 box, !! and move the box in the direction where the distance !! between the box and the point is minimum. !! Iterates ... !! Stops when the point is outside the grid. !! !! References : P.A. Darbon and A. de Miranda acknowledged for this !! clever algorithm developped in CLIPPER. !!---------------------------------------------------------------------- REAL(KIND=8), INTENT(in) :: ddlon, ddlat !: lon and lat of target point INTEGER(KIND=4), INTENT (in) :: kpi, kpj !: grid size REAL(KIND=8), DIMENSION(kpi,kpj), INTENT(in) :: ddlam, ddphi !: model grid layout INTEGER(KIND=4), INTENT (inout) :: kpiloc, kpjloc !: nearest point location LOGICAL :: ld_bnd !: reach boundary flag INTEGER(KIND=4) :: ji, jj INTEGER(KIND=4), PARAMETER :: jp_blk=10 INTEGER(KIND=4) :: ii0, ij0 INTEGER(KIND=4) :: ii1, ij1 REAL(KIND=4) :: zdist REAL(KIND=4) :: zdistmin, zdistmin0 LOGICAL, SAVE :: ll_bndcell, ll_first=.TRUE. !!---------------------------------------------------------------------- IF ( ll_first ) THEN kpiloc = kpi/2 ; kpjloc = kpj/2 ! seek from the middle of domain ll_first=.FALSE. ENDIF zdistmin=1000000. ; zdistmin0=1000000. ii0 = kpiloc ; ij0 = kpjloc ll_bndcell=.TRUE. ; ld_bnd=.FALSE. ! loop until found or boundary reach DO WHILE ( ll_bndcell .AND. .NOT. ld_bnd ) ii0 = kpiloc - jp_blk ; ii1 = kpiloc + jp_blk ij0 = kpjloc - jp_blk ; ij1 = kpjloc + jp_blk ! search only the inner domain IF (ii0 <= 0 ) ii0 = 2 IF (ii1 > kpi) ii1 = kpi - 1 IF (ij0 <= 0 ) ij0 = 2 IF( ij1 > kpj) ij1 = kpj - 1 ! within a block jp_blk+1 x jp_blk+1: DO jj=ij0,ij1 DO ji=ii0,ii1 ! compute true distance (orthodromy) between target point and grid point zdist = dist(ddlon, ddlam(ji,jj), ddlat, ddphi(ji,jj) ) zdistmin = MIN(zdistmin, zdist) ! update kpiloc, kpjloc if distance decreases IF (zdistmin /= zdistmin0 ) THEN kpiloc=ji kpjloc=jj ENDIF zdistmin0=zdistmin END DO END DO ll_bndcell=.FALSE. ! if kpiloc, kpjloc belong to block boundary proceed to next block, centered on kpiloc, kpjloc IF (kpiloc == ii0 .OR. kpiloc == ii1) ll_bndcell=.TRUE. IF (kpjloc == ij0 .OR. kpjloc == ij1) ll_bndcell=.TRUE. ! boundary reach ---> not found IF (kpiloc == 2 .OR. kpiloc ==kpi-1) ld_bnd=.TRUE. IF (kpjloc == 2 .OR. kpjloc ==kpj-1) ld_bnd=.TRUE. END DO END SUBROUTINE NEARESTPOINT REAL(KIND=8) FUNCTION dist(ddlona, ddlonb, ddlata, ddlatb) !!--------------------------------------------------------------------- !! *** FUNCTION dist *** !! !! ** Purpose : Compute the distance (km) between !! point A (lona, lata) and B (lonb, latb) !! !! ** Method : Use of double precision is important. Compute the !! distance along the orthodromy !! !!---------------------------------------------------------------------- REAL(KIND=8), INTENT(in) :: ddlata, ddlona, ddlatb, ddlonb REAL(KIND=8), SAVE :: dl_latar, dl_latbr, dl_lonar, dl_lonbr REAL(KIND=8) :: dl_pds REAL(KIND=8), SAVE :: dl_ux, dl_uy, dl_uz REAL(KIND=8) :: dl_vx, dl_vy, dl_vz REAL(KIND=8), SAVE :: dl_prevlat=-1000.d0 REAL(KIND=8), SAVE :: dl_prevlon=-1000.d0 REAL(KIND=8), SAVE :: dl_r, dl_pi, dl_conv LOGICAL :: ll_first=.TRUE. !!---------------------------------------------------------------------- ! initialise some values at first call IF ( ll_first ) THEN ll_first = .FALSE. ! constants dl_pi = ACOS(-1.d0) dl_conv = dl_pi/180.d0 ! for degree to radian conversion ! Earth radius dl_r = (6378.137d0+6356.7523d0)/2.0d0 ! km ENDIF ! compute these term only if they differ from previous call IF ( ddlata /= dl_prevlat .OR. ddlona /= dl_prevlon) THEN dl_latar = ddlata*dl_conv dl_lonar = ddlona*dl_conv dl_ux = COS(dl_lonar)*COS(dl_latar) dl_uy = SIN(dl_lonar)*COS(dl_latar) dl_uz = SIN(dl_latar) dl_prevlat = ddlata dl_prevlon = ddlona ENDIF dl_latbr = ddlatb*dl_conv dl_lonbr = ddlonb*dl_conv dl_vx = COS(dl_lonbr)*COS(dl_latbr) dl_vy = SIN(dl_lonbr)*COS(dl_latbr) dl_vz = SIN(dl_latbr) dl_pds = dl_ux*dl_vx + dl_uy*dl_vy + dl_uz*dl_vz IF (dl_pds >= 1.) THEN dist = 0. ELSE dist = dl_r*ACOS(dl_pds) ENDIF END FUNCTION dist END MODULE cdftools cdftools-3.0/cdfstrconv.f900000644000175000017500000002706712241227304017027 0ustar amckinstryamckinstryPROGRAM cdfstrconv !!------------------------------------------------------------------- !! PROGRAM CDFFLXCONV !! ****************** !! !! ** Purpose: Convert a set of fluxes dimgfile (Clipper like) !! to a set of CDF files (Drakkar like ) !! !! ** Method: takes the current year as input, and config name !! automatically read !! ECMWF.Y${year}.M??.FLUX.${config}.dimg (daily, 1 file per month) !! ECMWF.Y${year}.M??.STRESS.${config}.dimg (daily, 1 file per month) !! REYNOLDS.Y${year}.SST.${config}.dimg ( weekly, 1 file per year ) ! Danger ! !! creates 6 netcdf daily files : !! ECMWF_emp_1d_${year}.${config}.nc !! ECMWF_qnet_1d_${year}.${config}.nc !! ECMWF_qsr_1d_${year}.${config}.nc !! ECMWF_sst_1d_${year}.${config}.nc !! ECMWF_taux_1d_${year}.${config}.nc !! ECMWF_tauy_1d_${year}.${config}.nc !! Requires coordinates.diags file (to be input consistent) !! !! history: !! Original: J.M. Molines (Feb. 2007 ) !!------------------------------------------------------------------- !! $Rev$ !! $Date$ !! $Id$ !!-------------------------------------------------------------- !! !! * Modules used USE cdfio !! * Local variables IMPLICIT NONE INTEGER :: ji,jj,jk, jvar, jmonth, jdim, jday, jt INTEGER :: narg, iargc, nvar INTEGER :: npiglo,npjglo, npk !: size of the domain INTEGER :: iyear, icurrday, jul, jul1, jul2 INTEGER :: id1, id2, ii1, ii2, ntime, ntp, ntn, itt INTEGER :: january1, december31 INTEGER, DIMENSION(:), ALLOCATABLE :: itime REAL(KIND=4) , DIMENSION (:,:,:), ALLOCATABLE :: v2d REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glam, gphi, z2d, v2daily REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamu, gphiu REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamv, gphiv REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: dep, timetab REAL(KIND=8) , DIMENSION (:), ALLOCATABLE :: timetag, timetagp,timetagn REAL(KIND=4) ,DIMENSION(1) :: timean CHARACTER(LEN=256) :: ctag, confcase ! Dimg stuff INTEGER :: irecl, ii, nt, ndim, irec INTEGER :: numflx=10, numcoo=11, numtau=12, numsst=14, numsstp=15, numsstn=16 CHARACTER(LEN=256) :: cflux, ctau, csstr,csstrp, csstrn CHARACTER(LEN=256) :: coord='coordinates.diags' CHARACTER(LEN=256) :: cheader, cdum, config CHARACTER(LEN=4) :: cver REAL(KIND=4) :: x1,y1, dx,dy, spval ! coordinates.diags INTEGER :: nrecl8 REAL(KIND=8) :: zrecl8, zpiglo,zpjglo REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: dzvar CHARACTER(LEN=256) :: cltextco LOGICAL :: lexist ! Netcdf Stuff CHARACTER(LEN=256) :: cemp, cqnet, cqsr, ctaux, ctauy, csst TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvaremp,typvarqnet,typvarqsr TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvartaux,typvartauy,typvarsst INTEGER, DIMENSION(:), ALLOCATABLE :: ipkemp, ipkqnet, ipkqsr, id_varoutemp,id_varoutqnet, id_varoutqsr INTEGER, DIMENSION(:), ALLOCATABLE :: ipktaux, ipktauy, ipksst, id_varouttaux,id_varouttauy, id_varoutsst INTEGER :: ncoutemp, ncoutqnet, ncoutqsr, ncouttaux, ncouttauy, ncoutsst INTEGER :: istatus !! Read command line narg= iargc() IF ( narg /= 2 ) THEN PRINT *,' Usage : cdfstrconv YEAR config ' PRINT *,' Output 6 cdf files : for emp, qnet, qsr, sst, taux, tauy with standard var name :' PRINT *,' sowaflup, sohefldo, soshfldo, sst, sozotaux, sometauy ' PRINT *,' coordinates.diags ( clipper like) is required in current dir ' STOP ENDIF !! CALL getarg (1, cdum) READ(cdum,*) iyear CALL getarg (2, config) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! ..... STRESSES STRESSES STRESSES ...... !!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT *,' Doing Stresses ...' !! read glam gphi in the coordinates file for U point (fluxes) nrecl8=200 OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8) READ(numcoo,rec=1) cltextco,zrecl8,zpiglo,zpjglo CLOSE(numcoo) nrecl8=zrecl8 ; npiglo=zpiglo ; npjglo=zpjglo ALLOCATE ( glamu(npiglo,npjglo), gphiu(npiglo,npjglo) ,dzvar(npiglo,npjglo) ) ALLOCATE ( glamv(npiglo,npjglo), gphiv(npiglo,npjglo) ) OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8) READ(numcoo,REC=3)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamu(:,:) = dzvar(:,:) READ(numcoo,REC=7)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiu(:,:) = dzvar(:,:) READ(numcoo,REC=4)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamv(:,:) = dzvar(:,:) READ(numcoo,REC=8)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiv(:,:) = dzvar(:,:) DEALLOCATE ( dzvar ) CLOSE(numcoo) !! build nc output files WRITE(ctaux,'(a,I4.4,a)') 'ECMWF_taux_1d_',iyear,'.'//TRIM(config)//'.nc' WRITE(ctauy,'(a,I4.4,a)') 'ECMWF_tauy_1d_',iyear,'.'//TRIM(config)//'.nc' jmonth=1 !! Build dimg file names WRITE(ctau ,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg' ! WRITE(csst ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg' ! open (and check ?? if they exists ) irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk ALLOCATE (v2d(npiglo, npjglo,2), dep(npk) ) ALLOCATE (z2d(npiglo, npjglo) ) READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, & x1,y1,dx,dy,spval, & (dep(jk),jk=1,npk), & timean(1) CLOSE(numtau) ! Build cdf files output nvar = 1 ! 1 var but many files ... (OK ... 3 actually ) ALLOCATE ( typvartaux(nvar), ipktaux(nvar), id_varouttaux(nvar) ) ALLOCATE ( typvartauy(nvar), ipktauy(nvar), id_varouttauy(nvar) ) jvar=1 ipktaux(jvar) = 1 typvartaux(jvar)%cname='sozotaux' ! taux dim 1 of dimgfile typvartaux(jvar)%cunits='N/m2' typvartaux(jvar)%rmissing_value=0. typvartaux(jvar)%valid_min= -0.1 typvartaux(jvar)%valid_max= 0.1 typvartaux(jvar)%clong_name='Zonal Wind Stress' typvartaux(jvar)%cshort_name='sozotaux' typvartaux(jvar)%conline_operation='N/A' typvartaux(jvar)%caxis='TYX' ipktauy(jvar) = 1 typvartauy(jvar)%cname='sometauy' ! tauy dim 2 of dimgfile typvartauy(jvar)%cunits='N/m2' typvartauy(jvar)%rmissing_value=0. typvartauy(jvar)%valid_min= -0.1 typvartauy(jvar)%valid_max= 0.1 typvartauy(jvar)%clong_name='Meridional Wind Stress' typvartauy(jvar)%cshort_name='sometauy' typvartauy(jvar)%conline_operation='N/A' typvartauy(jvar)%caxis='TYX' ncouttaux =create(ctaux, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncouttaux ,typvartaux,nvar, ipktaux,id_varouttaux ) istatus= putheadervar(ncouttaux, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ncouttauy =create(ctauy, 'none',npiglo,npjglo,npk,cdep='deptht' ) istatus= createvar(ncouttauy ,typvartauy,nvar, ipktauy,id_varouttauy ) istatus= putheadervar(ncouttauy, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep ) ! Ready for time loop on month icurrday=0 DO jmonth = 1, 12 WRITE(ctau,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg' irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl ) READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim ! loop for days in files DO jday=1,nt icurrday=icurrday +1 DO jdim=1,ndim irec=1+(jday-1)*ndim +jdim READ(numtau,REC=irec) (( v2d(ji,jj,jdim),ji=1,npiglo),jj=1,npjglo) END DO ! taux istatus = putvar(ncouttaux,id_varouttaux(1),v2d(:,:,1),icurrday,npiglo,npjglo) ! tauy istatus = putvar(ncouttauy,id_varouttauy(1),v2d(:,:,2),icurrday,npiglo,npjglo) END DO ! loop on days CLOSE(numtau) END DO ! loop on month ! update time_counter ALLOCATE( timetab (icurrday) ) timetab=(/(jt,jt=1,icurrday)/) istatus=putvar1d(ncouttaux,timetab,icurrday,'T') istatus=putvar1d(ncouttauy,timetab,icurrday,'T') ! close fluxes files istatus=closeout(ncouttaux) istatus=closeout(ncouttauy) DEALLOCATE (v2d , dep, z2d , timetab) CONTAINS INTEGER FUNCTION isdirect(clname) !!! FUNCTION ISDIRECT !!! ***************** !!! !!! PURPOSE : This integer function returns the record length if clname !!! is a valid dimg file, it returns 0 either. !!! !!! METHOD : Open the file and look for the key characters (@!01) for !!! identification. !!! !!! AUTHOR : Jean-Marc Molines (Apr. 1998) !!! ------------------------------------------------------------------------- IMPLICIT NONE CHARACTER(LEN=*), INTENT(in) :: clname CHARACTER(LEN=4) :: cver CHARACTER(LEN=256) :: clheader ! INTEGER :: irecl ! OPEN(100,FILE=clname, FORM ='UNFORMATTED', ACCESS ='DIRECT', RECL =88) READ(100,REC=1) cver ,clheader,irecl CLOSE(100) ! IF (cver == '@!01' ) THEN isdirect=irecl ELSE isdirect=0 END IF ! END FUNCTION isdirect FUNCTION julday(kdastp) !! ------------------------------------------------------------------ !! *** FUNCTION JULDAY *** !! !! Purpose: This routine returns the julian day number which begins at noon !! of the calendar date specified by month kmm, day kid, and year kiyyy. !! positive year signifies a.d.; negative, b.c. (remember that the !! year after 1 b.c. was 1 a.d.) !! routine handles changeover to gregorian calendar on oct. 15, 1582. !! !! Method: This routine comes directly from the Numerical Recipe Book, !! press et al., numerical recipes, cambridge univ. press, 1986. !! !! Arguments: !! kdastp : OPA date yyyymmdd (instead of kmm kid kiyyy) !! kmm : input, corresponding month !! kid : input, corresponding day !! kiyyy : input, corresponding year, positive IF a.d, negative b.c. !! !! !! history !! 1998: J.M. Molines for the Doctor form. !! 2007 : J.M. Molines in F90 !! ----------------------------------------------------------------- ! * Declarations ! INTEGER :: julday, kiyyy,kid,kmm INTEGER, INTENT(in) ::kdastp ! * Local INTEGER, PARAMETER ::jpgreg=15+31*(10+12*1582) INTEGER :: iy, im, ia ! ... Year 0 never existed ... kiyyy=kdastp/10000 kmm=(kdastp - kiyyy*10000)/100 kid= kdastp - kiyyy*10000 - kmm*100 IF (kiyyy == 0) STOP 101 ! IF (kiyyy < 0) kiyyy = kiyyy + 1 IF (kmm > 2) THEN iy = kiyyy im = kmm + 1 ELSE iy = kiyyy - 1 im = kmm + 13 END IF ! julday = INT(365.25*iy) + INT(30.6001*im) + kid + 1720995 IF (kid+31*(kmm+12*kiyyy).GE.jpgreg) THEN ia = INT(0.01*iy) julday = julday + 2 - ia + INT(0.25*ia) END IF END FUNCTION JULDAY END PROGRAM cdfstrconv cdftools-3.0/cdfvint.f900000644000175000017500000002435612241227304016307 0ustar amckinstryamckinstryPROGRAM cdfvint !!====================================================================== !! *** PROGRAM cdfvint *** !!===================================================================== !! ** Purpose : Compute vertically integrated temperature or salinity. !! !! ** Method : Compute the integral from top to bottom and save !! cumulated values. For temperature, cumulated values are !! transformed to heat content (J.K.m^-2). For salinity !! they are saved as PSU.m !! !! History : 2.1 : 10/2012 : M.A. Balmaseda : Original code from cdfmxlhc !! 3.0 : 11/2012 : J.M. Molines : Doctor norm + Lic + ... !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2012 !! $Id$ !! Copyright (c) 2012, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt ! dummy loop index INTEGER(KIND=4) :: ierr, ij, iko ! working integer INTEGER(KIND=4) :: narg, iargc, ijarg ! command line INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: npko ! size of the domain INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! only one output variable INTEGER(KIND=4) :: ncout REAL(KIND=4), PARAMETER :: pprho0 = 1020. ! water density (kg/m3) REAL(KIND=4), PARAMETER :: ppcp = 4000. ! calorific capacity (J/kg/m3) REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3t ! vertical metric REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zt ! working input variable REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! npiglo x npjglo REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepo ! output depth REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics in case of full step REAL(KIND=4) :: rdep1, rdep2 ! depth counters REAL(KIND=4) :: tol = 1.0 ! tolerance REAL(KIND=4) :: sclf = 1.0 ! scale factor REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_vint1, dl_vint2 ! verticall int quantity CHARACTER(LEN=256) :: cf_in, cf_out ! input/output file CHARACTER(LEN=256) :: cv_in, cv_out ! variable name in and out CHARACTER(LEN=256) :: cunits, clongname ! variable attributes CHARACTER(LEN=256) :: cldum ! dummy string for command line browsing LOGICAL :: lfull =.FALSE. ! flag for full step computation LOGICAL :: lgsop =.FALSE. ! selected depths gsop intercomparison LOGICAL :: lchk =.FALSE. ! flag for missing files LOGICAL :: lout ! check for output TYPE(variable), DIMENSION(1) :: stypvar ! extension for attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfvint T-file [IN-var] [-GSOP] [-full] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Compute the vertical integral of the variable from top ' PRINT *,' to bottom, and save the cumulated valued, level by level.' PRINT *,' For temperature (default var), the integral is transformed' PRINT *,' to Heat Content ( J.K. m^-2) hence for salinity, the integral' PRINT *,' represents PSU.m ' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' T-file : gridT file holding either Temperature or salinity ' PRINT *,' [IN-var ] : name of input variable to process. Default is ' PRINT *,' ', TRIM(cn_votemper),'. Can also be ',TRIM(cn_vosaline) PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' -GSOP : Use 7 GSOP standard level for the output ' PRINT *,' Default is to take the model levels for the output' PRINT *,' -full : for full step computation ' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' ', TRIM(cn_fmsk),', ',TRIM(cn_fhgr),' and ', TRIM(cn_fzgr) PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : VAR-name.nc' PRINT *,' variables : either voheatc or vohsalt' PRINT *,' ' PRINT *,' SEE ALSO :' PRINT *,' cdfvertmean, cdfheatc, cdfmxlhcsc and cdfmxlheatc' PRINT *,' ' STOP ENDIF ! default values cv_in = cn_votemper ! browse command line ijarg = 1 ; ij = 0 DO WHILE ( ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum) CASE ( '-GSOP' ) ; lgsop = .TRUE. CASE ( '-full' ) ; lfull = .TRUE. CASE DEFAULT ij = ij + 1 SELECT CASE ( ij) CASE ( 1 ) ; cf_in = cldum CASE ( 2 ) ; cv_in = cldum CASE DEFAULT ; PRINT *, ' ERROR: Too many arguments ! ' ; STOP END SELECT END SELECT END DO ! Security check lchk = chkfile ( cf_in ) lchk = chkfile ( cn_fmsk ) .OR. lchk lchk = chkfile ( cn_fhgr ) .OR. lchk lchk = chkfile ( cn_fzgr ) .OR. lchk IF ( lchk ) STOP ! missing files ! Set output information according to variable name IF ( cv_in == cn_votemper ) THEN cv_out = 'voheatc' clongname = 'Heat Content per unit area' cunits = 'J Km^-2' sclf = pprho0*ppcp/1.e6 ELSEIF ( cv_in == cn_vosaline ) THEN cv_out = 'vohsalt' clongname = 'Vertically Integrated Salinity' cunits = 'psu*m' sclf =1. ELSE PRINT *,' ERROR: Variable ', TRIM(cv_in), ' not pre-defined ...' PRINT *,' Accepted variables are ', TRIM(cn_votemper),' and ',TRIM(cn_vosaline) STOP ENDIF ! log information so far cf_out = TRIM(cv_out)//'.nc' PRINT *,' INPUT VARIABLE : ' , TRIM(cv_in) PRINT *,' OUTPUT VARIABLE : ' , TRIM(cv_out) PRINT *,' OUTPUT FILE : ' , TRIM(cf_out) npiglo = getdim (cf_in, cn_x ) npjglo = getdim (cf_in, cn_y ) npk = getdim (cf_in, cn_z ) npt = getdim (cf_in, cn_t ) IF ( lgsop ) THEN ; PRINT *,' using GSOP depths' ; npko = 7 ELSE ; PRINT *,' using model depths'; npko = npk ENDIF PRINT *, ' NPIGLO = ', npiglo PRINT *, ' NPJGLO = ', npjglo PRINT *, ' NPK = ', npk PRINT *, ' NPKO = ', npko PRINT *, ' NPT = ', npt ! Allocate arrays ALLOCATE ( tim(npt) ) ALLOCATE ( tmask(npiglo,npjglo) ) ALLOCATE ( zt(npiglo,npjglo) ) ALLOCATE ( e3t(npiglo,npjglo) ) ALLOCATE ( e31d(npk) ) ALLOCATE ( gdepw(npk), gdepo(npko) ) ALLOCATE ( dl_vint1(npiglo, npjglo), dl_vint2(npiglo,npjglo) ) ! prepare output variable ipk(:) = npko stypvar(1)%cname = TRIM(cv_out) stypvar(1)%cunits = TRIM(cunits) stypvar(1)%rmissing_value = 0. stypvar(1)%valid_min = -1.e15 stypvar(1)%valid_max = 1.e15 stypvar(1)%clong_name = TRIM(clongname) stypvar(1)%cshort_name = TRIM(cv_out) stypvar(1)%conline_operation = 'N/A' stypvar(1)%caxis = 'TZYX' ! Initialize output file gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk ) IF ( lgsop ) THEN gdepo(:) = (/100.,300.,700.,1500.,3000.,4000.,6000./) ELSE gdepo(1:npk-1) = gdepw(2:npk) gdepo(npk) = 6000. ENDIF PRINT*,'OUTPUT DEPTHS ARE : ',gdepo ncout = create (cf_out, 'none', npiglo, npjglo, npko, cdep=cn_vdepthw, ld_xycoo=.FALSE.) ierr = createvar (ncout, stypvar, 1, ipk, id_varout ) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npko, pdep=gdepo, ld_xycoo=.FALSE.) tim = getvar1d (cf_in, cn_vtimec, npt ) ierr = putvar1d (ncout, tim, npt, 'T') PRINT *, 'Output files initialised ...' DO jt = 1, npt dl_vint1(:,:) = 0.d0 iko = 1 rdep1 = 0.0 ; rdep2 = 0.0 lout = .TRUE. DO jk = 1, npk IF ( lgsop ) lout = .FALSE. rdep1 = rdep2 dl_vint2(:,:) = dl_vint1 (:,:) tmask(:,:)= getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo ) zt(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt ) IF ( lfull ) THEN ; e3t(:,:) = e31d(jk) ELSE ; e3t(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.) ENDIF rdep2 = rdep1 + e31d(jk) dl_vint1(:,:) = dl_vint1(:,:)+ zt(:,:)*e3t(:,:)*tmask(:,:)*1.d0 IF ( rdep2 >= (gdepo(iko) - tol ) ) THEN lout=.TRUE. !modify vertical thickness for output WHERE (e3t(:,:) > gdepo(iko) - rdep1 ) e3t(:,:) = gdepo(iko)-rdep1 dl_vint2(:,:) = dl_vint2(:,:)+ zt(:,:)*e3t(:,:)*tmask(:,:)*1.d0 ENDIF IF ( lout ) THEN dl_vint2(:,:) = dl_vint2(:,:) * sclf IF (jt == 1 ) THEN PRINT *,'Output for level ',iko PRINT *,'rdep1, rdep2, depo ',rdep1,rdep2,gdepo(iko) ENDIF ierr = putvar(ncout, id_varout(1) ,REAL(dl_vint2), iko, npiglo, npjglo, ktime=jt) iko = iko + 1 ENDIF END DO ! loop to next level END DO ! next time frame ierr = closeout(ncout) END PROGRAM cdfvint cdftools-3.0/cdfinfo.f900000644000175000017500000000712412241227304016254 0ustar amckinstryamckinstryPROGRAM cdfinfo !!====================================================================== !! *** PROGRAM cdfinfo *** !!===================================================================== !! ** Purpose : Give very basic informations for Netcdf File !! !! ** Method : to be improved !! !! History : 2.1 : 09/2010 : J.M. Molines : Original code !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jvar ! dummy loop index INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: narg, iargc ! INTEGER(KIND=4) :: npiglo, npjglo, npk ,npt ! size of the domain INTEGER(KIND=4) :: nvars ! Number of variables in a file CHARACTER(LEN=256) :: cf_in ! file name CHARACTER(LEN=256) :: cv_dep ! depth name CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! variable attributes !!---------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfinfo ''model cdf file'' ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Gives very basic information about the file given in arguments.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' model output file in netcdf.' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' On standard ouput, gives the size of the domain, the depth ' PRINT *,' dimension name, the number of variables.' PRINT *,' ' STOP ENDIF CALL getarg (1, cf_in) IF ( chkfile(cf_in) ) STOP ! missing file npiglo = getdim (cf_in,cn_x) npjglo = getdim (cf_in,cn_y) npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'nav_lev',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'levels',cdtrue=cv_dep,kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF ENDIF ENDIF npt = getdim (cf_in,cn_t) PRINT *, 'npiglo =', npiglo PRINT *, 'npjglo =', npjglo PRINT *, 'npk =', npk PRINT *, 'npt =', npt PRINT *,' Depth dimension name is ', TRIM(cv_dep) nvars = getnvar(cf_in) PRINT *,' nvars =', nvars ALLOCATE (cv_names(nvars) ) ALLOCATE (stypvar(nvars) ) ! get list of variable names cv_names(:)=getvarname(cf_in, nvars, stypvar) DO jvar = 1, nvars PRINT *, 'variable# ',jvar,' is : ',TRIM(cv_names(jvar)) END DO END PROGRAM cdfinfo cdftools-3.0/cdfclip.f900000644000175000017500000002744112241227304016254 0ustar amckinstryamckinstryPROGRAM cdfclip !!====================================================================== !! *** PROGRAM cdfclip *** !!===================================================================== !! ** Purpose : An alternative to ncks to clip model file. It is !! usefull when the clipping area cross the E-W !! periodic folding line. Additionally it does not !! mess up the order of the dimensions and variables, !! which was a problem for coordinates.nc files with !! IOIPSL !! !! History : 2.1 : 02/2007 : J.M. Molines : Original code !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic. !!---------------------------------------------------------------------- !! USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2010, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE INTEGER(KIND=4) :: jk, jt, jvar, jv ! dummy loop index INTEGER(KIND=4) :: ik1, ik2, ik ! INTEGER(KIND=4) :: ierr ! working integer INTEGER(KIND=4) :: iimin, iimax ! INTEGER(KIND=4) :: ijmin, ijmax ! INTEGER(KIND=4) :: ikmin=-9999, ikmax=-9999 ! INTEGER(KIND=4) :: narg, iargc, ijarg ! INTEGER(KIND=4) :: npiglo, npjglo, npk ! INTEGER(KIND=4) :: npkk, npt ! size of the domain INTEGER(KIND=4) :: nvars ! Number of variables in a file INTEGER(KIND=4) :: ncout ! INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, ipkk ! arrays of vertical level for each var INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout , ndim ! REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, rlon, rlat ! REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2dxz, v2dyz, zxz, zyz ! REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: rdepg, rdep ! REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! CHARACTER(LEN=256) :: cf_in ! input file name CHARACTER(LEN=256) :: cf_out='cdfclip.nc' ! output file name CHARACTER(LEN=256) :: cv_dep, cv_tim ! depth and time variable names CHARACTER(LEN=255) :: cglobal ! global attribute to write on output file CHARACTER(LEN=256) :: cldum ! dummy character variable CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! LOGICAL :: lzonal=.false. ! LOGICAL :: lmeridian=.false. ! !!------------------------------------------------------------------------- CALL ReadCdfNames() narg= iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfclip -f IN-file -zoom imin imax jmin jmax [kmin kmax] ' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Clip the input file according to the indices given in the' PRINT *,' zoom statement. If no vertical zoomed area is indicated, ' PRINT *,' the whole water column is considered. This program is able' PRINT *,' to extract data for a region crossing the E-W periodic boundary' PRINT *,' of a global configuration. It does so if imax < imin.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' -f IN-file : specify the input file to be clipped' PRINT *,' -zoom imin imax jmin jmax : specify the domain to be extracted.' PRINT *,' If imin=imax, or jmin = jmax assume a vertical section either ' PRINT *,' meridional or zonal.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [kmin kmax ] : specify vertical limits for the zoom, in order to reduce' PRINT *,' the extracted area to some levels. Default is to take the whole' PRINT *,' water column.' PRINT *,' ' PRINT *,' REQUIRED FILES :' PRINT *,' none' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' netcdf file : ', TRIM(cf_out) PRINT *,' variables : same as input variables.' STOP ENDIF !! ijarg=1 DO WHILE (ijarg <= narg ) CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 SELECT CASE ( cldum) CASE ('-f' ) CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; cf_in=cldum CASE ('-zoom') CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimin CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax IF ( narg == 9 ) THEN ! there are kmin kmax optional arguments CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmin CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmax ENDIF CASE DEFAULT PRINT *,' Unknown option :', TRIM(cldum) ; STOP END SELECT ENDDO IF ( chkfile (cf_in ) ) STOP ! missing file ! set global attribute for output file IF ( ikmin > 0 ) THEN WRITE(cglobal,'(a,a,a,6i5)') 'cdfclip -f ',TRIM(cf_in),' -zoom ',iimin,iimax,ijmin,ijmax, ikmin, ikmax ELSE WRITE(cglobal,'(a,a,a,4i5)') 'cdfclip -f ',TRIM(cf_in),' -zoom ',iimin,iimax,ijmin,ijmax ENDIF IF ( iimin == iimax ) THEN ; lmeridian=.true.; print *,' Meridional section ' ; ENDIF IF ( ijmin == ijmax ) THEN ; lzonal=.true. ; print *,' Zonal section ' ; ENDIF IF (iimax < iimin ) THEN ! we assume that this is the case when we cross the periodic line in orca (Indian ocean) npiglo= getdim (cf_in,cn_x) npiglo=iimax+(npiglo-iimin) -1 ELSE npiglo= iimax-iimin+1 ENDIF npjglo= ijmax-ijmin+1 ! look for possible name for vertical dim : npk = getdim (cf_in,cn_z,cdtrue=cv_dep, kstatus=ierr) ! depthxxx print *,'ist',ierr,TRIM(cn_z) IF (ierr /= 0 ) THEN npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr) ! zxxx print *,'ist',ierr,'z' IF (ierr /= 0 ) THEN npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr) ! sigmaxxx print *,'ist',ierr,'sigma' IF (ierr /= 0 ) THEN PRINT *,' assume file with no depth' IF ( ikmin > 0 ) THEN PRINT *,' You cannot specify limits on k level !' ; STOP ENDIF npk=0 ! means no dim level in file (implicitly 1 level) ENDIF ENDIF ENDIF ! replace flag value (-9999) by standard value (no ikmin ikmax specified = whole column) IF ( ikmin < 0 ) ikmin = 1 IF ( ikmax < 0 ) ikmax = npk npkk = ikmax - ikmin +1 ! number of extracted levels. If no level in file, it is 0: 0 -1 + 1 ! IF (npk == 0 ) ikmax = 1 ! look for possible name for time dimension npt = getdim(cf_in,cn_t, cdtrue=cv_tim, kstatus=ierr) IF ( ierr /= 0 ) THEN npt = getdim(cf_in,'time', cdtrue=cv_tim, kstatus=ierr) IF ( ierr /= 0 ) THEN npt = getdim(cf_in,'t', cdtrue=cv_tim, kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *, 'no time dimension found' npt=1 ENDIF ENDIF ENDIF PRINT *, 'npiglo = ', npiglo PRINT *, 'npjglo = ', npjglo PRINT *, 'npk = ', npk ,' npkk =', npkk PRINT *, 'npt = ', npt IF (npkk > npk ) THEN PRINT *,' It seems that you want levels that are not represented ' PRINT *,' in any of the variables that are in the file ',TRIM(cf_in) STOP ENDIF ALLOCATE( v2d(npiglo,npjglo),rlon(npiglo,npjglo), rlat(npiglo,npjglo), rdepg(npk) , rdep(npkk)) ALLOCATE( zxz(npiglo,1), zyz(1,npjglo) ) ALLOCATE( tim(npt) ) nvars = getnvar(cf_in) PRINT *,' nvars =', nvars ALLOCATE (cv_names(nvars), ndim(nvars) ) ALLOCATE (stypvar(nvars)) ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars), ipkk(nvars)) rlon =getvar(cf_in, cn_vlon2d, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin) ! nav_lon rlat =getvar(cf_in, cn_vlat2d, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin) ! nav_lat IF ( npk /= 0 ) THEN rdepg = getvar1d(cf_in, cv_dep, npk) rdep(:) = rdepg(ikmin:ikmax) ENDIF ! get list of variable names and collect attributes in stypvar (optional) cv_names(:)=getvarname(cf_in, nvars, stypvar) ! save variable dimension in ndim ! 1 = either time or depth : noclip ! 2 = nav_lon, nav_lat ! 3 = X,Y,T or X,Y,Z <-- need to fix the ambiguity ... ! 4 = X,Y,Z,T DO jvar=1,nvars ndim(jvar) = getvdim(cf_in, cv_names(jvar)) + 1 ! we add 1 because vdim is dim - 1 ... END DO id_var(:) = (/(jv, jv=1,nvars)/) ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk (cf_in,nvars,cdep=cv_dep) ipk(:) = MIN ( ipk , ikmax ) ! reduce max depth to the required maximum ipkk(:)= MAX( 0 , ipk(:) - ikmin + 1 ) ! for output variable. For 2D input var, ! ipkk is set to 0 if ikmin > 1 ... OK ? WHERE( ipkk == 0 ) cv_names='none' stypvar(:)%cname = cv_names ! create output fileset ! create output file taking the sizes in cf_in ncout = create (cf_out, cf_in, npiglo, npjglo, npkk, cdep=cv_dep ) ierr = createvar (ncout, stypvar, nvars, ipkk, id_varout, cdglobal=cglobal) ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npkk, pnavlon=rlon, pnavlat=rlat, pdep=rdep, cdep=cv_dep) DO jvar = 1,nvars ! skip dimension variables (already done when creating the output file) ik1=MAX(1,ikmin) ; ik2=ipk(jvar) SELECT CASE (cv_names(jvar) ) ! CASE ('none' ) ! skip CASE DEFAULT IF ( lzonal ) THEN ALLOCATE( v2dxz(npiglo,ipk(jvar)) ) DO jt=1,npt v2dxz=getvarxz(cf_in, cv_names(jvar), ijmin, npiglo, ipk(jvar), kimin=iimin, kkmin=1, ktime=jt) DO jk=ik1,ik2 ik = jk - ik1 + 1 zxz(:,1) = v2dxz(:,jk) ierr=putvar(ncout, id_varout(jvar), zxz, ik, npiglo, 1, ktime=jt) ENDDO ENDDO DEALLOCATE ( v2dxz ) ELSEIF (lmeridian) THEN ALLOCATE( v2dyz(npjglo,ipk(jvar)) ) DO jt=1,npt v2dyz=getvaryz(cf_in, cv_names(jvar), iimin, npjglo, ipk(jvar), kjmin=ijmin, kkmin=1, ktime=jt) DO jk=ik1, ik2 ik = jk - ik1 + 1 zyz(1,:) = v2dyz(:,jk) ierr=putvar(ncout, id_varout(jvar), zyz, ik, 1, npjglo, ktime=jt) ENDDO ENDDO DEALLOCATE ( v2dyz ) ELSE DO jt = 1, npt DO jk=ik1,ik2 ik = jk - ik1 + 1 v2d = getvar(cf_in, cv_names(jvar), jk, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jt) ierr = putvar(ncout, id_varout(jvar), v2d, ik, npiglo, npjglo, ktime=jt) ENDDO ENDDO ENDIF END SELECT END DO ! loop to next var in file tim = getvar1d(cf_in, cn_vtimec, npt ) ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout) END PROGRAM cdfclip cdftools-3.0/cdfsmooth.f900000644000175000017500000006054212241227304016635 0ustar amckinstryamckinstryPROGRAM cdfsmooth !!====================================================================== !! *** PROGRAM cdfsmooth *** !!===================================================================== !! ** Purpose : perform a spatial filtering on input file. !! - various filters are available : !! 1: Lanczos (default) !! 2: hanning !! 3: shapiro !! !! ** Method : read file level by level and perform a x direction !! filter, then y direction filter !! !! History : -- : 1995 : J.M. Molines : Original code for spem !! : 2.1 : 07/2007 : J.M. Molines : port in cdftools !! : 2.1 : 05/2010 : R. Dussin : Add shapiro filter !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. !! 3.0 : 07/2011 : R. Dussin : Add anisotropic box !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! routines : description !! filterinit : initialise weight !! filter : main routine for filter computation !! initlanc : initialise lanczos weights !! inithann : initialise hanning weights !! initshap : initialise shapiro routine !! initbox : initialize weight for box car average !! lislanczos2d : Lanczos filter !! lishan2d : hanning 2d filter !! lisshapiro1d : shapiro filter !! lisbox : box car filter !!---------------------------------------------------------------------- USE cdfio USE modcdfnames !!---------------------------------------------------------------------- !! CDFTOOLS_3.0 , MEOM 2011 !! $Id$ !! Copyright (c) 2011, J.-M. Molines !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt) !!---------------------------------------------------------------------- IMPLICIT NONE ! INTEGER(KIND=4), PARAMETER :: jp_lanc=1 ! lancszos id INTEGER(KIND=4), PARAMETER :: jp_hann=2 ! hanning id INTEGER(KIND=4), PARAMETER :: jp_shap=3 ! shapiro id INTEGER(KIND=4), PARAMETER :: jp_boxc=4 ! box car id INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain INTEGER(KIND=4) :: npk, npt ! size of the domain INTEGER(KIND=4) :: narg, iargc ! browse arguments INTEGER(KIND=4) :: ncut, nband ! cut period/ length, bandwidth INTEGER(KIND=4) :: nfilter = jp_lanc ! default value INTEGER(KIND=4) :: nvars, ierr ! number of vars INTEGER(KIND=4) :: ncout ! ncid of output file INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: iw ! flag for bad values (or land masked ) INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! id of output variables REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, w2d ! raw data, filtered result REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time array REAL(KIND=4) :: fn, rspval ! cutoff freq/wavelength, spval REAL(KIND=4) :: ranis ! anistropy REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dec2d ! working array REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dec, de ! weight in r8, starting index 0:nband TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! struture for attribute CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name CHARACTER(LEN=256) :: cf_in, cf_out ! file names CHARACTER(LEN=256) :: cv_dep, cv_tim ! variable name for depth and time CHARACTER(LEN=256) :: ctyp ! filter type CHARACTER(LEN=256) :: cldum ! dummy character variable !!---------------------------------------------------------------------- CALL ReadCdfNames() narg=iargc() IF ( narg == 0 ) THEN PRINT *,' usage : cdfsmooth IN-file ncut [filter_type]' PRINT *,' ' PRINT *,' PURPOSE :' PRINT *,' Perform a spatial smoothing on the file using a particular' PRINT *,' filter as specified in the option. Available filters' PRINT *,' are : Lanczos, Hanning, Shapiro, Box car average. Default' PRINT *,' is Lanczos filter.' PRINT *,' ' PRINT *,' ARGUMENTS :' PRINT *,' IN-file : input data file. All variables will be filtered' PRINT *,' ncut : number of grid step to be filtered, or number' PRINT *,' of iteration of the Shapiro filter.' PRINT *,' ' PRINT *,' OPTIONS :' PRINT *,' [filter_type] : Lanczos , L, l (default)' PRINT *,' Hanning , H, h' PRINT *,' Shapiro , S, s' PRINT *,' Box , B, b' PRINT *,' Anis. Box , B, b + anisotropy ratio' PRINT *,' ' PRINT *,' OUTPUT : ' PRINT *,' Output file name is build from input file name with indication' PRINT *,' of the filter type (1 letter) and of ncut.' PRINT *,' netcdf file : IN-file[LHSB]ncut' PRINT *,' variables : same as input variables.' STOP ENDIF ! CALL getarg(1,cf_in) CALL getarg(2,cldum) ; READ(cldum,*) ncut IF ( chkfile(cf_in) ) STOP ! missing file ! remark: for a spatial filter, fn=dx/lambda where dx is spatial step, lamda is cutting wavelength fn = 1./ncut nband = 2*ncut ! Bandwidth of filter is twice the filter span ALLOCATE ( dec(0:nband) , de(0:nband) ) WRITE(cf_out,'(a,a,i3.3)') TRIM(cf_in),'L',ncut ! default name IF ( narg >= 3 ) THEN CALL getarg(3, ctyp) SELECT CASE ( ctyp) CASE ( 'Lanczos','L','l') nfilter=jp_lanc WRITE(cf_out,'(a,a,i3.3)') TRIM(cf_in),'L',ncut PRINT *,' Working with Lanczos filter' CASE ( 'Hanning','H','h') nfilter=jp_hann ALLOCATE ( dec2d(0:2,0:2) ) WRITE(cf_out,'(a,a,i3.3)') TRIM(cf_in),'H',ncut PRINT *,' Working with Hanning filter' CASE ( 'Shapiro','S','s') nfilter=jp_shap WRITE(cf_out,'(a,a,i3.3)') TRIM(cf_in),'S',ncut PRINT *,' Working with Shapiro filter' CASE ( 'Box','B','b') nfilter=jp_boxc WRITE(cf_out,'(a,a,i3.3)') TRIM(cf_in),'B',ncut PRINT *,' Working with Box filter' CASE DEFAULT PRINT *, TRIM(ctyp),' : undefined filter ' ; STOP END SELECT ENDIF IF ( narg == 4 ) THEN CALL getarg(4,cldum) ; READ(cldum,*) ranis PRINT *, 'Anisotropic box car with ratio Lx = ', ranis, 'x Ly' ELSE ranis=1. ENDIF CALL filterinit (nfilter, fn, nband) ! Look for input file and create outputfile npiglo = getdim (cf_in,cn_x) npjglo = getdim (cf_in,cn_y) npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in,'z', cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN npk = getdim (cf_in, 'sigma', cdtrue=cv_dep, kstatus=ierr) IF ( ierr /= 0 ) THEN PRINT *,' assume file with no depth' npk=0 ENDIF ENDIF ENDIF npt = getdim (cf_in,cn_t, cdtrue=cv_tim) PRINT *, 'npiglo = ',npiglo PRINT *, 'npjglo = ',npjglo PRINT *, 'npk = ',npk PRINT *, 'npt = ',npt ALLOCATE ( v2d(npiglo,npjglo),iw(npiglo,npjglo), w2d(npiglo,npjglo), tim(npt) ) nvars = getnvar(cf_in) PRINT *, 'nvars = ', nvars ALLOCATE (cv_names(nvars) ) ALLOCATE (stypvar(nvars) ) ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) ) ! get list of variable names and collect attributes in stypvar (optional) cv_names(:) = getvarname(cf_in, nvars, stypvar) ! ipk gives the number of level or 0 if not a T[Z]YX variable ipk(:) = getipk (cf_in, nvars, cdep=cv_dep) WHERE( ipk == 0 ) cv_names='none' stypvar(:)%cname=cv_names ! create output file taking the sizes in cf_in PRINT *, 'Output file name : ', TRIM(cf_out) ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep) ierr = createvar (ncout , stypvar, nvars, ipk, id_varout ) ierr = putheadervar(ncout , cf_in, npiglo, npjglo, npk, cdep=cv_dep) tim = getvar1d(cf_in, cv_tim, npt) ! DO jvar = 1,nvars IF ( cv_names(jvar) == cn_vlon2d .OR. & cv_names(jvar) == cn_vlat2d .OR. cv_names(jvar) == 'none' ) THEN ! skip these variables ELSE rspval=stypvar(jvar)%rmissing_value DO jt=1,npt DO jk=1,ipk(jvar) PRINT *, jt,'/',npt,' and ',jk,'/',ipk(jvar) v2d(:,:) = getvar(cf_in,cv_names(jvar),jk,npiglo,npjglo,ktime=jt) iw(:,:) = 1 WHERE ( v2d == rspval ) iw =0 IF ( ncut /= 0 ) CALL filter( nfilter, v2d, iw, w2d) IF ( ncut == 0 ) w2d = v2d w2d = w2d *iw ! mask filtered data ierr = putvar(ncout, id_varout(jvar), w2d, jk, npiglo, npjglo, ktime=jt) ! END DO END DO ENDIF END DO ierr = putvar1d(ncout, tim, npt, 'T') ierr = closeout(ncout ) CONTAINS SUBROUTINE filterinit(kfilter, pfn, kband) !!--------------------------------------------------------------------- !! *** ROUTINE filterinit *** !! !! ** Purpose : initialise weight according to filter type !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kfilter ! filter number REAL(KIND=4), INTENT(in) :: pfn ! filter cutoff frequency/wavelength INTEGER(KIND=4), INTENT(in) :: kband ! filter bandwidth !!---------------------------------------------------------------------- SELECT CASE ( kfilter) CASE ( jp_lanc ) CALL initlanc (pfn, kband) CASE ( jp_hann ) CALL inithann (pfn, kband) CASE ( jp_shap ) CALL initshap (pfn, kband) CASE ( jp_boxc ) CALL initbox (pfn, kband) END SELECT END SUBROUTINE filterinit SUBROUTINE filter (kfilter, px, kpx, py) !!--------------------------------------------------------------------- !! *** ROUTINE filter *** !! !! ** Purpose : Call the proper filter routine according to filter type !! !!---------------------------------------------------------------------- INTEGER(KIND=4), INTENT(in) :: kfilter ! filter number REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: px ! input data INTEGER(KIND=4), DIMENSION(:,:), INTENT(in) :: kpx ! validity flag REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py ! output data !!---------------------------------------------------------------------- SELECT CASE ( kfilter) CASE ( jp_lanc ) CALL lislanczos2d (px, kpx, py, npiglo, npjglo, fn, nband) CASE ( jp_hann ) CALL lishan2d (px, kpx, py, ncut, npiglo, npjglo) CASE ( jp_shap ) CALL lisshapiro1d (px, kpx, py, ncut, npiglo, npjglo) CASE ( jp_boxc ) CALL lisbox (px, kpx, py, npiglo, npjglo, fn, nband, ranis) END SELECT END SUBROUTINE filter SUBROUTINE initlanc(pfn, knj) !!--------------------------------------------------------------------- !! *** ROUTINE initlanc *** !! !! ** Purpose : initialize lanczos weights !! !!---------------------------------------------------------------------- REAL(KIND=4), INTENT(in) :: pfn ! cutoff freq/wavelength INTEGER(KIND=4), INTENT(in) :: knj ! bandwidth INTEGER(KIND=4) :: ji ! dummy loop index REAL(KIND=8) :: dl_pi, dl_ey, dl_coef !!---------------------------------------------------------------------- dl_pi = ACOS(-1.d0) dl_coef = 2*dl_pi*pfn de(0) = 2.d0*pfn DO ji=1,knj de(ji) = SIN(dl_coef*ji)/(dl_pi*ji) END DO ! dec(0) = 2.d0*pfn DO ji=1,knj dl_ey = dl_pi*ji/knj dec(ji) = de(ji)*SIN(dl_ey)/dl_ey END DO END SUBROUTINE initlanc SUBROUTINE inithann(pfn, knj) !!--------------------------------------------------------------------- !! *** ROUTINE inithann *** !! !! ** Purpose : Initialize hanning weight !! !!---------------------------------------------------------------------- REAL(KIND=4), INTENT(in) :: pfn ! cutoff freq/wavelength INTEGER(KIND=4), INTENT(in) :: knj ! bandwidth REAL(KIND=8) :: dl_sum !!---------------------------------------------------------------------- dec2d(:,:) = 0.d0 ! central point dec2d(1,1) = 4.d0 ! along one direction dec2d(1,0) = 1.d0 ; dec2d(1,2) = 1.d0 ! and the other dec2d(0,1) = 1.d0 ; dec2d(2,1) = 1.d0 ! normalize dl_sum = SUM(dec2d) dec2d(:,:) = dec2d(:,:) / dl_sum END SUBROUTINE inithann SUBROUTINE initshap(pfn, knj) !!--------------------------------------------------------------------- !! *** ROUTINE initshap *** !! !! ** Purpose : Dummy routine to respect program structure !! !!---------------------------------------------------------------------- REAL(KIND=4), INTENT(in) :: pfn ! cutoff freq/wavelength INTEGER(KIND=4), INTENT(in) :: knj ! bandwidth !!---------------------------------------------------------------------- ! nothing to do END SUBROUTINE initshap SUBROUTINE initbox(pfn, knj) !!--------------------------------------------------------------------- !! *** ROUTINE initbox *** !! !! ** Purpose : Init weights for box car !! !!---------------------------------------------------------------------- REAL(KIND=4), INTENT(in) :: pfn ! cutoff freq/wavelength INTEGER(KIND=4), INTENT(in) :: knj ! bandwidth !!---------------------------------------------------------------------- dec(:) = 1.d0 END SUBROUTINE initbox SUBROUTINE lislanczos2d(px, kiw, py, kpi, kpj, pfn, knj) !!--------------------------------------------------------------------- !! *** ROUTINE lislanczos2d *** !! !! ** Purpose : Perform lanczos filter !! !! ** Method : px = input data !! kiw = validity of input data !! py = output filter !! kpi,kpj = number of input/output data !! pfn = cutoff frequency !! knj = bandwith of the filter !! !! References : E. Blayo (1992) from CLS source and huge optimization !!---------------------------------------------------------------------- REAL(KIND=4), DIMENSION(:,:), INTENT(in ) :: px ! input array INTEGER(KIND=4), DIMENSION(:,:), INTENT(in ) :: kiw ! flag input array REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py ! output array INTEGER(KIND=4), INTENT(in ) :: kpi, kpj ! size of input/output REAL(KIND=4), INTENT(in ) :: pfn ! cutoff frequency/wavelength INTEGER(KIND=4), INTENT(in ) :: knj ! filter bandwidth INTEGER(KIND=4) :: ji, jj, jmx, jkx ! dummy loop index INTEGER(KIND=4) :: ik1x, ik2x, ikkx INTEGER(KIND=4) :: ifrst=0 INTEGER(KIND=4) :: inxmin, inxmaxi INTEGER(KIND=4) :: inymin, inymaxi REAL(KIND=8), DIMENSION(kpi,kpj) :: dl_tmpx, dl_tmpy REAL(KIND=8) :: dl_yy, dl_den !!---------------------------------------------------------------------- inxmin = knj inxmaxi = kpi-knj+1 inymin = knj inymaxi = kpj-knj+1 PRINT *,' filtering parameters' PRINT *,' nx = ', kpi PRINT *,' nband = ', knj PRINT *,' fn = ', pfn DO jj=1,kpj DO jmx=1,kpi ik1x = -knj ik2x = knj ! IF (jmx <= inxmin ) ik1x = 1-jmx IF (jmx >= inxmaxi) ik2x = kpi-jmx ! dl_yy = 0.d0 dl_den = 0.d0 ! DO jkx=ik1x,ik2x ikkx=ABS(jkx) IF (kiw(jkx+jmx,jj) == 1) THEN dl_den = dl_den + dec(ikkx) dl_yy = dl_yy + dec(ikkx)*px(jkx+jmx,jj) END IF END DO ! dl_tmpx(jmx,jj)=dl_yy/dl_den END DO END DO DO ji=1,kpi DO jmx=1,kpj ik1x = -knj ik2x = knj ! IF (jmx <= inymin ) ik1x = 1-jmx IF (jmx >= inymaxi) ik2x = kpj-jmx ! dl_yy = 0.d0 dl_den = 0.d0 ! DO jkx=ik1x,ik2x ikkx=ABS(jkx) IF (kiw(ji,jkx+jmx) == 1) THEN dl_den = dl_den + dec(ikkx) dl_yy = dl_yy + dec(ikkx)*dl_tmpx(ji,jkx+jmx) END IF END DO py(ji,jmx)=0. IF (dl_den /= 0.) py(ji,jmx) = dl_yy/dl_den END DO END DO ! END SUBROUTINE lislanczos2d SUBROUTINE lishan2d(px, kiw, py, korder, kpi, kpj) !!--------------------------------------------------------------------- !! *** ROUTINE lishan2d *** !! !! ** Purpose : compute hanning filter at order korder !! !!---------------------------------------------------------------------- REAL(KIND=4), DIMENSION(:,:), INTENT(in ) :: px ! input data INTEGER(KIND=4), DIMENSION(:,:), INTENT(in ) :: kiw ! validity flags REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py ! output data INTEGER(KIND=4), INTENT(in ) :: korder ! order of the filter INTEGER(KIND=4), INTENT(in ) :: kpi, kpj ! size of the data INTEGER(KIND=4) :: jj, ji, jorder ! loop indexes INTEGER(KIND=4) :: iiplus1, iiminus1 INTEGER(KIND=4) :: ijplus1, ijminus1 REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztmp !!---------------------------------------------------------------------- ALLOCATE( ztmp(kpi,kpj) ) py(:,:) = 0. ztmp(:,:) = px(:,:) DO jorder = 1, korder DO jj = 2, kpj-1 DO ji = 2, kpi-1 !treatment of the domain frontiers iiplus1 = MIN(ji+1,kpi) ; iiminus1 = MAX(ji-1,1) ijplus1 = MIN(jj+1,kpj) ; ijminus1 = MAX(jj-1,1) ! we don't compute in land IF ( kiw(ji,jj) == 1 ) THEN py(ji,jj) = SUM( dec2d(:,:) * ztmp(iiminus1:iiplus1,ijminus1:ijplus1) ) ENDIF ENDDO ENDDO ! update the ztmp array ztmp(:,:) = py(:,:) ENDDO END SUBROUTINE lishan2d SUBROUTINE lisshapiro1d(px, kiw, py, korder, kpi, kpj) !!--------------------------------------------------------------------- !! *** ROUTINE lisshapiro1d *** !! !! ** Purpose : compute shapiro filter !! !! References : adapted from Mercator code !!---------------------------------------------------------------------- REAL(KIND=4), DIMENSION(:,:), INTENT(in ) :: px ! input data INTEGER(KIND=4), DIMENSION(:,:), INTENT(in ) :: kiw ! validity flags REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py ! output data INTEGER(KIND=4), INTENT(in ) :: korder ! order of the filter INTEGER(KIND=4), INTENT(in ) :: kpi, kpj ! size of the data INTEGER(KIND=4) :: jj, ji, jorder ! loop indexes INTEGER(KIND=4) :: imin, imax, ihalo=0 REAL(KIND=4), PARAMETER :: rp_aniso_diff_XY = 2.25 ! anisotrope case REAL(KIND=4) :: zalphax, zalphay, znum REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztmp , zpx , zpy, zkiw LOGICAL :: ll_cycl = .TRUE. !!---------------------------------------------------------------------- IF(ll_cycl) ihalo=1 ! we allocate with an ihalo ALLOCATE( ztmp(0:kpi+ihalo,kpj) , zkiw(0:kpi+ihalo,kpj) ) ALLOCATE( zpx (0:kpi+ihalo,kpj) , zpy (0:kpi+ihalo,kpj) ) IF(ll_cycl) THEN zpx(1:kpi,:) = px(: ,:) ; zkiw(1:kpi,:) = kiw(: ,:) zpx(0 ,:) = px(kpi,:) ; zkiw(0 ,:) = kiw(kpi,:) zpx(kpi+1,:) = px(1 ,:) ; zkiw(kpi+1,:) = kiw(1 ,:) ELSE zpx(: ,:) = px(: ,:) ENDIF zpy (:,:) = zpx(:,:) ! init? ztmp(:,:) = zpx(:,:) ! init zalphax=1./2. zalphay=1./2. ! Dx/Dy=rp_aniso_diff_XY , D_ = vitesse de diffusion ! 140 passes du fitre, Lx/Ly=1.5, le rp_aniso_diff_XY correspondant est: IF ( rp_aniso_diff_XY >= 1. ) zalphay=zalphay/rp_aniso_diff_XY IF ( rp_aniso_diff_XY < 1. ) zalphax=zalphax*rp_aniso_diff_XY DO jorder=1,korder imin = 2 - ihalo imax = kpi-1 + ihalo DO ji = imin,imax DO jj = 2,kpj-1 ! We crop on the coast znum = ztmp(ji,jj) & & + 0.25*zalphax*(ztmp(ji-1,jj )-ztmp(ji,jj))*zkiw(ji-1,jj ) & & + 0.25*zalphax*(ztmp(ji+1,jj )-ztmp(ji,jj))*zkiw(ji+1,jj ) & & + 0.25*zalphay*(ztmp(ji ,jj-1)-ztmp(ji,jj))*zkiw(ji ,jj-1) & & + 0.25*zalphay*(ztmp(ji ,jj+1)-ztmp(ji,jj))*zkiw(ji ,jj+1) zpy(ji,jj) = znum*zkiw(ji,jj)+zpx(ji,jj)*(1.-zkiw(ji,jj)) ENDDO ! end loop ji ENDDO ! end loop jj IF ( ll_cycl ) THEN zpy(0 ,:) = zpy(kpi,:) zpy(kpi+1,:) = zpy(1 ,:) ENDIF ! update the tmp array ztmp(:,:) = zpy(:,:) ENDDO ! return this array IF( ll_cycl ) THEN py(:,:) = zpy(1:kpi,:) ELSE py(:,:) = zpy(: ,:) ENDIF END SUBROUTINE lisshapiro1d SUBROUTINE lisbox(px, kiw, py, kpi, kpj, pfn, knj,anis) !!--------------------------------------------------------------------- !! *** ROUTINE lisbox *** !! !! ** Purpose : Perform box car filtering !! !!---------------------------------------------------------------------- REAL(KIND=4), DIMENSION(:,:), INTENT(in ) :: px ! input array INTEGER(KIND=4), DIMENSION(:,:), INTENT(in ) :: kiw ! flag input array REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py ! output array INTEGER(KIND=4), INTENT(in ) :: kpi, kpj ! size of input/output REAL(KIND=4), INTENT(in ) :: pfn ! cutoff frequency/wavelength INTEGER(KIND=4), INTENT(in ) :: knj ! filter bandwidth REAL(KIND=4), INTENT(in ) :: anis ! anisotrop INTEGER(KIND=4) :: ji, jj INTEGER(KIND=4) :: ik1x, ik2x, ik1y, ik2y REAL(KIND=8) :: dl_den LOGICAL, DIMENSION(kpi,kpj) :: ll_mask !!---------------------------------------------------------------------- ll_mask=.TRUE. WHERE (kiw == 0 ) ll_mask=.FALSE. DO ji=1,kpi ik1x = ji-NINT( anis * knj) ; ik2x = ji+NINT( anis * knj) ik1x = MAX(1,ik1x) ; ik2x = MIN(kpi,ik2x) DO jj=1,kpj ik1y = jj-knj ; ik2y = jj+knj ik1y = MAX(1,ik1y) ; ik2y = MIN(kpj,ik2y) dl_den = SUM(kiw(ik1x:ik2x,ik1y:ik2y) ) IF ( dl_den /= 0 ) THEN py(ji,jj) = SUM(px(ik1x:ik2x,ik1y:ik2y), mask=ll_mask(ik1x:ik2x,ik1y:ik2y) )/dl_den ELSE py(ji,jj) = rspval ENDIF END DO END DO END SUBROUTINE lisbox END PROGRAM cdfsmooth