Changeset 6140 for trunk/NEMOGCM/NEMO/TOP_SRC
- Timestamp:
- 2015-12-21T12:35:23+01:00 (9 years ago)
- Location:
- trunk/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 39 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r5836 r6140 49 49 REAL(wp) :: xconv3 = 1.e+3_wp ! conversion from mol/l/atm to mol/m3/atm 50 50 51 !! * Substitutions52 # include "domzgr_substitute.h90"53 51 !!---------------------------------------------------------------------- 54 52 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 257 255 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2. 258 256 ! Add the surface flux to the trend 259 tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / fse3t(ji,jj,1)257 tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / e3t_n(ji,jj,1) 260 258 261 259 ! cumulation of surface flux at each time step -
trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r5836 r6140 50 50 REAL(wp) :: xconv4 = 1.0e-12 ! conversion from mol/m3/atm to mol/m3/pptv 51 51 52 !! * Substitutions53 # include "domzgr_substitute.h90"54 52 !!---------------------------------------------------------------------- 55 53 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 75 73 !! CFC concentration in pico-mol/m3 76 74 !!---------------------------------------------------------------------- 77 !78 75 INTEGER, INTENT(in) :: kt ! ocean time-step index 79 76 ! … … 167 164 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 168 165 ! Add the surface flux to the trend 169 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1)166 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1) 170 167 171 168 ! cumulation of surface flux at each time step -
trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r5385 r6140 18 18 USE trd_oce 19 19 USE trdtrc 20 USE trcbc, only : trc_bc_read 20 21 21 22 IMPLICIT NONE … … 56 57 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 57 58 58 IF( l_trdtrc ) THEN ! Save the trends in the ixed layer 59 CALL trc_bc_read ( kt ) ! tracers: surface and lateral Boundary Conditions 60 61 ! add here the call to BGC model 62 63 ! Save the trends in the mixed layer 64 IF( l_trdtrc ) THEN 59 65 DO jn = jp_myt0, jp_myt1 60 66 ztrmyt(:,:,:) = tra(:,:,:,jn) -
trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
r5836 r6140 36 36 DO jn = jp_myt0, jp_myt1 37 37 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 38 CALL iom_put( cltra, trn(:,:,:,jn) )38 IF( ln_trc_wri(jn) ) CALL iom_put( cltra, trn(:,:,:,jn) ) 39 39 END DO 40 40 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r5836 r6140 60 60 61 61 !! * Substitutions 62 # include "domzgr_substitute.h90"63 62 # include "vectopt_loop_substitute.h90" 64 63 !!---------------------------------------------------------------------- … … 67 66 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 68 67 !!---------------------------------------------------------------------- 69 70 68 CONTAINS 71 69 … … 187 185 ! closure : flux grazing is redistributed below level jpkbio 188 186 zzoobod = tmminz * zzoo * zzoo 189 xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk)187 xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t_n(ji,jj,jk) 190 188 zboddet = fdbod * zzoobod 191 189 … … 242 240 IF( ln_diatrc .OR. lk_iomput ) THEN 243 241 ! convert fluxes in per day 244 ze3t = fse3t(ji,jj,jk) * 86400.242 ze3t = e3t_n(ji,jj,jk) * 86400._wp 245 243 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 246 244 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t … … 363 361 IF( ln_diatrc .OR. lk_iomput ) THEN 364 362 ! convert fluxes in per day 365 ze3t = fse3t(ji,jj,jk) * 86400.363 ze3t = e3t_n(ji,jj,jk) * 86400._wp 366 364 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 367 365 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t … … 382 380 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 383 381 ! 384 zw3d(ji,jj,jk,1) = zno3phy * 86400 385 zw3d(ji,jj,jk,2) = znh4phy * 86400 386 zw3d(ji,jj,jk,3) = znh4no3 * 86400 382 zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 383 zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 384 zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 387 385 ! 388 386 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
r5836 r6140 42 42 43 43 !! * Substitutions 44 # include "domzgr_substitute.h90"45 44 # include "vectopt_loop_substitute.h90" 46 45 !!---------------------------------------------------------------------- … … 49 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 49 !!---------------------------------------------------------------------- 51 52 50 CONTAINS 53 51 … … 95 93 DO jj = 2, jpjm1 96 94 DO ji = fs_2, fs_jpim1 97 ze3t = 1. / fse3t(ji,jj,jk)95 ze3t = 1. / e3t_n(ji,jj,jk) 98 96 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 99 97 END DO … … 110 108 DO ji = fs_2, fs_jpim1 111 109 ikt = mbkt(ji,jj) 112 tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikt)110 tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt) 113 111 ! Deposition of organic matter in the sediment 114 112 zwork = vsed * trn(ji,jj,ikt,jpdet) … … 121 119 DO jj = 2, jpjm1 122 120 DO ji = fs_2, fs_jpim1 123 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)121 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / e3t_n(ji,jj,1) 124 122 END DO 125 123 END DO … … 212 210 DO jj = 1, jpj 213 211 DO ji = 1, jpi 214 zfluo = ( fsdepw(ji,jj,jk ) / fsdepw(ji,jj,jpkb) )**xhr215 zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr212 zfluo = ( gdepw_n(ji,jj,jk ) / gdepw_n(ji,jj,jpkb) )**xhr 213 zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr 216 214 IF( zfluo.GT.1. ) zfluo = 1._wp 217 215 zdm0(ji,jj,jk) = zfluo - zfluu -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
r5836 r6140 40 40 REAL(wp), PUBLIC :: reddom ! redfield ratio (C:N) for DOM 41 41 42 !! * Substitutions43 # include "domzgr_substitute.h90"44 42 !!---------------------------------------------------------------------- 45 43 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 47 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 46 !!---------------------------------------------------------------------- 49 50 47 CONTAINS 51 48 … … 105 102 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 106 103 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 107 zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )108 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) )104 zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) ) 105 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) ) 109 106 END DO 110 107 END DO … … 116 113 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 117 114 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 118 zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )119 zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) )115 zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) ) 116 zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) ) 120 117 etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 121 118 END DO … … 138 135 DO jj = 1, jpj 139 136 DO ji = 1, jpi 140 heup(ji,jj) = fsdepw(ji,jj,neln(ji,jj))137 heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj)) 141 138 END DO 142 139 END DO -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
r5836 r6140 34 34 REAL(wp), PUBLIC :: xhr ! coeff for martin''s remineralisation profile 35 35 36 !! * Substitutions37 # include "domzgr_substitute.h90"38 36 !!---------------------------------------------------------------------- 39 37 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 102 100 DO jj = 1, jpj 103 101 DO ji = 1, jpi 104 ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)102 ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 105 103 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk) 106 104 END DO … … 111 109 IF( iom_use( "TDETSED" ) ) THEN 112 110 CALL wrk_alloc( jpi, jpj, zw2d ) 113 zw2d(:,:) = ztra(:,:,1) * fse3t(:,:,1) * 86400.111 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 114 112 DO jk = 2, jpkm1 115 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.113 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 116 114 END DO 117 115 CALL iom_put( "TDETSED", zw2d ) … … 121 119 IF( ln_diatrc ) THEN 122 120 CALL wrk_alloc( jpi, jpj, zw2d ) 123 zw2d(:,:) = ztra(:,:,1) * fse3t(:,:,1) * 86400.121 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 124 122 DO jk = 2, jpkm1 125 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.123 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 126 124 END DO 127 125 trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r5836 r6140 34 34 PUBLIC p4z_bio 35 35 36 !! * Substitutions37 # include "domzgr_substitute.h90"38 36 !!---------------------------------------------------------------------- 39 37 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 41 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 40 !!---------------------------------------------------------------------- 43 44 41 CONTAINS 45 42 … … 70 67 DO jj = 1, jpj 71 68 DO ji = 1, jpi 72 IF( fsdepw(ji,jj,jk+1) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 69 !!gm : use nmln and test on jk ... less memory acces 70 IF( gdepw_n(ji,jj,jk+1) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 73 71 END DO 74 72 END DO 75 73 END DO 76 74 77 78 75 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column 79 76 CALL p4z_sink ( kt, knt ) ! vertical flux of particulate organic matter -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r5836 r6140 164 164 REAL(wp) :: devk55 = 0.3692E-3 165 165 166 !! * Substitutions167 # include "domzgr_substitute.h90"168 166 !!---------------------------------------------------------------------- 169 167 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 244 242 245 243 246 247 244 ! CHEMICAL CONSTANTS - DEEP OCEAN 248 245 ! ------------------------------- … … 252 249 253 250 ! SET PRESSION 254 zpres = 1.025e-1 * fsdept(ji,jj,jk)251 zpres = 1.025e-1 * gdept_n(ji,jj,jk) 255 252 256 253 ! SET ABSOLUTE TEMPERATURE -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r5836 r6140 30 30 PUBLIC p4z_fechem_init ! called in trcsms_pisces.F90 31 31 32 !! * Shared module variables33 LOGICAL :: ln_fechem !: boolean for complex iron chemistryfollowing Tagliabue and voelker34 LOGICAL :: ln_ligvar !: boolean for variable ligand concentration following Tagliabue and voelker35 REAL(wp), PUBLIC :: xlam1 !: scavenging rate of Iron36 REAL(wp), PUBLIC :: xlamdust !: scavenging rate of Iron by dust37 REAL(wp), PUBLIC :: ligand !: ligand concentration in the ocean 38 32 LOGICAL :: ln_fechem !: boolean for complex iron chemistry following Tagliabue and voelker 33 LOGICAL :: ln_ligvar !: boolean for variable ligand concentration following Tagliabue and voelker 34 REAL(wp), PUBLIC :: xlam1 !: scavenging rate of Iron 35 REAL(wp), PUBLIC :: xlamdust !: scavenging rate of Iron by dust 36 REAL(wp), PUBLIC :: ligand !: ligand concentration in the ocean 37 38 !!gm Not DOCTOR norm !!! 39 39 REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 40 40 41 !! * Substitutions42 # include "domzgr_substitute.h90"43 41 !!---------------------------------------------------------------------- 44 42 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 61 59 !! and one particulate form (ln_fechem) 62 60 !!--------------------------------------------------------------------- 63 ! 64 INTEGER, INTENT(in) :: kt, knt ! ocean time step 61 INTEGER, INTENT(in) :: kt, knt ! ocean time step 65 62 ! 66 63 INTEGER :: ji, jj, jk, jic 64 CHARACTER (len=25) :: charout 67 65 REAL(wp) :: zdep, zlam1a, zlam1b, zlamfac 68 66 REAL(wp) :: zkeq, zfeequi, zfesatur, zfecoll … … 79 77 REAL(wp) :: ztfe, zoxy 80 78 REAL(wp) :: zstep 81 CHARACTER (len=25) :: charout82 79 !!--------------------------------------------------------------------- 83 80 ! 84 81 IF( nn_timing == 1 ) CALL timing_start('p4z_fechem') 85 82 ! 86 ! Allocate temporary workspace 87 CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig ) 83 CALL wrk_alloc( jpi,jpj,jpk, zFe3, zFeL1, zTL1, ztotlig ) 88 84 zFe3 (:,:,:) = 0. 89 85 zFeL1(:,:,:) = 0. 90 86 zTL1 (:,:,:) = 0. 91 87 IF( ln_fechem ) THEN 92 CALL wrk_alloc( jpi, jpj, jpk,zFe2, zFeL2, zTL2, zFeP )88 CALL wrk_alloc( jpi,jpj,jpk, zFe2, zFeL2, zTL2, zFeP ) 93 89 zFe2 (:,:,:) = 0. 94 90 zFeL2(:,:,:) = 0. … … 253 249 zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 254 250 zlamfac = MIN( 1. , zlamfac ) 255 zdep = MIN( 1., 1000. / fsdept(ji,jj,jk) ) 251 !!gm very small BUG : it is unlikely but possible that gdept_n = 0 ..... 252 zdep = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 256 253 zlam1b = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 257 254 zcoag = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r5836 r6140 59 59 REAL(wp) :: xconv = 0.01_wp / 3600._wp !: coefficients for conversion 60 60 61 !! * Substitutions62 # include "domzgr_substitute.h90"63 61 !!---------------------------------------------------------------------- 64 62 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 182 180 oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 183 181 ! compute the trend 184 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1)182 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) 185 183 186 184 ! Compute O2 flux … … 188 186 zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 189 187 zoflx(ji,jj) = zfld16 - zflu16 190 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / fse3t(ji,jj,1)188 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1) 191 189 END DO 192 190 END DO -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r5836 r6140 51 51 REAL(wp), DIMENSION(3,61), PUBLIC :: xkrgb !: tabulated attenuation coefficients for RGB absorption 52 52 53 !! * Substitutions54 # include "domzgr_substitute.h90"55 53 !!---------------------------------------------------------------------- 56 54 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 101 99 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 102 100 ! 103 ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)104 ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)105 ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)101 ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk) 102 ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk) 103 ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk) 106 104 END DO 107 105 END DO … … 162 160 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 163 161 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 164 heup(ji,jj) = fsdepw(ji,jj,jk+1)! Euphotic layer depth162 heup(ji,jj) = gdepw_n(ji,jj,jk+1) ! Euphotic layer depth 165 163 ENDIF 166 164 END DO … … 179 177 DO jj = 1, jpj 180 178 DO ji = 1, jpi 181 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN182 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation183 zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production184 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * fse3t(ji,jj,jk) ! production185 zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * fse3t(ji,jj,jk) ! production186 zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk)179 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 180 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation 181 zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 182 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 183 zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 184 zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t_n(ji,jj,jk) 187 185 ENDIF 188 186 END DO … … 196 194 DO jj = 1, jpj 197 195 DO ji = 1, jpi 198 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN196 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 199 197 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 200 198 emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep … … 260 258 DO jj = 1, jpj 261 259 DO ji = 1, jpi 262 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r )260 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 263 261 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) ) 264 262 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r5836 r6140 54 54 REAL(wp) :: texcret2 !: 1 - excret2 55 55 56 !! * Substitutions57 # include "domzgr_substitute.h90"58 56 !!---------------------------------------------------------------------- 59 57 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 277 275 DO jj = 1, jpj 278 276 DO ji = 1, jpi 279 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN277 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 280 278 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 281 279 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) … … 321 319 DO jj = 1, jpj 322 320 DO ji = 1, jpi 323 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN321 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 324 322 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 325 323 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) … … 462 460 zw2d(:,:) = 0. 463 461 DO jk = 1, jpkm1 464 zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano462 zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 465 463 ENDDO 466 464 CALL iom_put( "INTPPPHY" , zw2d ) … … 468 466 zw2d(:,:) = 0. 469 467 DO jk = 1, jpkm1 470 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom468 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom 471 469 ENDDO 472 470 CALL iom_put( "INTPPPHY2" , zw2d ) … … 475 473 zw2d(:,:) = 0. 476 474 DO jk = 1, jpkm1 477 zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp475 zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 478 476 ENDDO 479 477 CALL iom_put( "INTPP" , zw2d ) … … 482 480 zw2d(:,:) = 0. 483 481 DO jk = 1, jpkm1 484 zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod482 zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod 485 483 ENDDO 486 484 CALL iom_put( "INTPNEW" , zw2d ) … … 489 487 zw2d(:,:) = 0. 490 488 DO jk = 1, jpkm1 491 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod489 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 492 490 ENDDO 493 491 CALL iom_put( "INTPBFE" , zw2d ) … … 496 494 zw2d(:,:) = 0. 497 495 DO jk = 1, jpkm1 498 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bsi prod496 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bsi prod 499 497 ENDDO 500 498 CALL iom_put( "INTPBSI" , zw2d ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r5836 r6140 50 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitnh4 !: - - - - - 51 51 52 !! * Substitutions53 # include "domzgr_substitute.h90"54 52 !!---------------------------------------------------------------------- 55 53 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 103 101 DO ji = 1, jpi 104 102 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 105 IF( fsdept(ji,jj,jk) < zdep ) THEN103 IF( gdept_n(ji,jj,jk) < zdep ) THEN 106 104 zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 ) 107 105 ztempbac(ji,jj) = zdepbac(ji,jj,jk) 108 106 ELSE 109 zdepmin = MIN( 1., zdep / fsdept(ji,jj,jk) )107 zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) ) 110 108 zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 111 109 zdepprod(ji,jj,jk) = zdepmin**0.273 … … 283 281 ! ---------------------------------------------------------- 284 282 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 285 zdep = MAX( 0., fsdept(ji,jj,jk) - zdep )283 zdep = MAX( 0., gdept_n(ji,jj,jk) - zdep ) 286 284 ztem = MAX( tsn(ji,jj,1,jp_tem), 0. ) 287 285 zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r5836 r6140 25 25 PUBLIC p4z_sbc_init 26 26 27 !! * Shared module variables28 27 LOGICAL , PUBLIC :: ln_dust !: boolean for dust input from the atmosphere 29 28 LOGICAL , PUBLIC :: ln_solub !: boolean for variable solubility of atmospheric iron … … 45 44 LOGICAL , PUBLIC :: ll_sbc 46 45 47 !! * Module variables48 46 LOGICAL :: ll_solub 49 47 … … 80 78 REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput 81 79 82 83 80 !! * Substitutions 84 # include "domzgr_substitute.h90"85 81 # include "vectopt_loop_substitute.h90" 86 82 !!---------------------------------------------------------------------- … … 89 85 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 90 86 !!---------------------------------------------------------------------- 91 92 87 CONTAINS 93 88 … … 163 158 DO jj = 1, jpj 164 159 DO ji = 1, jpi 165 nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn )160 nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * e3t_n(ji,jj,1) + rtrn ) 166 161 END DO 167 162 END DO … … 267 262 IF( lk_offline ) THEN 268 263 nk_rnf(:,:) = 1 269 h_rnf (:,:) = fsdept(:,:,1)264 h_rnf (:,:) = gdept_n(:,:,1) 270 265 ENDIF 271 266 … … 456 451 DO jj = 1, jpj 457 452 DO ji = 1, jpi 458 zexpide = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )453 zexpide = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) ) 459 454 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 460 455 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) … … 466 461 ironsed(:,:,jpk) = 0._wp 467 462 DO jk = 1, jpkm1 468 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday )463 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_n(:,:,jk) * rday ) 469 464 END DO 470 465 DEALLOCATE( zcmask) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r5836 r6140 32 32 PUBLIC p4z_sed_alloc 33 33 34 35 !! * Module variables36 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot !: Nitrogen fixation 37 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: sdenit !: Nitrate reduction in the sediments 38 36 REAL(wp) :: r1_rday !: inverse of rday 39 37 40 !! * Substitutions41 # include "domzgr_substitute.h90"42 38 !!---------------------------------------------------------------------- 43 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 100 96 DO jj = 1, jpj 101 97 DO ji = 1, jpi 102 zdep = rfact2 / fse3t(ji,jj,1)98 zdep = rfact2 / e3t_n(ji,jj,1) 103 99 zwflux = fmmflx(ji,jj) / 1000._wp 104 100 zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep … … 111 107 ! 112 108 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) ) & 113 & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice109 & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 114 110 ! 115 111 CALL wrk_dealloc( jpi, jpj, zironice ) … … 125 121 ! ! Iron and Si deposition at the surface 126 122 IF( ln_solub ) THEN 127 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss123 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 128 124 ELSE 129 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss125 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 130 126 ENDIF 131 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 28.1132 zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 31. / po4r127 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 128 zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 133 129 ! ! Iron solubilization of particles in the water column 134 130 ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j 135 131 zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 136 132 DO jk = 2, jpkm1 137 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( - fsdept(:,:,jk) / 540. )133 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 138 134 END DO 139 135 ! ! Iron solubilization of particles in the water column … … 145 141 IF( knt == nrdttrc ) THEN 146 142 IF( iom_use( "Irondep" ) ) & 147 & CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron143 & CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 148 144 IF( iom_use( "pdust" ) ) & 149 145 & CALL iom_put( "pdust" , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface … … 151 147 ELSE 152 148 IF( ln_diatrc ) & 153 & trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)149 & trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 154 150 ENDIF 155 151 CALL wrk_dealloc( jpi, jpj, zpdep, zsidep ) … … 206 202 DO ji = 1, jpi 207 203 ikt = mbkt(ji,jj) 208 zdep = fse3t(ji,jj,ikt) / xstep204 zdep = e3t_n(ji,jj,ikt) / xstep 209 205 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 210 206 zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) ) … … 230 226 zo2 = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 231 227 zno3 = LOG10( MAX( 1. , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 232 zdep = LOG10( fsdepw(ji,jj,ikt+1) )228 zdep = LOG10( gdepw_n(ji,jj,ikt+1) ) 233 229 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 & 234 230 & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 … … 279 275 DO ji = 1, jpi 280 276 ikt = mbkt(ji,jj) 281 zdep = xstep / fse3t(ji,jj,ikt)277 zdep = xstep / e3t_n(ji,jj,ikt) 282 278 zws4 = zwsbio4(ji,jj) * zdep 283 279 zwsc = zwscal (ji,jj) * zdep … … 305 301 DO ji = 1, jpi 306 302 ikt = mbkt(ji,jj) 307 zdep = xstep / fse3t(ji,jj,ikt)303 zdep = xstep / e3t_n(ji,jj,ikt) 308 304 zws4 = zwsbio4(ji,jj) * zdep 309 305 zws3 = zwsbio3(ji,jj) * zdep … … 336 332 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 337 333 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 338 sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)334 sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 339 335 #endif 340 336 END DO … … 388 384 zwork1(:,:) = 0. 389 385 DO jk = 1, jpkm1 390 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk)386 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 391 387 ENDDO 392 388 CALL iom_put( "INTNFIX" , zwork1 ) … … 395 391 ELSE 396 392 IF( ln_diatrc ) & 397 & trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)393 & trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 398 394 ENDIF 399 395 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r5836 r6140 65 65 #endif 66 66 67 !! * Substitutions68 # include "domzgr_substitute.h90"69 67 !!---------------------------------------------------------------------- 70 68 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 108 106 DO ji = 1,jpi 109 107 zmax = MAX( heup(ji,jj), hmld(ji,jj) ) 110 zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 5000._wp108 zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / 5000._wp 111 109 wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 112 110 END DO … … 137 135 DO ji = 1, jpi 138 136 IF( tmask(ji,jj,jk) == 1) THEN 139 zwsmax = 0.5 * fse3t(ji,jj,jk) / xstep137 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep 140 138 iiter1 = MAX( iiter1, INT( wsbio3(ji,jj,jk) / zwsmax ) ) 141 139 iiter2 = MAX( iiter2, INT( wsbio4(ji,jj,jk) / zwsmax ) ) … … 156 154 DO ji = 1, jpi 157 155 IF( tmask(ji,jj,jk) == 1 ) THEN 158 zwsmax = 0.5 * fse3t(ji,jj,jk) / xstep156 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep 159 157 wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * FLOAT( iiter1 ) ) 160 158 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * FLOAT( iiter2 ) ) … … 700 698 zl = zmin 701 699 zr = zmax 702 wmax = 0.5 * fse3t(1,1,jk) * rday * float(niter1max) / rfact2700 wmax = 0.5 * e3t_n(1,1,jk) * rday * float(niter1max) / rfact2 703 701 zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 704 702 znum = zl - 1. … … 844 842 DO jj = 1, jpj 845 843 DO ji = 1, jpi 846 zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1)844 zigma = zwsink2(ji,jj,jk+1) * zstep / e3w_n(ji,jj,jk+1) 847 845 zew = zwsink2(ji,jj,jk+1) 848 846 psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep … … 858 856 DO jj = 1,jpj 859 857 DO ji = 1, jpi 860 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk)858 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 861 859 trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx 862 860 END DO … … 869 867 DO jj = 1,jpj 870 868 DO ji = 1, jpi 871 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk)869 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 872 870 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 873 871 END DO -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r5836 r6140 92 92 ! 93 93 ! ! set time step size (Euler/Leapfrog) 94 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ; rfact = rdttrc (1)! at nittrc00095 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; rfact = 2. * rdttrc (1)! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)94 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ; rfact = rdttrc ! at nittrc000 95 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; rfact = 2. * rdttrc ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog) 96 96 ENDIF 97 97 ! … … 102 102 xstep = rfact2 / rday ! Time step duration for biology 103 103 IF(lwp) WRITE(numout,*) 104 IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdt tra(1)104 IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdt 105 105 IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2 106 106 IF(lwp) WRITE(numout,*) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90
r5215 r6140 60 60 61 61 ALLOCATE( zdta(jpi,jpj,jpksed,jptrased), zdta1(jpi,jpj,jpksed,2), zhipor(jpoce,jpksed) ) 62 63 IF ( jprstlib == jprstdimg ) THEN64 ! eventually read netcdf file (monobloc) for restarting on different number of processors65 ! if restart_sed.nc exists, then set jlibalt to jpnf9066 INQUIRE( FILE = 'restart_sed.nc', EXIST = llok )67 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF68 ENDIF69 62 70 63 CALL iom_open( 'restart_sed', numrsr, kiolib = jlibalt ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90
r5836 r6140 21 21 PUBLIC trc_wri_pisces 22 22 23 !! * Substitutions 24 # include "domzgr_substitute.h90" 25 23 !!---------------------------------------------------------------------- 24 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 25 !! $Id: trcnam.F90 5836 2015-10-26 14:49:40Z cetlod $ 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 !!---------------------------------------------------------------------- 26 28 CONTAINS 27 29 … … 57 59 zdic(:,:) = 0. 58 60 DO jk = 1, jpkm1 59 zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * fse3t(:,:,jk) * tmask(:,:,jk) * 12.61 zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 60 62 ENDDO 61 63 CALL iom_put( 'INTDIC', zdic ) … … 64 66 IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth 65 67 zo2min (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 66 zdepo2min(:,:) = fsdepw(:,:,1)* tmask(:,:,1)68 zdepo2min(:,:) = gdepw_n(:,:,1) * tmask(:,:,1) 67 69 DO jk = 2, jpkm1 68 70 DO jj = 1, jpj … … 71 73 IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 72 74 zo2min (ji,jj) = trn(ji,jj,jk,jpoxy) 73 zdepo2min(ji,jj) = fsdepw(ji,jj,jk)75 zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 74 76 ENDIF 75 77 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r5836 r6140 32 32 33 33 PUBLIC trc_adv 34 PUBLIC trc_adv_alloc35 34 PUBLIC trc_adv_ini 36 35 … … 58 57 INTEGER :: nadv ! chosen advection scheme 59 58 ! 60 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra61 ! ! except at nitrrc000 (=rdt tra) if neuler=059 REAL(wp) :: r2dttrc ! vertical profile time-step, = 2 rdt 60 ! ! except at nitrrc000 (=rdt) if neuler=0 62 61 63 62 !! * Substitutions 64 # include "domzgr_substitute.h90"65 63 # include "vectopt_loop_substitute.h90" 66 64 !!---------------------------------------------------------------------- … … 70 68 !!---------------------------------------------------------------------- 71 69 CONTAINS 72 73 INTEGER FUNCTION trc_adv_alloc()74 !!----------------------------------------------------------------------75 !! *** ROUTINE trc_adv_alloc ***76 !!----------------------------------------------------------------------77 !78 ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc )79 !80 IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')81 !82 END FUNCTION trc_adv_alloc83 84 70 85 71 SUBROUTINE trc_adv( kt ) … … 103 89 ! 104 90 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 105 r2dt (:) = rdttrc(:)! = rdttrc (use or restarting with Euler time stepping)91 r2dttrc = rdttrc ! = rdttrc (use or restarting with Euler time stepping) 106 92 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 107 r2dt (:) = 2. * rdttrc(:)! = 2 rdttrc (leapfrog)93 r2dttrc = 2. * rdttrc ! = 2 rdttrc (leapfrog) 108 94 ENDIF 109 95 ! !== effective transport ==! 110 96 DO jk = 1, jpkm1 111 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport112 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk)97 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport 98 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 113 99 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 114 100 END DO … … 134 120 CALL tra_adv_cen ( kt, nittrc000,'TRC', zun, zvn, zwn , trn, tra, jptra, nn_cen_h, nn_cen_v ) 135 121 CASE ( np_FCT ) ! FCT : 2nd / 4th order 136 CALL tra_adv_fct ( kt, nittrc000,'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )122 CALL tra_adv_fct ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 137 123 CASE ( np_FCT_zts ) ! 2nd order FCT with vertical time-splitting 138 CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra , nn_fct_zts )124 CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra , nn_fct_zts ) 139 125 CASE ( np_MUS ) ! MUSCL 140 CALL tra_adv_mus ( kt, nittrc000,'TRC', r2dt , zun, zvn, zwn, trb, tra, jptra , ln_mus_ups )126 CALL tra_adv_mus ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, tra, jptra , ln_mus_ups ) 141 127 CASE ( np_UBS ) ! UBS 142 CALL tra_adv_ubs ( kt, nittrc000,'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra , nn_ubs_v )128 CALL tra_adv_ubs ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra , nn_ubs_v ) 143 129 CASE ( np_QCK ) ! QUICKEST 144 CALL tra_adv_qck ( kt, nittrc000,'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra )130 CALL tra_adv_qck ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) 145 131 ! 146 132 END SELECT … … 231 217 CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 232 218 ENDIF 233 IF( lk_vvl) THEN219 IF( .NOT.ln_linssh ) THEN 234 220 CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 235 221 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r5836 r6140 43 43 44 44 !! * Substitutions 45 # include "domzgr_substitute.h90"46 45 # include "vectopt_loop_substitute.h90" 47 46 !!---------------------------------------------------------------------- … … 82 81 !! - save the trends ('key_trdmxl_trc') 83 82 !!---------------------------------------------------------------------- 84 !! 85 INTEGER, INTENT( in ) :: kt ! ocean time-step index 86 !! 87 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 88 REAL(wp) :: ztra ! temporary scalars 89 CHARACTER (len=22) :: charout 83 INTEGER, INTENT(in) :: kt ! ocean time-step index 84 ! 85 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 86 CHARACTER (len=22) :: charout 90 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace88 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 92 89 !!---------------------------------------------------------------------- 93 90 ! … … 105 102 ! 106 103 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 107 104 ! 108 105 jl = n_trc_index(jn) 109 106 CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 110 107 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 111 108 ! 112 109 SELECT CASE ( nn_zdmp_tr ) 113 110 ! … … 116 113 DO jj = 2, jpjm1 117 114 DO ji = fs_2, fs_jpim1 ! vector opt. 118 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 119 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 115 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 120 116 END DO 121 117 END DO 122 118 END DO 123 !119 ! 124 120 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==! 125 121 DO jk = 1, jpkm1 … … 127 123 DO ji = fs_2, fs_jpim1 ! vector opt. 128 124 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 129 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 130 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 125 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 131 126 ENDIF 132 127 END DO 133 128 END DO 134 129 END DO 135 !130 ! 136 131 CASE ( 2 ) !== no damping in the mixed layer ==! 137 132 DO jk = 1, jpkm1 138 133 DO jj = 2, jpjm1 139 134 DO ji = fs_2, fs_jpim1 ! vector opt. 140 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 141 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 142 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 135 IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 136 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 143 137 END IF 144 138 END DO 145 139 END DO 146 140 END DO 147 !141 ! 148 142 END SELECT 149 143 ! … … 162 156 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 163 157 ! ! print mean trends (used for debugging) 164 IF( ln_ctl ) THEN 165 WRITE(charout, FMT="('dmp ')") ; CALL prt_ctl_trc_info(charout) 166 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 158 IF( ln_ctl ) THEN 159 WRITE(charout, FMT="('dmp ')") 160 CALL prt_ctl_trc_info(charout) 161 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 167 162 ENDIF 168 163 ! … … 170 165 ! 171 166 END SUBROUTINE trc_dmp 167 172 168 173 169 SUBROUTINE trc_dmp_ini … … 180 176 !! called by trc_dmp at the first timestep (nittrc000) 181 177 !!---------------------------------------------------------------------- 182 ! 183 INTEGER :: ios ! Local integer output status for namelist read 184 INTEGER :: imask !local file handle 185 ! 178 INTEGER :: ios, imask ! local integers 179 !! 186 180 NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 187 181 !!---------------------------------------------------------------------- 188 182 ! 189 183 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init') 190 184 ! 191 192 185 REWIND( numnat_ref ) ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 193 186 READ ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) … … 233 226 END SUBROUTINE trc_dmp_ini 234 227 228 235 229 SUBROUTINE trc_dmp_clo( kt ) 236 230 !!--------------------------------------------------------------------- … … 245 239 !! nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 246 240 !!---------------------------------------------------------------------- 247 INTEGER, INTENT( in ) :: kt ! ocean time-step index 248 ! 249 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 250 INTEGER :: isrow ! local index 251 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 252 253 !!---------------------------------------------------------------------- 254 241 INTEGER, INTENT( in ) :: kt ! ocean time-step index 242 ! 243 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 244 INTEGER :: isrow ! local index 245 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 246 !!---------------------------------------------------------------------- 247 ! 255 248 IF( kt == nit000 ) THEN 256 249 ! initial values … … 364 357 END SUBROUTINE trc_dmp_clo 365 358 366 367 359 #else 368 360 !!---------------------------------------------------------------------- … … 376 368 #endif 377 369 378 379 370 !!====================================================================== 380 371 END MODULE trcdmp -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r5836 r6140 12 12 !! 'key_top' TOP models 13 13 !!---------------------------------------------------------------------- 14 !! trc_ldf : update the tracer trend with the lateral diffusion 15 !! trc_ldf_ini : initialization, namelist read, and parameters control 16 !!---------------------------------------------------------------------- 17 USE trc ! ocean passive tracers variables 18 USE oce_trc ! ocean dynamics and active tracers 19 USE ldfslp ! lateral diffusion: iso-neutral slope 20 USE traldf_lap ! lateral diffusion: laplacian iso-level operator (tra_ldf_lap routine) 21 USE traldf_iso ! lateral diffusion: laplacian iso-neutral standard operator (tra_ldf_iso routine) 22 USE traldf_triad ! lateral diffusion: laplacian iso-neutral triad operator (tra_ldf_triad routine) 23 USE traldf_blp ! lateral diffusion (iso-level lap/blp) (tra_ldf_lap routine) 24 USE trd_oce ! trends: ocean variables 25 USE trdtra ! trends manager: tracers 14 !! trc_ldf : update the tracer trend with the lateral diffusion 15 !! trc_ldf_ini : initialization, namelist read, and parameters control 16 !!---------------------------------------------------------------------- 17 USE trc ! ocean passive tracers variables 18 USE oce_trc ! ocean dynamics and active tracers 19 USE ldfslp ! lateral diffusion: iso-neutral slope 20 USE traldf_lap_blp ! lateral diffusion: lap/bilaplacian iso-level operator (tra_ldf_lap/_blp routine) 21 USE traldf_iso ! lateral diffusion: laplacian iso-neutral standard operator (tra_ldf_iso routine) 22 USE traldf_triad ! lateral diffusion: laplacian iso-neutral triad operator (tra_ldf_ triad routine) 23 USE trd_oce ! trends: ocean variables 24 USE trdtra ! trends manager: tracers 26 25 ! 27 USE prtctl_trc 26 USE prtctl_trc ! Print control 28 27 29 28 IMPLICIT NONE … … 42 41 REAL(wp), PUBLIC :: rn_bhtrc_0 !: bilaplacian - -- - - [m4/s] 43 42 ! 44 !!: ** lateral mixing namelist (nam_trcldf) ** 45 REAL(wp) :: rldf ! ratio between active and passive tracers diffusive coefficient 43 ! !!: ** lateral mixing namelist (nam_trcldf) ** 44 REAL(wp) :: rldf ! ratio between active and passive tracers diffusive coefficient 45 46 46 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 47 47 48 48 !! * Substitutions 49 # include "domzgr_substitute.h90"50 49 # include "vectopt_loop_substitute.h90" 51 50 !!---------------------------------------------------------------------- … … 64 63 !!---------------------------------------------------------------------- 65 64 INTEGER, INTENT( in ) :: kt ! ocean time-step index 66 ! !65 ! 67 66 INTEGER :: jn 68 67 CHARACTER (len=22) :: charout … … 99 98 END SELECT 100 99 ! 101 IF( l_trdtrc ) THEN ! s ave the horizontal diffusive trends for further diagnostics100 IF( l_trdtrc ) THEN ! send the trends for further diagnostics 102 101 DO jn = 1, jptra 103 102 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) … … 106 105 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 107 106 ENDIF 108 ! ! print mean trends (used for debugging) 109 IF( ln_ctl ) THEN 110 WRITE(charout, FMT="('ldf ')") ; CALL prt_ctl_trc_info(charout) 111 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 107 ! 108 IF( ln_ctl ) THEN ! print mean trends (used for debugging) 109 WRITE(charout, FMT="('ldf ')") 110 CALL prt_ctl_trc_info(charout) 111 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 112 112 ENDIF 113 113 ! … … 133 133 INTEGER :: ioptio, ierr ! temporary integers 134 134 INTEGER :: ios ! Local integer output status for namelist read 135 ! 135 !! 136 136 NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp, & 137 137 & ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad, & 138 138 & rn_ahtrc_0 , rn_bhtrc_0 139 139 !!---------------------------------------------------------------------- 140 REWIND( numnat_ref ) ! namtrc_ldf in reference namelist 140 ! 141 REWIND( numnat_ref ) ! namtrc_ldf in reference namelist 141 142 READ ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 142 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp )143 144 REWIND( numnat_cfg ) 143 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp ) 144 ! 145 REWIND( numnat_cfg ) ! namtrc_ldf in configuration namelist 145 146 READ ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 146 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp )147 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 147 148 IF(lwm) WRITE ( numont, namtrc_ldf ) 148 149 IF(lwp) THEN ! Namelist print149 ! 150 IF(lwp) THEN ! Namelist print 150 151 WRITE(numout,*) 151 152 WRITE(numout,*) 'trc_ldf_ini : lateral tracer diffusive operator' … … 174 175 IF( ln_trcldf_lap .AND. ln_trcldf_blp ) CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' ) 175 176 IF( ln_trcldf_blp .AND. ln_trcldf_lap ) CALL ctl_stop( 'trc_ldf_ctl: laplacian should be used on both TRC and TRA' ) 176 177 ! 177 178 ioptio = 0 178 179 IF( ln_trcldf_lev ) ioptio = ioptio + 1 … … 180 181 IF( ln_trcldf_iso ) ioptio = ioptio + 1 181 182 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 182 183 ! 183 184 ! defined the type of lateral diffusion from ln_trcldf_... logicals 184 185 ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully … … 204 205 ENDIF 205 206 ! ! diffusivity ratio: passive / active tracers 206 IF( ABS(rn_aht_0) < 2._wp*TINY(1. e0) ) THEN207 IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1. e0) ) THEN207 IF( ABS(rn_aht_0) < 2._wp*TINY(1._wp) ) THEN 208 IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1._wp) ) THEN 208 209 rldf = 1.0_wp 209 210 ELSE 210 CALL ctl_stop( ' STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' )211 CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 211 212 ENDIF 212 213 ELSE … … 235 236 ENDIF 236 237 ! ! diffusivity ratio: passive / active tracers 237 IF( ABS(rn_bht_0) < 2._wp*TINY(1. e0) ) THEN238 IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1. e0) ) THEN238 IF( ABS(rn_bht_0) < 2._wp*TINY(1._wp) ) THEN 239 IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1._wp) ) THEN 239 240 rldf = 1.0_wp 240 241 ELSE 241 CALL ctl_stop( ' STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' )242 CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 242 243 ENDIF 243 244 ELSE … … 246 247 ENDIF 247 248 ! 248 IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 249 IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso ) & 250 CALL ctl_stop( ' eddy induced velocity on tracers', & 251 & ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 252 IF( nldf == 1 .OR. nldf == 3 ) THEN ! rotation 253 IF( .NOT.l_ldfslp ) CALL ctl_stop( ' the rotation of the diffusive tensor require l_ldfslp' ) 254 ENDIF 249 IF( ierr == 1 ) CALL ctl_stop( 'trc_ldf_ctl: iso-level in z-partial step, not allowed' ) 250 IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso ) CALL ctl_stop( 'trc_ldf_ctl: eiv requires isopycnal laplacian diffusion' ) 251 IF( nldf == 1 .OR. nldf == 3 ) l_ldfslp = .TRUE. ! slope of neutral surfaces required 255 252 ! 256 253 IF(lwp) THEN 257 254 WRITE(numout,*) 258 IF( nldf == np_no_ldf ) WRITE(numout,*) ' NO lateral diffusion' 259 IF( nldf == np_lap ) WRITE(numout,*) ' laplacian iso-level operator' 260 IF( nldf == np_lap_i ) WRITE(numout,*) ' Rotated laplacian operator (standard)' 261 IF( nldf == np_lap_it ) WRITE(numout,*) ' Rotated laplacian operator (triad)' 262 IF( nldf == np_blp ) WRITE(numout,*) ' bilaplacian iso-level operator' 263 IF( nldf == np_blp_i ) WRITE(numout,*) ' Rotated bilaplacian operator (standard)' 264 IF( nldf == np_blp_it ) WRITE(numout,*) ' Rotated bilaplacian operator (triad)' 255 SELECT CASE( nldf ) 256 CASE( np_no_ldf ) ; WRITE(numout,*) ' NO lateral diffusion' 257 CASE( np_lap ) ; WRITE(numout,*) ' laplacian iso-level operator' 258 CASE( np_lap_i ) ; WRITE(numout,*) ' Rotated laplacian operator (standard)' 259 CASE( np_lap_it ) ; WRITE(numout,*) ' Rotated laplacian operator (triad)' 260 CASE( np_blp ) ; WRITE(numout,*) ' bilaplacian iso-level operator' 261 CASE( np_blp_i ) ; WRITE(numout,*) ' Rotated bilaplacian operator (standard)' 262 CASE( np_blp_it ) ; WRITE(numout,*) ' Rotated bilaplacian operator (triad)' 263 END SELECT 265 264 ENDIF 266 265 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r5656 r6140 33 33 USE trdtra 34 34 USE tranxt 35 USE trcbdy ! BDY open boundaries 36 USE bdy_par, only: lk_bdy 35 37 # if defined key_agrif 36 38 USE agrif_top_interp … … 41 43 42 44 PUBLIC trc_nxt ! routine called by step.F90 43 PUBLIC trc_nxt_alloc ! routine called by nemogcm.F9044 45 45 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt46 REAL(wp) :: r2dttrc 46 47 47 48 !!---------------------------------------------------------------------- … … 51 52 !!---------------------------------------------------------------------- 52 53 CONTAINS 53 54 INTEGER FUNCTION trc_nxt_alloc()55 !!----------------------------------------------------------------------56 !! *** ROUTINE trc_nxt_alloc ***57 !!----------------------------------------------------------------------58 ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc )59 !60 IF( trc_nxt_alloc /= 0 ) CALL ctl_warn('trc_nxt_alloc : failed to allocate array')61 !62 END FUNCTION trc_nxt_alloc63 64 54 65 55 SUBROUTINE trc_nxt( kt ) … … 101 91 WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 102 92 ENDIF 103 93 ! 104 94 #if defined key_agrif 105 95 CALL Agrif_trc ! AGRIF zoom boundaries 106 96 #endif 107 ! Update after tracer on domain lateral boundaries 108 DO jn = 1, jptra 97 DO jn = 1, jptra ! Update after tracer on domain lateral boundaries 109 98 CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. ) 110 99 END DO 111 100 101 IF( lk_bdy ) CALL trc_bdy( kt ) 112 102 113 #if defined key_bdy 114 !! CALL bdy_trc( kt ) ! BDY open boundaries 115 #endif 116 117 118 ! set time step size (Euler/Leapfrog) 119 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ; r2dt(:) = rdttrc(:) ! at nittrc000 (Euler) 120 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog) 103 ! ! set time step size (Euler/Leapfrog) 104 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ; r2dttrc = rdttrc ! at nittrc000 (Euler) 105 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dttrc = 2.* rdttrc ! at nit000 or nit000+1 (Leapfrog) 121 106 ENDIF 122 107 123 ! trends computation initialisation 124 IF( l_trdtrc ) THEN 125 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt ) !* store now fields before applying the Asselin filter 108 IF( l_trdtrc ) THEN ! trends: store now fields before the Asselin filter application 109 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt ) 126 110 ztrdt(:,:,:,:) = trn(:,:,:,:) 127 111 ENDIF 128 ! Leap-Frog + Asselin filter time stepping 129 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! Euler time-stepping at first time-step 130 ! ! (only swap) 112 ! ! Leap-Frog + Asselin filter time stepping 113 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! Euler time-stepping at first time-step (only swap) 131 114 DO jn = 1, jptra 132 115 DO jk = 1, jpkm1 … … 134 117 END DO 135 118 END DO 136 ! 137 ELSE 138 ! Leap-Frog + Asselin filter time stepping 139 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra, & 140 & sbc_trc, sbc_trc_b, jptra ) ! variable volume level (vvl) 141 ELSE ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! fixed volume level 119 ELSE ! Asselin filter + swap 120 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! linear ssh 121 ELSE ; CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra, & 122 & sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 142 123 ENDIF 124 ! 125 DO jn = 1, jptra 126 CALL lbc_lnk( trb(:,:,:,jn), 'T', 1._wp ) 127 CALL lbc_lnk( trn(:,:,:,jn), 'T', 1._wp ) 128 CALL lbc_lnk( tra(:,:,:,jn), 'T', 1._wp ) 129 END DO 143 130 ENDIF 144 145 ! trends computation 146 IF( l_trdtrc ) THEN ! trends 131 ! 132 IF( l_trdtrc ) THEN ! trends: send Asselin filter trends to trdtra manager for further diagnostics 147 133 DO jn = 1, jptra 148 134 DO jk = 1, jpkm1 149 zfact = 1. e0 / r2dt(jk)135 zfact = 1._wp / r2dttrc 150 136 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 151 137 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r5836 r6140 28 28 PUBLIC trc_sbc ! routine called by step.F90 29 29 30 REAL(wp) :: r2dt ! time-step at surface31 32 30 !! * Substitutions 33 # include "domzgr_substitute.h90"34 31 # include "vectopt_loop_substitute.h90" 35 32 !!---------------------------------------------------------------------- … … 76 73 ! 77 74 ! Allocate temporary workspace 78 CALL wrk_alloc( jpi, jpj,zsfx )79 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk,ztrtrd )75 CALL wrk_alloc( jpi,jpj, zsfx ) 76 IF( l_trdtrc ) CALL wrk_alloc( jpi,jpj,jpk, ztrtrd ) 80 77 ! 81 78 zrtrn = 1.e-15_wp … … 88 85 89 86 IF( ln_top_euler) THEN 90 r2dt = rdttrc (1)! = rdttrc (use Euler time stepping)87 r2dt = rdttrc ! = rdttrc (use Euler time stepping) 91 88 ELSE 92 89 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 93 r2dt = rdttrc (1)! = rdttrc (restarting with Euler time stepping)90 r2dt = rdttrc ! = rdttrc (restarting with Euler time stepping) 94 91 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 95 r2dt = 2. * rdttrc (1)! = 2 rdttrc (leapfrog)92 r2dt = 2. * rdttrc ! = 2 rdttrc (leapfrog) 96 93 ENDIF 97 94 ENDIF … … 129 126 ! Coupling offline : runoff are in emp which contains E-P-R 130 127 ! 131 IF( .NOT. lk_offline .AND. lk_vvl) THEN ! online coupling with vvl128 IF( .NOT. lk_offline .AND. .NOT.ln_linssh ) THEN ! online coupling with vvl 132 129 zsfx(:,:) = 0._wp 133 130 ELSE ! online coupling free surface or offline with free surface … … 138 135 DO jn = 1, jptra 139 136 ! 140 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 141 ! ! add the trend to the general tracer trend 137 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 142 138 143 139 IF ( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) … … 153 149 DO jj = 2, jpj 154 150 DO ji = fs_2, fs_jpim1 ! vector opt. 155 zse3t = 1. / fse3t(ji,jj,1)151 zse3t = 1. / e3t_n(ji,jj,1) 156 152 ! tracer flux at the ice/ocean interface (tracer/m2/s) 157 153 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice … … 174 170 DO jj = 2, jpj 175 171 DO ji = fs_2, fs_jpim1 ! vector opt. 176 zse3t = zfact / fse3t(ji,jj,1)172 zse3t = zfact / e3t_n(ji,jj,1) 177 173 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 178 174 END DO … … 203 199 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 204 200 ENDIF 205 CALL wrk_dealloc( jpi, jpj,zsfx )206 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk,ztrtrd )201 CALL wrk_dealloc( jpi,jpj, zsfx ) 202 IF( l_trdtrc ) CALL wrk_dealloc( jpi,jpj,jpk, ztrtrd ) 207 203 ! 208 204 IF( nn_timing == 1 ) CALL timing_stop('trc_sbc') -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r5836 r6140 25 25 USE trcsbc ! surface boundary condition (trc_sbc routine) 26 26 USE zpshde ! partial step: hor. derivative (zps_hde routine) 27 USE trcbdy ! BDY open boundaries 28 USE bdy_par, only: lk_bdy 27 29 28 30 #if defined key_agrif … … 64 66 IF( ln_trcdmp ) CALL trc_dmp ( kt ) ! internal damping trends 65 67 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kt ) ! internal damping trends on closed seas only 68 IF( lk_bdy ) CALL trc_bdy_dmp( kt ) ! BDY damping trends 66 69 CALL trc_adv ( kt ) ! horizontal & vertical advection 67 70 ! ! Partial top/bottom cell: GRADh( trb ) -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r5836 r6140 28 28 PUBLIC trc_zdf ! called by step.F90 29 29 PUBLIC trc_zdf_ini ! called by nemogcm.F90 30 PUBLIC trc_zdf_alloc ! called by nemogcm.F9031 30 32 31 ! !!** Vertical diffusion (nam_trczdf) ** … … 36 35 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used 37 36 ! ! defined from ln_zdf... namlist logicals) 38 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra39 ! ! except at nittrc000 (=rdttra) if neuler=037 REAL(wp) :: r2dttrc ! vertical profile time-step, = 2 rdt 38 ! ! except at nittrc000 (=rdt) if neuler=0 40 39 41 40 !! * Substitutions 42 # include "domzgr_substitute.h90"43 41 # include "zdfddm_substitute.h90" 44 42 # include "vectopt_loop_substitute.h90" … … 49 47 !!---------------------------------------------------------------------- 50 48 CONTAINS 51 52 INTEGER FUNCTION trc_zdf_alloc()53 !!----------------------------------------------------------------------54 !! *** ROUTINE trc_zdf_alloc ***55 !!----------------------------------------------------------------------56 ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc )57 !58 IF( trc_zdf_alloc /= 0 ) CALL ctl_warn('trc_zdf_alloc : failed to allocate array.')59 !60 END FUNCTION trc_zdf_alloc61 62 49 63 50 SUBROUTINE trc_zdf( kt ) … … 77 64 ! 78 65 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 79 r2dt (:) = rdttrc(:)! = rdttrc (use or restarting with Euler time stepping)66 r2dttrc = rdttrc ! = rdttrc (use or restarting with Euler time stepping) 80 67 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 81 r2dt (:) = 2. * rdttrc(:)! = 2 rdttrc (leapfrog)68 r2dttrc = 2. * rdttrc ! = 2 rdttrc (leapfrog) 82 69 ENDIF 83 70 … … 88 75 89 76 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 90 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt , nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme91 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt , trb, tra, jptra ) ! implicit scheme77 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme 78 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra ) ! implicit scheme 92 79 END SELECT 93 80 … … 95 82 DO jn = 1, jptra 96 83 DO jk = 1, jpkm1 97 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt (jk)) - ztrtrd(:,:,jk,jn)84 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 98 85 END DO 99 86 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
r5836 r6140 66 66 67 67 !! * Substitutions 68 # include "domzgr_substitute.h90"69 68 # include "zdfddm_substitute.h90" 70 69 !!---------------------------------------------------------------------- … … 175 174 DO jj = 1, jpj 176 175 DO ji = 1, jpi 177 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)176 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 178 177 END DO 179 178 END DO … … 293 292 DO jj = 1,jpj 294 293 DO ji = 1,jpi 295 IF( jk - nmld_trc(ji,jj) < 0. ) wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)294 IF( jk - nmld_trc(ji,jj) < 0. ) wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 296 295 END DO 297 296 END DO … … 330 329 !! 331 330 !! ** Purpose : Compute and cumulate the mixed layer trends over an analysis 332 !! period, and write NetCDF (or dimg)outputs.331 !! period, and write NetCDF outputs. 333 332 !! 334 333 !! ** Method/usage : … … 390 389 ! 391 390 CHARACTER (LEN=10) :: clvar 392 #if defined key_dimgout393 INTEGER :: iyear,imon,iday394 CHARACTER(LEN=80) :: cltext, clmode395 #endif396 391 !!---------------------------------------------------------------------- 397 392 … … 417 412 DO jn = 1, jptra 418 413 IF( ln_trdtrc(jn) ) & 419 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik) &414 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / e3w_n(ji,jj,ik) * tmask(ji,jj,ik) & 420 415 & * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) ) & 421 416 & / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) … … 774 769 ! ====================================================================== 775 770 776 ! IV.1 Code for dimg mpp output 777 ! ----------------------------- 778 779 # if defined key_dimgout 780 STOP 'Not implemented' 781 # else 782 783 ! IV.2 Code for IOIPSL/NetCDF output 771 ! IV.1 Code for IOIPSL/NetCDF output 784 772 ! ---------------------------------- 785 773 … … 865 853 icount = 1 866 854 867 # endif /* key_dimgout */868 869 855 IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN 870 856 ! … … 896 882 !! 897 883 !! ** Purpose : Compute and cumulate the mixed layer biological trends over an analysis 898 !! period, and write NetCDF (or dimg)outputs.884 !! period, and write NetCDF outputs. 899 885 !! 900 886 !! ** Method/usage : … … 943 929 LOGICAL :: llwarn = .TRUE., lldebug = .TRUE. 944 930 REAL(wp) :: zfn, zfn2 945 #if defined key_dimgout946 INTEGER :: iyear,imon,iday947 CHARACTER(LEN=80) :: cltext, clmode948 #endif949 931 !!---------------------------------------------------------------------- 950 932 ! ... Warnings … … 1055 1037 ! ====================================================================== 1056 1038 1057 ! IV.1 Code for dimg mpp output 1058 ! ----------------------------- 1059 1060 # if defined key_dimgout 1061 STOP 'Not implemented' 1062 # else 1063 1064 ! IV.2 Code for IOIPSL/NetCDF output 1039 ! IV.1 Code for IOIPSL/NetCDF output 1065 1040 ! ---------------------------------- 1066 1041 … … 1107 1082 1108 1083 1109 # endif /* key_dimgout */1110 1084 1111 1085 IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN … … 1258 1232 ! ====================================================================== 1259 1233 1260 #if defined key_dimgout1261 ???1262 #else1263 1234 ! clmxl = legend root for netCDF output 1264 1235 IF( nn_ctls_trc == 0 ) THEN ! control surface = mixed-layer with density criterion … … 1403 1374 #endif 1404 1375 1405 #endif /* key_dimgout */1406 1376 END SUBROUTINE trd_mxl_trc_init 1407 1377 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90
r5341 r6140 21 21 22 22 INTEGER :: nummldw_trc ! logical unit for mld restart 23 23 24 !!--------------------------------------------------------------------------------- 24 25 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 26 27 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 28 !!--------------------------------------------------------------------------------- 28 29 29 CONTAINS 30 31 30 32 31 SUBROUTINE trd_mxl_trc_rst_write( kt ) … … 147 146 clpath = TRIM(cn_trcrst_indir) 148 147 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 149 150 IF ( jprstlib == jprstdimg ) THEN151 ! eventually read netcdf file (monobloc) for restarting on different number of processors152 ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90153 INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok )154 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF155 ENDIF156 157 148 CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt ) 158 149 -
trunk/NEMOGCM/NEMO/TOP_SRC/trc.F90
r5836 r6140 14 14 USE par_oce 15 15 USE par_trc 16 #if defined key_bdy 17 USE bdy_oce, only: nb_bdy, OBC_DATA 18 #endif 16 19 17 20 IMPLICIT NONE … … 64 67 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 65 68 CHARACTER(len = 256), PUBLIC :: cn_trcrst_outdir !: restart output directory 66 REAL(wp) , PUBLIC , ALLOCATABLE, SAVE, DIMENSION(:) :: rdttrc !: vertical profile ofpassive tracer time step69 REAL(wp) , PUBLIC :: rdttrc !: passive tracer time step 67 70 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration 68 71 LOGICAL , PUBLIC :: ln_trcdta !: Read inputs data from files … … 91 94 CHARACTER(len = 20) :: clunit !: unit 92 95 LOGICAL :: llinit !: read in a file or not 96 #if defined key_my_trc 97 LOGICAL :: llsbc !: read in a file or not 98 LOGICAL :: llcbc !: read in a file or not 99 LOGICAL :: llobc !: read in a file or not 100 #endif 93 101 LOGICAL :: llsave !: save the tracer or not 94 102 END TYPE PTRACER … … 181 189 # endif 182 190 ! 191 #if defined key_bdy 192 CHARACTER(len=20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cn_trc_dflt ! Default OBC condition for all tracers 193 CHARACTER(len=20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cn_trc ! Choice of boundary condition for tracers 194 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nn_trcdmp_bdy !: =T Tracer damping 195 ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp 196 TYPE(OBC_DATA), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: trcdta_bdy !: bdy external data (local process) 197 #endif 198 ! 183 199 184 200 !!---------------------------------------------------------------------- … … 201 217 & gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , & 202 218 & sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra) , & 203 & cvol(jpi,jpj,jpk) , rdttrc(jpk) , trai(jptra), &219 & cvol(jpi,jpj,jpk) , trai(jptra) , & 204 220 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & 205 & ln_trc_ini(jptra) , ln_trc_wri(jptra) , qsr_mean(jpi,jpj) , STAT = trc_alloc ) 221 & ln_trc_ini(jptra) , ln_trc_wri(jptra) , qsr_mean(jpi,jpj) , & 222 #if defined key_my_trc 223 & ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , & 224 #endif 225 #if defined key_bdy 226 & cn_trc_dflt(nb_bdy) , cn_trc(nb_bdy) , nn_trcdmp_bdy(nb_bdy) , & 227 & trcdta_bdy(jptra,nb_bdy) , & 228 #endif 229 & STAT = trc_alloc ) 206 230 207 231 IF( trc_alloc /= 0 ) CALL ctl_warn('trc_alloc: failed to allocate arrays') -
trunk/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r5215 r6140 1 1 MODULE trcbc 2 2 !!====================================================================== 3 !! *** MODULE trc dta***3 !! *** MODULE trcbc *** 4 4 !! TOP : module for passive tracer boundary conditions 5 5 !!===================================================================== 6 !!---------------------------------------------------------------------- 7 #if defined key_top 6 !! History : 3.5 ! 2014-04 (M. Vichi, T. Lovato) Original 7 !! 3.6 ! 2015-03 (T . Lovato) Revision and BDY support 8 !!---------------------------------------------------------------------- 9 #if defined key_top 8 10 !!---------------------------------------------------------------------- 9 11 !! 'key_top' TOP model 10 12 !!---------------------------------------------------------------------- 11 !! trc_ dta : read and time interpolated passive tracer data13 !! trc_bc : read and time interpolated tracer Boundary Conditions 12 14 !!---------------------------------------------------------------------- 13 15 USE par_trc ! passive tracers parameters … … 17 19 USE lib_mpp ! MPP library 18 20 USE fldread ! read input fields 21 #if defined key_bdy 22 USE bdy_oce, only: nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out 23 #endif 19 24 20 25 IMPLICIT NONE … … 24 29 PUBLIC trc_bc_read ! called in trcstp.F90 or within 25 30 26 INTEGER , SAVE, PUBLIC :: nb_trcobc ! number of tracers with open BC27 INTEGER , SAVE, PUBLIC :: nb_trcsbc ! number of tracers with surface BC28 INTEGER , SAVE, PUBLIC :: nb_trccbc ! number of tracers with coastal BC31 INTEGER , SAVE, PUBLIC :: nb_trcobc ! number of tracers with open BC 32 INTEGER , SAVE, PUBLIC :: nb_trcsbc ! number of tracers with surface BC 33 INTEGER , SAVE, PUBLIC :: nb_trccbc ! number of tracers with coastal BC 29 34 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_indobc ! index of tracer with OBC data 30 35 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_indsbc ! index of tracer with SBC data 31 36 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_indcbc ! index of tracer with CBC data 32 INTEGER , SAVE, PUBLIC :: ntra_obc ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 33 INTEGER , SAVE, PUBLIC :: ntra_sbc ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 34 INTEGER , SAVE, PUBLIC :: ntra_cbc ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 35 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trofac ! multiplicative factor for OBCtracer values 36 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcobc ! structure of data input OBC (file informations, fields read) 37 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trsfac ! multiplicative factor for SBC tracer values 38 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcsbc ! structure of data input SBC (file informations, fields read) 39 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trcfac ! multiplicative factor for CBC tracer values 40 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trccbc ! structure of data input CBC (file informations, fields read) 41 42 !! * Substitutions 43 # include "domzgr_substitute.h90" 44 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 46 !! $Id$ 37 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trsfac ! multiplicative factor for SBC tracer values 38 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcsbc ! structure of data input SBC (file informations, fields read) 39 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trcfac ! multiplicative factor for CBC tracer values 40 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trccbc ! structure of data input CBC (file informations, fields read) 41 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trofac ! multiplicative factor for OBCtracer values 42 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET :: sf_trcobc ! structure of data input OBC (file informations, fields read) 43 TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap 44 45 !!---------------------------------------------------------------------- 46 !! NEMO/OPA 3.6 , NEMO Consortium (2015) 47 !! $Id$ 47 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 49 !!---------------------------------------------------------------------- 49 50 CONTAINS 50 51 51 SUBROUTINE trc_bc_init( ntrc)52 SUBROUTINE trc_bc_init( ntrc ) 52 53 !!---------------------------------------------------------------------- 53 54 !! *** ROUTINE trc_bc_init *** … … 60 61 ! 61 62 INTEGER,INTENT(IN) :: ntrc ! number of tracers 62 INTEGER :: jl, jn 63 INTEGER :: jl, jn , ib, ibd, ii, ij, ik ! dummy loop indices 63 64 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers 64 INTEGER :: ios ! Local integer output status for namelist read 65 INTEGER :: ios ! Local integer output status for namelist read 66 INTEGER :: nblen, igrd ! support arrays for BDY 65 67 CHARACTER(len=100) :: clndta, clntrc 66 68 ! 67 CHARACTER(len=100) :: cn_dir 69 CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc 70 68 71 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! local array of namelist informations on the fields to read 69 72 TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc ! open … … 74 77 REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trcfac ! multiplicative factor for tracer values 75 78 !! 76 NAMELIST/namtrc_bc/ cn_dir, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 79 NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 80 #if defined key_bdy 81 NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 82 #endif 77 83 !!---------------------------------------------------------------------- 78 84 IF( nn_timing == 1 ) CALL timing_start('trc_bc_init') 79 85 ! 86 IF( lwp ) THEN 87 WRITE(numout,*) ' ' 88 WRITE(numout,*) 'trc_bc_init : Tracers Boundary Conditions (BC)' 89 WRITE(numout,*) '~~~~~~~~~~~ ' 90 ENDIF 80 91 ! Initialisation and local array allocation 81 92 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 … … 107 118 n_trc_indcbc(:) = 0 108 119 ! 109 DO jn = 1, ntrc 110 IF( ln_trc_obc(jn) ) THEN 111 nb_trcobc = nb_trcobc + 1 112 n_trc_indobc(jn) = nb_trcobc 113 ENDIF 114 IF( ln_trc_sbc(jn) ) THEN 115 nb_trcsbc = nb_trcsbc + 1 116 n_trc_indsbc(jn) = nb_trcsbc 117 ENDIF 118 IF( ln_trc_cbc(jn) ) THEN 119 nb_trccbc = nb_trccbc + 1 120 n_trc_indcbc(jn) = nb_trccbc 121 ENDIF 122 ENDDO 123 ntra_obc = MAX( 1, nb_trcobc ) ! To avoid compilation error with bounds checking 124 IF( lwp ) WRITE(numout,*) ' ' 125 IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with open boundary data :', nb_trcobc 126 IF( lwp ) WRITE(numout,*) ' ' 127 ntra_sbc = MAX( 1, nb_trcsbc ) ! To avoid compilation error with bounds checking 128 IF( lwp ) WRITE(numout,*) ' ' 129 IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with surface boundary data :', nb_trcsbc 130 IF( lwp ) WRITE(numout,*) ' ' 131 ntra_cbc = MAX( 1, nb_trccbc ) ! To avoid compilation error with bounds checking 132 IF( lwp ) WRITE(numout,*) ' ' 133 IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with coastal boundary data :', nb_trccbc 134 IF( lwp ) WRITE(numout,*) ' ' 135 120 ! Read Boundary Conditions Namelists 136 121 REWIND( numnat_ref ) ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 137 122 READ ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) … … 143 128 IF(lwm) WRITE ( numont, namtrc_bc ) 144 129 145 ! print some information for each 130 #if defined key_bdy 131 REWIND( numnat_ref ) ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 132 READ ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 133 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 134 135 REWIND( numnat_cfg ) ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 136 READ ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 137 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 138 IF(lwm) WRITE ( numont, namtrc_bdy ) 139 ! setup up preliminary informations for BDY structure 140 DO jn = 1, ntrc 141 DO ib = 1, nb_bdy 142 ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 143 IF ( ln_trc_obc(jn) ) THEN 144 trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 145 ELSE 146 trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 147 ENDIF 148 ! set damping use in BDY data structure 149 trcdta_bdy(jn,ib)%dmp = .false. 150 IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 151 IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true. 152 IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 ) & 153 & CALL ctl_stop( 'Use FRS OR relaxation' ) 154 IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2) & 155 & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 156 ENDDO 157 ENDDO 158 159 #else 160 ! Force all tracers OBC to false if bdy not used 161 ln_trc_obc = .false. 162 #endif 163 ! compose BC data indexes 164 DO jn = 1, ntrc 165 IF( ln_trc_obc(jn) ) THEN 166 nb_trcobc = nb_trcobc + 1 ; n_trc_indobc(jn) = nb_trcobc 167 ENDIF 168 IF( ln_trc_sbc(jn) ) THEN 169 nb_trcsbc = nb_trcsbc + 1 ; n_trc_indsbc(jn) = nb_trcsbc 170 ENDIF 171 IF( ln_trc_cbc(jn) ) THEN 172 nb_trccbc = nb_trccbc + 1 ; n_trc_indcbc(jn) = nb_trccbc 173 ENDIF 174 ENDDO 175 176 ! Print summmary of Boundary Conditions 146 177 IF( lwp ) THEN 178 WRITE(numout,*) ' ' 179 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc 180 IF ( nb_trcsbc > 0 ) THEN 181 WRITE(numout,*) ' #trc NAME Boundary Mult.Fact. ' 182 DO jn = 1, ntrc 183 IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 184 ENDDO 185 ENDIF 186 WRITE(numout,'(2a)') ' SURFACE BC data repository : ', TRIM(cn_dir_sbc) 187 188 WRITE(numout,*) ' ' 189 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 190 IF ( nb_trccbc > 0 ) THEN 191 WRITE(numout,*) ' #trc NAME Boundary Mult.Fact. ' 192 DO jn = 1, ntrc 193 IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 194 ENDDO 195 ENDIF 196 WRITE(numout,'(2a)') ' COASTAL BC data repository : ', TRIM(cn_dir_cbc) 197 198 WRITE(numout,*) ' ' 199 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with OPEN BCs data:', nb_trcobc 200 #if defined key_bdy 201 IF ( nb_trcobc > 0 ) THEN 202 WRITE(numout,*) ' #trc NAME Boundary Mult.Fact. OBC Settings' 203 DO jn = 1, ntrc 204 IF ( ln_trc_obc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 205 IF ( .NOT. ln_trc_obc(jn) ) WRITE(numout, 9002) jn, 'Set data to IC and use default condition', (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 206 ENDDO 207 WRITE(numout,*) ' ' 208 DO ib = 1, nb_bdy 209 IF (nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) ' Boundary ',ib,' -> NO damping of tracers' 210 IF (nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) ' Boundary ',ib,' -> damping ONLY for tracers with external data provided' 211 IF (nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) ' Boundary ',ib,' -> damping of ALL tracers' 212 IF (nn_trcdmp_bdy(ib) .GT. 0) THEN 213 WRITE(numout,9003) ' USE damping parameters from nambdy for boundary ', ib,' : ' 214 WRITE(numout,'(a,f10.2,a)') ' - Inflow damping time scale : ',rn_time_dmp(ib),' days' 215 WRITE(numout,'(a,f10.2,a)') ' - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 216 ENDIF 217 ENDDO 218 ENDIF 219 #endif 220 WRITE(numout,'(2a)') ' OPEN BC data repository : ', TRIM(cn_dir_obc) 221 ENDIF 222 9001 FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13) 223 9002 FORMAT(2x,i5, 3x, a41, 3x, 10a13) 224 9003 FORMAT(a, i5, a) 225 226 ! 227 #if defined key_bdy 228 ! OPEN Lateral boundary conditions 229 IF( nb_trcobc > 0 ) THEN 230 ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), nbmap_ptr(nb_trcobc), STAT=ierr1 ) 231 IF( ierr1 > 0 ) THEN 232 CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' ) ; RETURN 233 ENDIF 234 235 igrd = 1 ! Everything is at T-points here 236 147 237 DO jn = 1, ntrc 148 IF( ln_trc_obc(jn) ) THEN 149 clndta = TRIM( sn_trcobc(jn)%clvar ) 150 IF(lwp) WRITE(numout,*) 'Preparing to read OBC data file for passive tracer number :', jn, ' name : ', clndta, & 151 & ' multiplicative factor : ', rn_trofac(jn) 152 ENDIF 153 IF( ln_trc_sbc(jn) ) THEN 154 clndta = TRIM( sn_trcsbc(jn)%clvar ) 155 IF(lwp) WRITE(numout,*) 'Preparing to read SBC data file for passive tracer number :', jn, ' name : ', clndta, & 156 & ' multiplicative factor : ', rn_trsfac(jn) 157 ENDIF 158 IF( ln_trc_cbc(jn) ) THEN 159 clndta = TRIM( sn_trccbc(jn)%clvar ) 160 IF(lwp) WRITE(numout,*) 'Preparing to read CBC data file for passive tracer number :', jn, ' name : ', clndta, & 161 & ' multiplicative factor : ', rn_trcfac(jn) 162 ENDIF 163 END DO 164 ENDIF 165 ! 166 ! The following code is written this way to reduce memory usage and repeated for each boundary data 167 ! MAV: note that this is just a placeholder and the dimensions must be changed according to 168 ! what will be done with BDY. A new structure will probably need to be included 169 ! 170 ! OPEN Lateral boundary conditions 171 IF( nb_trcobc > 0 ) THEN ! allocate only if the number of tracer to initialise is greater than zero 172 ALLOCATE( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), STAT=ierr1 ) 173 IF( ierr1 > 0 ) THEN 174 CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' ) ; RETURN 175 ENDIF 176 ! 177 DO jn = 1, ntrc 178 IF( ln_trc_obc(jn) ) THEN ! update passive tracers arrays with input data read from file 179 jl = n_trc_indobc(jn) 180 slf_i(jl) = sn_trcobc(jn) 181 rf_trofac(jl) = rn_trofac(jn) 182 ALLOCATE( sf_trcobc(jl)%fnow(jpi,jpj,jpk) , STAT=ierr2 ) 183 IF( sn_trcobc(jn)%ln_tint ) ALLOCATE( sf_trcobc(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 184 IF( ierr2 + ierr3 > 0 ) THEN 185 CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' ) ; RETURN 238 DO ib = 1, nb_bdy 239 240 nblen = idx_bdy(ib)%nblen(igrd) 241 242 IF ( ln_trc_obc(jn) ) THEN 243 ! Initialise from external data 244 jl = n_trc_indobc(jn) 245 slf_i(jl) = sn_trcobc(jn) 246 rf_trofac(jl) = rn_trofac(jn) 247 ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk) , STAT=ierr2 ) 248 IF( sn_trcobc(jn)%ln_tint ) ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 249 IF( ierr2 + ierr3 > 0 ) THEN 250 CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' ) ; RETURN 251 ENDIF 252 trcdta_bdy(jn,ib)%trc => sf_trcobc(jl)%fnow(:,1,:) 253 trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl) 254 ! create OBC mapping array 255 nbmap_ptr(jl)%ptr => idx_bdy(ib)%nbmap(:,igrd) 256 nbmap_ptr(jl)%ll_unstruc = ln_coords_file(igrd) 257 ELSE 258 ! Initialise obc arrays from initial conditions 259 ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 260 DO ibd = 1, nblen 261 DO ik = 1, jpkm1 262 ii = idx_bdy(ib)%nbi(ibd,igrd) 263 ij = idx_bdy(ib)%nbj(ibd,igrd) 264 trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 265 END DO 266 END DO 267 trcdta_bdy(jn,ib)%rn_fac = 1._wp 186 268 ENDIF 187 ENDIF 188 ! 269 ENDDO 189 270 ENDDO 190 ! ! fill sf_trcdta with slf_i and control print 191 CALL fld_fill( sf_trcobc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 192 ! 193 ENDIF 194 ! 271 272 CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 273 ENDIF 274 #endif 195 275 ! SURFACE Boundary conditions 196 276 IF( nb_trcsbc > 0 ) THEN ! allocate only if the number of tracer to initialise is greater than zero … … 214 294 ENDDO 215 295 ! ! fill sf_trcsbc with slf_i and control print 216 CALL fld_fill( sf_trcsbc, slf_i, cn_dir , 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' )296 CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 217 297 ! 218 298 ENDIF … … 239 319 ENDDO 240 320 ! ! fill sf_trccbc with slf_i and control print 241 CALL fld_fill( sf_trccbc, slf_i, cn_dir , 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' )321 CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 242 322 ! 243 323 ENDIF 244 324 ! 245 325 DEALLOCATE( slf_i ) ! deallocate local field structure 246 326 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_init') 247 327 ! 248 328 END SUBROUTINE trc_bc_init 249 329 250 330 251 SUBROUTINE trc_bc_read(kt )331 SUBROUTINE trc_bc_read(kt, jit) 252 332 !!---------------------------------------------------------------------- 253 333 !! *** ROUTINE trc_bc_init *** … … 258 338 !! 259 339 !!---------------------------------------------------------------------- 260 261 ! NEMO262 340 USE fldread 263 341 264 342 !! * Arguments 265 343 INTEGER, INTENT( in ) :: kt ! ocean time-step index 266 344 INTEGER, INTENT( in ), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option) 267 345 !!--------------------------------------------------------------------- 268 346 ! 269 347 IF( nn_timing == 1 ) CALL timing_start('trc_bc_read') 270 348 271 IF( kt == nit000 ) THEN 272 IF(lwp) WRITE(numout,*) 273 IF(lwp) WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 274 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 275 ENDIF 276 277 ! OPEN boundary conditions: DOES NOT WORK. Waiting for stable BDY 278 IF( nb_trcobc > 0 ) THEN 279 if (lwp) write(numout,'(a,i5,a,i5)') ' reading OBC data for ', nb_trcobc ,' variables at step ', kt 280 CALL fld_read(kt,1,sf_trcobc) 281 ! vertical interpolation on s-grid and partial step to be added 282 ENDIF 283 284 ! SURFACE boundary conditions 285 IF( nb_trcsbc > 0 ) THEN 286 if (lwp) write(numout,'(a,i5,a,i5)') ' reading SBC data for ', nb_trcsbc ,' variables at step ', kt 287 CALL fld_read(kt,1,sf_trcsbc) 288 ENDIF 289 290 ! COASTAL boundary conditions 291 IF( nb_trccbc > 0 ) THEN 292 if (lwp) write(numout,'(a,i5,a,i5)') ' reading CBC data for ', nb_trccbc ,' variables at step ', kt 293 CALL fld_read(kt,1,sf_trccbc) 294 ENDIF 349 IF( kt == nit000 .AND. lwp) THEN 350 WRITE(numout,*) 351 WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 352 WRITE(numout,*) '~~~~~~~~~~~ ' 353 ENDIF 354 355 IF ( PRESENT(jit) ) THEN 356 357 ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 358 IF( nb_trcobc > 0 ) THEN 359 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 360 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1) 361 ENDIF 362 363 ! SURFACE boundary conditions 364 IF( nb_trcsbc > 0 ) THEN 365 if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 366 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 367 ENDIF 368 369 ! COASTAL boundary conditions 370 IF( nb_trccbc > 0 ) THEN 371 if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 372 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 373 ENDIF 374 375 ELSE 376 377 ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 378 IF( nb_trcobc > 0 ) THEN 379 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 380 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1) 381 ENDIF 382 383 ! SURFACE boundary conditions 384 IF( nb_trcsbc > 0 ) THEN 385 if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 386 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc) 387 ENDIF 388 389 ! COASTAL boundary conditions 390 IF( nb_trccbc > 0 ) THEN 391 if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 392 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc) 393 ENDIF 394 395 ENDIF 396 295 397 ! 296 398 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_read') 297 ! 298 399 ! 299 400 END SUBROUTINE trc_bc_read 401 300 402 #else 301 403 !!---------------------------------------------------------------------- … … 303 405 !!---------------------------------------------------------------------- 304 406 CONTAINS 407 408 SUBROUTINE trc_bc_init( ntrc ) ! Empty routine 409 INTEGER,INTENT(IN) :: ntrc ! number of tracers 410 WRITE(*,*) 'trc_bc_init: You should not have seen this print! error?', kt 411 END SUBROUTINE trc_bc_init 412 305 413 SUBROUTINE trc_bc_read( kt ) ! Empty routine 306 414 WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt -
trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
r5836 r6140 106 106 CHARACTER (len=20) :: cltra, cltrau 107 107 CHARACTER (len=80) :: cltral 108 REAL(wp) :: zsto, zout , zdt108 REAL(wp) :: zsto, zout 109 109 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 110 110 !!---------------------------------------------------------------------- … … 118 118 119 119 ! Define frequency of output and means 120 zdt = rdt121 120 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 122 121 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) … … 126 125 clop = "inst("//TRIM(clop)//")" 127 126 # else 128 zsto = zdt127 zsto = rdt 129 128 clop = "ave("//TRIM(clop)//")" 130 129 # endif 131 zout = nn_writetrc * zdt130 zout = nn_writetrc * rdt 132 131 133 132 ! Define indices of the horizontal output zoom and vertical limit storage … … 182 181 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 183 182 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 184 & iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set)183 & iiter, zjulian, rdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set) 185 184 186 185 ! Vertical grid for tracer : gdept … … 250 249 INTEGER :: jl 251 250 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 252 REAL(wp) :: zsto, zout , zdt251 REAL(wp) :: zsto, zout 253 252 !!---------------------------------------------------------------------- 254 253 … … 261 260 ! 262 261 ! Define frequency of output and means 263 zdt = rdt264 262 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 265 263 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) 266 264 ENDIF 267 265 # if defined key_diainstant 268 zsto = nn_writedia * zdt266 zsto = nn_writedia * rdt 269 267 clop = "inst("//TRIM(clop)//")" 270 268 # else 271 zsto = zdt269 zsto = rdt 272 270 clop = "ave("//TRIM(clop)//")" 273 271 # endif 274 zout = nn_writedia * zdt272 zout = nn_writedia * rdt 275 273 276 274 ! Define indices of the horizontal output zoom and vertical limit storage … … 302 300 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 303 301 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 304 & iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set )302 & iiter, zjulian, rdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set ) 305 303 306 304 ! Vertical grid for 2d and 3d arrays … … 387 385 INTEGER :: ji, jj, jk, jl 388 386 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 389 REAL(wp) :: zsto, zout , zdt387 REAL(wp) :: zsto, zout 390 388 !!---------------------------------------------------------------------- 391 389 … … 398 396 399 397 ! Define frequency of output and means 400 zdt = rdt401 398 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 402 399 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) 403 400 ENDIF 404 401 # if defined key_diainstant 405 zsto = nn_writebio * zdt402 zsto = nn_writebio * rdt 406 403 clop = "inst("//TRIM(clop)//")" 407 404 # else 408 zsto = zdt405 zsto = rdt 409 406 clop = "ave("//TRIM(clop)//")" 410 407 # endif 411 zout = nn_writebio * zdt408 zout = nn_writebio * rdt 412 409 413 410 ! Define indices of the horizontal output zoom and vertical limit storage … … 435 432 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 436 433 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 437 & iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set )434 & iiter, zjulian, rdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set ) 438 435 ! Vertical grid for biological trends 439 436 CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_1d, ndepitb) -
trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r5385 r6140 9 9 !! 3.4 ! 2010-11 (C. Ethe, G. Madec) use of fldread + dynamical allocation 10 10 !! 3.5 ! 2013-08 (M. Vichi) generalization for other BGC models 11 !!---------------------------------------------------------------------- 12 #if defined key_top 11 !! 3.6 ! 2015-03 (T. Lovato) revision of code log info 12 !!---------------------------------------------------------------------- 13 #if defined key_top 13 14 !!---------------------------------------------------------------------- 14 15 !! 'key_top' TOP model … … 36 37 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read) 37 38 !$AGRIF_END_DO_NOT_TREAT 38 !! * Substitutions 39 # include "domzgr_substitute.h90" 39 40 40 !!---------------------------------------------------------------------- 41 41 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 72 72 IF( nn_timing == 1 ) CALL timing_start('trc_dta_init') 73 73 ! 74 IF( lwp ) THEN 75 WRITE(numout,*) ' ' 76 WRITE(numout,*) ' trc_dta_init : Tracers Initial Conditions (IC)' 77 WRITE(numout,*) ' ~~~~~~~~~~~ ' 78 ENDIF 79 ! 74 80 ! Initialisation 75 81 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 … … 77 83 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 78 84 IF( ierr0 > 0 ) THEN 79 CALL ctl_stop( 'trc_ nam: unable to allocate n_trc_index' ) ; RETURN85 CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' ) ; RETURN 80 86 ENDIF 81 87 nb_trcdta = 0 … … 97 103 REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer input data 98 104 READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 99 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp )105 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in reference namelist', lwp ) 100 106 101 107 REWIND( numnat_cfg ) ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 102 108 READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 103 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp )109 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp ) 104 110 IF(lwm) WRITE ( numont, namtrc_dta ) 105 111 … … 109 115 clndta = TRIM( sn_trcdta(jn)%clvar ) 110 116 clntrc = TRIM( ctrcnm (jn) ) 117 if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra 111 118 zfact = rn_trfac(jn) 112 119 IF( clndta /= clntrc ) THEN 113 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :', &114 & ' the variable name in the data file : '//clndta// &115 & ' must be the same than the name of the passive tracer : '//clntrc//' ')120 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation ', & 121 & 'Input name of data file : '//TRIM(clndta)// & 122 & ' differs from that of tracer : '//TRIM(clntrc)//' ') 116 123 ENDIF 117 WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, & 118 & ' multiplicative factor : ', zfact 124 WRITE(numout,*) ' ' 125 WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', & 126 & jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 119 127 ENDIF 120 128 END DO … … 124 132 ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 125 133 IF( ierr1 > 0 ) THEN 126 CALL ctl_stop( 'trc_dta_ini : unable to allocate sf_trcdta structure' ) ; RETURN134 CALL ctl_stop( 'trc_dta_init: unable to allocate sf_trcdta structure' ) ; RETURN 127 135 ENDIF 128 136 ! … … 135 143 IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 136 144 IF( ierr2 + ierr3 > 0 ) THEN 137 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' ) ; RETURN145 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' ) ; RETURN 138 146 ENDIF 139 147 ENDIF … … 141 149 ENDDO 142 150 ! ! fill sf_trcdta with slf_i and control print 143 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta ', 'Passive tracer data', 'namtrc' )151 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 144 152 ! 145 153 ENDIF … … 189 197 DO ji = 1, jpi 190 198 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 191 zl = fsdept_n(ji,jj,jk)199 zl = gdept_n(ji,jj,jk) 192 200 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 193 201 ztp(jk) = sf_dta(1)%fnow(ji,jj,1) … … 220 228 ik = mbkt(ji,jj) 221 229 IF( ik > 1 ) THEN 222 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )230 zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 223 231 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1) 224 ENDIF225 ik = mikt(ji,jj)226 IF( ik > 1 ) THEN227 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )228 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1)229 232 ENDIF 230 233 END DO … … 236 239 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac ! multiplicative factor 237 240 ! 238 IF( lwp .AND. kt == nit000 ) THEN239 clndta = TRIM( sf_dta(1)%clvar )240 WRITE(numout,*) ''//clndta//' data '241 WRITE(numout,*)242 WRITE(numout,*)' level = 1'243 CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )244 WRITE(numout,*)' level = ', jpk/2245 CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )246 WRITE(numout,*)' level = ', jpkm1247 CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )248 WRITE(numout,*)249 ENDIF250 241 ENDIF 251 242 ! … … 253 244 ! 254 245 END SUBROUTINE trc_dta 246 255 247 #else 256 248 !!---------------------------------------------------------------------- … … 262 254 END SUBROUTINE trc_dta 263 255 #endif 256 264 257 !!====================================================================== 265 258 END MODULE trcdta -
trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r5836 r6140 26 26 USE sbc_oce 27 27 USE trcice ! tracers in sea ice 28 USE trcbc, only : trc_bc_init ! generalized Boundary Conditions 28 29 29 30 IMPLICIT NONE … … 32 33 PUBLIC trc_init ! called by opa 33 34 34 !! * Substitutions35 # include "domzgr_substitute.h90"36 35 !!---------------------------------------------------------------------- 37 36 !! NEMO/TOP 4.0 , NEMO Consortium (2011) … … 119 118 ! ! masked grid volume 120 119 DO jk = 1, jpk 121 cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)120 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 122 121 END DO 123 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)! degrad option: reduction by facvol122 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:) ! degrad option: reduction by facvol 124 123 ! ! total volume of the ocean 125 124 areatot = glob_sum( cvol(:,:,:) ) … … 208 207 !!---------------------------------------------------------------------- 209 208 ! 209 ! Initialisation of tracers Initial Conditions 210 210 IF( ln_trcdta ) CALL trc_dta_init(jptra) 211 212 ! Initialisation of tracers Boundary Conditions 213 IF( lk_my_trc ) CALL trc_bc_init(jptra) 211 214 212 215 IF( ln_rsttr ) THEN … … 246 249 END SUBROUTINE trc_ini_state 247 250 248 249 251 SUBROUTINE top_alloc 250 252 !!---------------------------------------------------------------------- … … 253 255 !! ** Purpose : Allocate all the dynamic arrays of the OPA modules 254 256 !!---------------------------------------------------------------------- 255 USE trcadv , ONLY: trc_adv_alloc ! TOP-related alloc routines...256 257 USE trc , ONLY: trc_alloc 257 USE trcnxt , ONLY: trc_nxt_alloc258 USE trczdf , ONLY: trc_zdf_alloc259 258 USE trdtrc_oce , ONLY: trd_trc_oce_alloc 260 259 #if defined key_trdmxl_trc … … 265 264 !!---------------------------------------------------------------------- 266 265 ! 267 ierr = trc_adv_alloc() ! Start of TOP-related alloc routines... 268 ierr = ierr + trc_alloc () 269 ierr = ierr + trc_nxt_alloc() 270 ierr = ierr + trc_zdf_alloc() 266 ierr = trc_alloc() 271 267 ierr = ierr + trd_trc_oce_alloc() 272 268 #if defined key_trdmxl_trc -
trunk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r5836 r6140 98 98 99 99 100 rdttrc (:) = rdttra(:) * FLOAT( nn_dttrc ) ! vertical profile ofpassive tracer time-step100 rdttrc = rdt * FLOAT( nn_dttrc ) ! passive tracer time-step 101 101 102 102 IF(lwp) THEN ! control print 103 103 WRITE(numout,*) 104 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc (1)104 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc 105 105 WRITE(numout,*) 106 106 ENDIF … … 173 173 !!--------------------------------------------------------------------- 174 174 ! 175 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'175 IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 176 176 IF(lwp) WRITE(numout,*) '~~~~~~~' 177 177 … … 271 271 TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput 272 272 !! 273 NAMELIST/namtrc/ sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo273 NAMELIST/namtrc/ sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo 274 274 !!--------------------------------------------------------------------- 275 275 IF(lwp) WRITE(numout,*) 276 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'276 IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 277 277 IF(lwp) WRITE(numout,*) '~~~~~~~' 278 278 … … 291 291 ctrcun (jn) = TRIM( sn_tracer(jn)%clunit ) 292 292 ln_trc_ini(jn) = sn_tracer(jn)%llinit 293 #if defined key_my_trc 294 ln_trc_sbc(jn) = sn_tracer(jn)%llsbc 295 ln_trc_cbc(jn) = sn_tracer(jn)%llcbc 296 ln_trc_obc(jn) = sn_tracer(jn)%llobc 297 #endif 293 298 ln_trc_wri(jn) = sn_tracer(jn)%llsave 294 299 END DO … … 317 322 NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 318 323 !!--------------------------------------------------------------------- 319 320 IF(lwp) WRITE(numout,*)321 IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options'322 IF(lwp) WRITE(numout,*) '~~~~~~~'323 324 324 325 IF(lwp) WRITE(numout,*) -
trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r5836 r6140 14 14 !!---------------------------------------------------------------------- 15 15 !!---------------------------------------------------------------------- 16 !! trc_rst : Restart for passive tracer 17 !!---------------------------------------------------------------------- 18 !!---------------------------------------------------------------------- 19 !! 'key_top' TOP models 20 !!---------------------------------------------------------------------- 16 !! trc_rst : Restart for passive tracer 21 17 !! trc_rst_opn : open restart file 22 18 !! trc_rst_read : read restart file … … 27 23 USE iom 28 24 USE daymod 25 29 26 IMPLICIT NONE 30 27 PRIVATE … … 35 32 PUBLIC trc_rst_cal 36 33 37 !! * Substitutions 38 # include "domzgr_substitute.h90" 39 34 !!---------------------------------------------------------------------- 35 !! NEMO/TOP 3.7 , NEMO Consortium (2010) 36 !! $Id$ 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 !!---------------------------------------------------------------------- 40 39 CONTAINS 41 40 … … 131 130 !!---------------------------------------------------------------------- 132 131 ! 133 CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc (1) ) ! surfacepassive tracer time step132 CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc ) ! passive tracer time step 134 133 ! prognostic variables 135 134 ! -------------------- … … 199 198 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 200 199 201 IF ( jprstlib == jprstdimg ) THEN202 ! eventually read netcdf file (monobloc) for restarting on different number of processors203 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90204 INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )205 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF206 ENDIF207 208 200 IF( ln_rsttr ) THEN 209 201 CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt ) … … 235 227 ELSE 236 228 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam 237 adatrj = ( REAL( nittrc000-1, wp ) * rdt tra(1)) / rday229 adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday 238 230 ! note this is wrong if time step has changed during run 239 231 ENDIF … … 288 280 ! 289 281 DO jk = 1, jpk 290 zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)282 zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 291 283 END DO 292 284 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r5407 r6140 36 36 LOGICAL :: llnew 37 37 38 !! * Substitutions39 # include "domzgr_substitute.h90"40 38 !!---------------------------------------------------------------------- 41 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 66 64 IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer 67 65 ! 68 IF( lk_vvl ) THEN! update ocean volume due to ssh temporal evolution66 IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution 69 67 DO jk = 1, jpk 70 cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)68 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 71 69 END DO 72 70 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:) ! degrad option: reduction by facvol … … 116 114 END SUBROUTINE trc_stp 117 115 116 118 117 SUBROUTINE trc_mean_qsr( kt ) 119 118 !!---------------------------------------------------------------------- … … 130 129 INTEGER, INTENT(in) :: kt 131 130 INTEGER :: jn 132 131 !!---------------------------------------------------------------------- 132 ! 133 133 IF( kt == nittrc000 ) THEN 134 134 IF( ln_cpl ) THEN … … 165 165 DO jn = 1, nb_rec_per_days - 1 166 166 qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 167 END DO167 END DO 168 168 qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 169 169 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days -
trunk/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r5930 r6140 40 40 PUBLIC trc_sub_ssh ! called by trc_stp to reset physics variables 41 41 42 !!* Module variables43 42 REAL(wp) :: r1_ndttrc ! 1 / nn_dttrc 44 43 REAL(wp) :: r1_ndttrcp1 ! 1 / (nn_dttrc+1) … … 48 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm , vslp_tm , wslpi_tm , wslpj_tm !: time mean 49 48 50 !! * Substitutions51 # include "domzgr_substitute.h90"52 49 !!---------------------------------------------------------------------- 53 50 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 88 85 IF( MOD( kt , nn_dttrc ) /= 0 ) THEN 89 86 ! 90 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)91 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)92 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)93 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)94 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)95 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)96 # if defined key_zdfddm 97 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)87 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * e3u_n(:,:,:) 88 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * e3v_n(:,:,:) 89 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * e3t_n(:,:,:) 90 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 91 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * e3t_n(:,:,:) 92 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * e3w_n(:,:,:) 93 # if defined key_zdfddm 94 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * e3w_n(:,:,:) 98 95 # endif 99 96 IF( l_ldfslp ) THEN … … 165 162 ! 166 163 ! 2. Create averages and reassign variables 167 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)168 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)169 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)170 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)171 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)172 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)173 # if defined key_zdfddm 174 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)164 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * e3u_n(:,:,:) 165 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * e3v_n(:,:,:) 166 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * e3t_n(:,:,:) 167 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 168 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * e3t_n(:,:,:) 169 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * e3w_n(:,:,:) 170 # if defined key_zdfddm 171 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * e3w_n(:,:,:) 175 172 # endif 176 173 IF( l_ldfslp ) THEN … … 244 241 DO jj = 1, jpj 245 242 DO ji = 1, jpi 246 z1_ne3t = r1_ndttrcp1 / fse3t(ji,jj,jk)247 z1_ne3u = r1_ndttrcp1 / fse3u(ji,jj,jk)248 z1_ne3v = r1_ndttrcp1 / fse3v(ji,jj,jk)249 z1_ne3w = r1_ndttrcp1 / fse3w(ji,jj,jk)243 z1_ne3t = r1_ndttrcp1 / e3t_n(ji,jj,jk) 244 z1_ne3u = r1_ndttrcp1 / e3u_n(ji,jj,jk) 245 z1_ne3v = r1_ndttrcp1 / e3v_n(ji,jj,jk) 246 z1_ne3w = r1_ndttrcp1 / e3w_n(ji,jj,jk) 250 247 ! 251 248 un (ji,jj,jk) = un_tm (ji,jj,jk) * z1_ne3u … … 300 297 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' ) 301 298 302 un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:)303 vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:)304 tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:)305 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:)306 rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:)299 un_tm (:,:,:) = un (:,:,:) * e3u_n(:,:,:) 300 vn_tm (:,:,:) = vn (:,:,:) * e3v_n(:,:,:) 301 tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * e3t_n(:,:,:) 302 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 303 rhop_tm (:,:,:) = rhop (:,:,:) * e3t_n(:,:,:) 307 304 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 308 avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:)309 # if defined key_zdfddm 310 avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:)305 avt_tm (:,:,:) = avt (:,:,:) * e3w_n(:,:,:) 306 # if defined key_zdfddm 307 avs_tm (:,:,:) = avs (:,:,:) * e3w_n(:,:,:) 311 308 # endif 312 309 IF( l_ldfslp ) THEN … … 400 397 ! 401 398 ! Start new averages 402 un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:)403 vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:)404 tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:)405 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:)406 rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:)407 avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:)408 # if defined key_zdfddm 409 avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:)399 un_tm (:,:,:) = un (:,:,:) * e3u_n(:,:,:) 400 vn_tm (:,:,:) = vn (:,:,:) * e3v_n(:,:,:) 401 tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * e3t_n(:,:,:) 402 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 403 rhop_tm (:,:,:) = rhop (:,:,:) * e3t_n(:,:,:) 404 avt_tm (:,:,:) = avt (:,:,:) * e3w_n(:,:,:) 405 # if defined key_zdfddm 406 avs_tm (:,:,:) = avs (:,:,:) * e3w_n(:,:,:) 410 407 # endif 411 408 IF( l_ldfslp ) THEN … … 449 446 !! 450 447 !! ** Purpose : compute the after ssh (ssha), the now vertical velocity 451 !! and update the now vertical coordinate (l k_vvl=T).448 !! and update the now vertical coordinate (ln_linssh=F). 452 449 !! 453 450 !! ** Method : - Using the incompressibility hypothesis, the vertical … … 458 455 !! ** action : ssha : after sea surface height 459 456 !! wn : now vertical velocity 460 !! sshu_a, sshv_a, sshf_a : after sea surface height (l k_vvl=T)457 !! sshu_a, sshv_a, sshf_a : after sea surface height (ln_linssh=F) 461 458 !! 462 459 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. 463 460 !!---------------------------------------------------------------------- 464 !465 461 INTEGER, INTENT(in) :: kt ! time step 466 462 ! … … 473 469 ! 474 470 ! Allocate temporary workspace 475 CALL wrk_alloc( jpi, jpj,zhdiv )471 CALL wrk_alloc( jpi,jpj, zhdiv ) 476 472 477 473 IF( kt == nittrc000 ) THEN … … 485 481 ENDIF 486 482 ! 483 !!gm BUG here ! hdivn will include the runoff divergence at the wrong timestep !!!! 487 484 CALL div_hor( kt ) ! Horizontal divergence & Relative vorticity 488 485 ! … … 495 492 zhdiv(:,:) = 0._wp 496 493 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 497 zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)494 zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 498 495 END DO 499 496 ! ! Sea surface elevation time stepping … … 502 499 z1_rau0 = 0.5 / rau0 503 500 ssha(:,:) = ( sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * tmask(:,:,1) 504 501 #if ! defined key_dynspg_ts 505 502 ! These lines are not necessary with time splitting since 506 503 ! boundary condition on sea level is set during ts loop … … 512 509 CALL lbc_lnk( ssha, 'T', 1. ) 513 510 #endif 514 511 #endif 512 ! 515 513 ! !------------------------------! 516 514 ! ! Now Vertical Velocity ! … … 518 516 z1_2dt = 1.e0 / z2dt 519 517 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 520 ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise521 wn(:,:,jk) = wn(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) &522 & - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) &518 ! - ML - need 3 lines here because replacement of e3t by its expression yields too long lines otherwise 519 wn(:,:,jk) = wn(:,:,jk+1) - e3t_n(:,:,jk) * hdivn(:,:,jk) & 520 & - ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) & 523 521 & * tmask(:,:,jk) * z1_2dt 524 522 #if defined key_bdy … … 526 524 #endif 527 525 END DO 528 529 ! 530 CALL wrk_dealloc( jpi, jpj, zhdiv ) 526 ! 527 CALL wrk_dealloc( jpi,jpj, zhdiv ) 531 528 ! 532 529 IF( nn_timing == 1 ) CALL timing_stop('trc_sub_ssh') 533 530 ! 534 531 END SUBROUTINE trc_sub_ssh 532 535 533 536 534 INTEGER FUNCTION trc_sub_alloc() … … 598 596 WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt 599 597 END SUBROUTINE trc_sub_ini 600 601 598 #endif 602 599
Note: See TracChangeset
for help on using the changeset viewer.