- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- Location:
- branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 6 deleted
- 72 edited
- 10 copied
-
C14b/trcice_c14b.F90 (copied) (copied from trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcice_c14b.F90)
-
C14b/trcsms_c14b.F90 (modified) (4 diffs)
-
C14b/trcwri_c14b.F90 (modified) (3 diffs)
-
CFC/trcice_cfc.F90 (copied) (copied from trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90)
-
CFC/trcsms_cfc.F90 (modified) (5 diffs)
-
CFC/trcwri_cfc.F90 (modified) (3 diffs)
-
MY_TRC/trcice_my_trc.F90 (copied) (copied from trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90)
-
MY_TRC/trcini_my_trc.F90 (modified) (1 diff)
-
MY_TRC/trcsms_my_trc.F90 (modified) (3 diffs)
-
MY_TRC/trcwri_my_trc.F90 (modified) (3 diffs)
-
PISCES/P2Z/p2zbio.F90 (modified) (13 diffs, 1 prop)
-
PISCES/P2Z/p2zexp.F90 (modified) (8 diffs, 1 prop)
-
PISCES/P2Z/p2zopt.F90 (modified) (6 diffs, 1 prop)
-
PISCES/P2Z/p2zsed.F90 (modified) (5 diffs, 1 prop)
-
PISCES/P2Z/p2zsms.F90 (modified) (4 diffs, 1 prop)
-
PISCES/P4Z/p4zbio.F90 (modified) (5 diffs)
-
PISCES/P4Z/p4zche.F90 (modified) (5 diffs, 1 prop)
-
PISCES/P4Z/p4zfechem.F90 (modified) (17 diffs)
-
PISCES/P4Z/p4zflx.F90 (modified) (11 diffs, 1 prop)
-
PISCES/P4Z/p4zint.F90 (modified) (3 diffs, 1 prop)
-
PISCES/P4Z/p4zlim.F90 (modified) (9 diffs)
-
PISCES/P4Z/p4zlys.F90 (modified) (7 diffs)
-
PISCES/P4Z/p4zmeso.F90 (modified) (18 diffs)
-
PISCES/P4Z/p4zmicro.F90 (modified) (15 diffs)
-
PISCES/P4Z/p4zmort.F90 (modified) (9 diffs, 1 prop)
-
PISCES/P4Z/p4zopt.F90 (modified) (15 diffs)
-
PISCES/P4Z/p4zprod.F90 (modified) (18 diffs)
-
PISCES/P4Z/p4zrem.F90 (modified) (13 diffs)
-
PISCES/P4Z/p4zsbc.F90 (modified) (15 diffs, 1 prop)
-
PISCES/P4Z/p4zsed.F90 (modified) (22 diffs, 1 prop)
-
PISCES/P4Z/p4zsink.F90 (modified) (34 diffs)
-
PISCES/P4Z/p4zsms.F90 (modified) (17 diffs)
-
PISCES/SED/par_sed.F90 (modified) (1 diff, 1 prop)
-
PISCES/SED/sed.F90 (modified) (1 diff, 1 prop)
-
PISCES/SED/sedadv.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/sedarr.F90 (modified) (1 diff, 1 prop)
-
PISCES/SED/sedbtb.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/sedchem.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/sedco3.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/seddsr.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/seddta.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/sedini.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/sedmat.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/sedmbc.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/sedmodel.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/sedrst.F90 (modified) (3 diffs, 1 prop)
-
PISCES/SED/sedsfc.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/sedstp.F90 (modified) (2 diffs, 1 prop)
-
PISCES/SED/sedwri.F90 (modified) (2 diffs, 1 prop)
-
PISCES/par_pisces.F90 (modified) (3 diffs)
-
PISCES/sms_pisces.F90 (modified) (5 diffs)
-
PISCES/trcice_pisces.F90 (copied) (copied from trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90)
-
PISCES/trcini_pisces.F90 (modified) (4 diffs)
-
PISCES/trcnam_pisces.F90 (modified) (2 diffs)
-
PISCES/trcwri_pisces.F90 (modified) (3 diffs)
-
TRP/trcadv.F90 (modified) (5 diffs)
-
TRP/trcbbl.F90 (modified) (2 diffs)
-
TRP/trcdmp.F90 (modified) (12 diffs)
-
TRP/trcldf.F90 (modified) (6 diffs)
-
TRP/trcnam_trp.F90 (deleted)
-
TRP/trcnxt.F90 (modified) (5 diffs)
-
TRP/trcrad.F90 (modified) (5 diffs)
-
TRP/trcsbc.F90 (modified) (7 diffs)
-
TRP/trctrp.F90 (modified) (7 diffs)
-
TRP/trczdf.F90 (modified) (7 diffs)
-
TRP/trdmld_trc.F90 (deleted)
-
TRP/trdmld_trc_rst.F90 (deleted)
-
TRP/trdmod_trc.F90 (deleted)
-
TRP/trdmod_trc_oce.F90 (deleted)
-
TRP/trdmxl_trc.F90 (copied) (copied from trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90)
-
TRP/trdmxl_trc_rst.F90 (copied) (copied from trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90)
-
TRP/trdtrc.F90 (copied) (copied from trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90)
-
TRP/trdtrc_oce.F90 (copied) (copied from trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90)
-
oce_trc.F90 (modified) (7 diffs)
-
top_substitute.h90 (deleted)
-
trc.F90 (modified) (9 diffs)
-
trcbc.F90 (modified) (11 diffs, 1 prop)
-
trcbdy.F90 (copied) (copied from trunk/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90)
-
trcdia.F90 (modified) (11 diffs)
-
trcdta.F90 (modified) (14 diffs)
-
trcice.F90 (copied) (copied from trunk/NEMOGCM/NEMO/TOP_SRC/trcice.F90)
-
trcini.F90 (modified) (8 diffs)
-
trcnam.F90 (modified) (13 diffs)
-
trcrst.F90 (modified) (13 diffs)
-
trcsms.F90 (modified) (1 diff)
-
trcstp.F90 (modified) (5 diffs)
-
trcsub.F90 (modified) (23 diffs, 1 prop)
-
trcwri.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r3680 r6225 18 18 USE par_trc ! TOP parameters 19 19 USE trc ! TOP variables 20 USE trd mod_oce21 USE trd mod_trc20 USE trd_oce 21 USE trdtrc 22 22 USE iom ! I/O library 23 23 … … 49 49 REAL(wp) :: xconv3 = 1.e+3_wp ! conversion from mol/l/atm to mol/m3/atm 50 50 51 !! * Substitutions52 # include "top_substitute.h90"53 54 51 !!---------------------------------------------------------------------- 55 52 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 56 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp$53 !! $Id$ 57 54 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 58 55 !!---------------------------------------------------------------------- … … 258 255 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2. 259 256 ! Add the surface flux to the trend 260 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) 261 258 262 259 ! cumulation of surface flux at each time step … … 290 287 ENDIF 291 288 ! 292 IF( l n_diatrc) THEN293 IF( lk_iomput ) THEN294 CALL iom_put( "qtrC14b" , qtr_c14)295 CALL iom_put( "qintC14b" , qint_c14)296 CALL iom_put( "fdecay" , zdecay )297 ELSE289 IF( lk_iomput ) THEN 290 CALL iom_put( "qtrC14b" , qtr_c14 ) 291 CALL iom_put( "qintC14b" , qint_c14 ) 292 CALL iom_put( "fdecay" , zdecay ) 293 ELSE 294 IF( ln_diatrc ) THEN 298 295 trc2d(:,: ,jp_c14b0_2d ) = qtr_c14 (:,:) 299 296 trc2d(:,: ,jp_c14b0_2d + 1 ) = qint_c14(:,:) 300 297 trc3d(:,:,:,jp_c14b0_3d ) = zdecay (:,:,:) 301 302 ENDIF 303 304 IF( l_trdtrc ) CALL trd_ mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt ) ! save trends298 ENDIF 299 ENDIF 300 301 IF( l_trdtrc ) CALL trd_trc( tra(:,:,:,jpc14), jpc14, jptra_sms, kt ) ! save trends 305 302 306 303 CALL wrk_dealloc( jpi, jpj, zatmbc14 ) -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90
r4305 r6225 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 7 !!---------------------------------------------------------------------- 8 #if defined key_top && key_c14b && defined key_iomput8 #if defined key_top && defined key_c14b && defined key_iomput 9 9 !!---------------------------------------------------------------------- 10 10 !! 'key_c14b' c14b model … … 20 20 PUBLIC trc_wri_c14b 21 21 22 # include "top_substitute.h90"23 22 CONTAINS 24 23 … … 37 36 DO jn = jp_c14b0, jp_c14b1 38 37 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 39 IF( lk_vvl ) THEN 40 CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) ) 41 ELSE 42 CALL iom_put( cltra, trn(:,:,:,jn) ) 43 ENDIF 38 CALL iom_put( cltra, trn(:,:,:,jn) ) 44 39 END DO 45 40 ! -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r3680 r6225 18 18 USE par_trc ! TOP parameters 19 19 USE trc ! TOP variables 20 USE trd mod_oce21 USE trd mod_trc20 USE trd_oce 21 USE trdtrc 22 22 USE iom ! I/O library 23 23 … … 50 50 REAL(wp) :: xconv4 = 1.0e-12 ! conversion from mol/m3/atm to mol/m3/pptv 51 51 52 !! * Substitutions53 # include "top_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 … … 185 182 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 186 183 END DO 187 ENDIF 188 ! 189 IF( ln_diatrc ) THEN 190 ! 191 IF( lk_iomput ) THEN 192 CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 193 CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 194 ELSE 195 trc2d(:,:,jp_cfc0_2d ) = qtr_cfc (:,:,1) 196 trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 197 END IF 198 ! 184 ENDIF 185 ! 186 IF( lk_iomput ) THEN 187 CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 188 CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 189 ELSE 190 IF( ln_diatrc ) THEN 191 trc2d(:,:,jp_cfc0_2d ) = qtr_cfc (:,:,1) 192 trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 193 END IF 199 194 END IF 200 195 ! 201 196 IF( l_trdtrc ) THEN 202 197 DO jn = jp_cfc0, jp_cfc1 203 CALL trd_ mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt ) ! save trends198 CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends 204 199 END DO 205 200 END IF -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90
r4305 r6225 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 7 !!---------------------------------------------------------------------- 8 #if defined key_top && key_cfc && defined key_iomput8 #if defined key_top && defined key_cfc && defined key_iomput 9 9 !!---------------------------------------------------------------------- 10 10 !! 'key_cfc' cfc model … … 20 20 PUBLIC trc_wri_cfc 21 21 22 # include "top_substitute.h90"23 22 CONTAINS 24 23 … … 37 36 DO jn = jp_cfc0, jp_cfc1 38 37 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 39 IF( lk_vvl ) THEN 40 CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) ) 41 ELSE 42 CALL iom_put( cltra, trn(:,:,:,jn) ) 43 ENDIF 38 CALL iom_put( cltra, trn(:,:,:,jn) ) 44 39 END DO 45 40 ! -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
r2787 r6225 42 42 43 43 IF(lwp) WRITE(numout,*) 44 IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: initialisation of MY_TRC model' 44 IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: passive tracer unit vector' 45 IF(lwp) WRITE(numout,*) ' To check conservation : ' 46 IF(lwp) WRITE(numout,*) ' 1 - No sea-ice model ' 47 IF(lwp) WRITE(numout,*) ' 2 - No runoff ' 48 IF(lwp) WRITE(numout,*) ' 3 - precipitation and evaporation equal to 1 : E=P=1 ' 45 49 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 46 50 47 IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0.51 IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 1. 48 52 ! 49 53 END SUBROUTINE trc_ini_my_trc -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r3680 r6225 16 16 USE oce_trc ! Ocean variables 17 17 USE trc ! TOP variables 18 USE trdmod_oce 19 USE trdmod_trc 18 USE trd_oce 19 USE trdtrc 20 USE trcbc, only : trc_bc_read 20 21 21 22 IMPLICIT NONE … … 46 47 INTEGER :: jn ! dummy loop index 47 48 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt 48 !!----------------------------------------------------------------------49 !!---------------------------------------------------------------------- 49 50 ! 50 51 IF( nn_timing == 1 ) CALL timing_start('trc_sms_my_trc') … … 56 57 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 57 58 58 WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) ) 59 trn(:,:,1,jpmyt1) = 1._wp 60 trb(:,:,1,jpmyt1) = 1._wp 61 tra(:,:,1,jpmyt1) = 0._wp 62 END WHERE 59 CALL trc_bc_read ( kt ) ! tracers: surface and lateral Boundary Conditions 63 60 64 IF( l_trdtrc ) THEN ! Save the trends in the ixed layer 61 ! add here the call to BGC model 62 63 ! Save the trends in the mixed layer 64 IF( l_trdtrc ) THEN 65 65 DO jn = jp_myt0, jp_myt1 66 66 ztrmyt(:,:,:) = tra(:,:,:,jn) 67 CALL trd_ mod_trc( ztrmyt, jn, jptra_trd_sms, kt ) ! save trends67 CALL trd_trc( ztrmyt, jn, jptra_sms, kt ) ! save trends 68 68 END DO 69 69 CALL wrk_dealloc( jpi, jpj, jpk, ztrmyt ) -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
r4305 r6225 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 7 !!---------------------------------------------------------------------- 8 #if defined key_top && key_my_trc && defined key_iomput8 #if defined key_top && defined key_my_trc && defined key_iomput 9 9 !!---------------------------------------------------------------------- 10 10 !! 'key_my_trc' my_trc model … … 20 20 PUBLIC trc_wri_my_trc 21 21 22 # include "top_substitute.h90"23 22 CONTAINS 24 23 … … 37 36 DO jn = jp_myt0, jp_myt1 38 37 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 39 IF( lk_vvl ) THEN 40 CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) ) 41 ELSE 42 CALL iom_put( cltra, trn(:,:,:,jn) ) 43 ENDIF 38 IF( ln_trc_wri(jn) ) CALL iom_put( cltra, trn(:,:,:,jn) ) 44 39 END DO 45 40 ! -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
- Property svn:keywords set to Id
r4624 r6225 21 21 USE lbclnk ! 22 22 USE prtctl_trc ! Print control for debbuging 23 USE trd mod_oce24 USE trd mod_trc23 USE trd_oce 24 USE trdtrc 25 25 USE iom 26 26 … … 59 59 REAL(wp) :: fdbod ! zooplankton mortality fraction that goes to detritus 60 60 61 !! * Substitution62 # include " top_substitute.h90"61 !! * Substitutions 62 # include "vectopt_loop_substitute.h90" 63 63 !!---------------------------------------------------------------------- 64 64 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 65 !! $Id : p2zbio.F90 3294 2012-01-28 16:44:18Z rblod$65 !! $Id$ 66 66 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 67 67 !!---------------------------------------------------------------------- 68 69 68 CONTAINS 70 69 … … 110 109 IF( nn_timing == 1 ) CALL timing_start('p2z_bio') 111 110 ! 112 IF( ln_diatrc ) THEN111 IF( ln_diatrc .OR. lk_iomput ) THEN 113 112 CALL wrk_alloc( jpi, jpj, 17, zw2d ) 114 113 CALL wrk_alloc( jpi, jpj, jpk, 3, zw3d ) … … 122 121 123 122 xksi(:,:) = 0.e0 ! zooplakton closure ( fbod) 124 IF( ln_diatrc ) THEN123 IF( ln_diatrc .OR. lk_iomput ) THEN 125 124 zw2d (:,:,:) = 0.e0 126 125 zw3d(:,:,:,:) = 0.e0 … … 186 185 ! closure : flux grazing is redistributed below level jpkbio 187 186 zzoobod = tmminz * zzoo * zzoo 188 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) 189 188 zboddet = fdbod * zzoobod 190 189 … … 239 238 ! trend number 17 in p2zexp 240 239 ENDIF 241 IF( ln_diatrc ) THEN240 IF( ln_diatrc .OR. lk_iomput ) THEN 242 241 ! convert fluxes in per day 243 ze3t = fse3t(ji,jj,jk) * 86400.242 ze3t = e3t_n(ji,jj,jk) * 86400._wp 244 243 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 245 244 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t … … 360 359 ! trend number 17 in p2zexp 361 360 ENDIF 362 IF( ln_diatrc ) THEN361 IF( ln_diatrc .OR. lk_iomput ) THEN 363 362 ! convert fluxes in per day 364 ze3t = fse3t(ji,jj,jk) * 86400.363 ze3t = e3t_n(ji,jj,jk) * 86400._wp 365 364 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 366 365 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t … … 381 380 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 382 381 ! 383 zw3d(ji,jj,jk,1) = zno3phy * 86400 384 zw3d(ji,jj,jk,2) = znh4phy * 86400 385 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 386 385 ! 387 386 ENDIF … … 390 389 END DO 391 390 392 IF( ln_diatrc ) THEN 393 ! 391 IF( ln_diatrc .OR. lk_iomput ) THEN 394 392 DO jl = 1, 17 395 393 CALL lbc_lnk( zw2d(:,:,jl),'T', 1. ) … … 398 396 CALL lbc_lnk( zw3d(:,:,:,jl),'T', 1. ) 399 397 END DO 400 IF( lk_iomput ) THEN 398 ENDIF 399 IF( lk_iomput ) THEN 401 400 ! Save diagnostics 402 CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 403 CALL iom_put( "TNH4PHY", zw2d(:,:,2) ) 404 CALL iom_put( "TPHYDOM", zw2d(:,:,3) ) 405 CALL iom_put( "TPHYNH4", zw2d(:,:,4) ) 406 CALL iom_put( "TPHYZOO", zw2d(:,:,5) ) 407 CALL iom_put( "TPHYDET", zw2d(:,:,6) ) 408 CALL iom_put( "TDETZOO", zw2d(:,:,7) ) 409 CALL iom_put( "TZOODET", zw2d(:,:,8) ) 410 CALL iom_put( "TZOOBOD", zw2d(:,:,9) ) 411 CALL iom_put( "TZOONH4", zw2d(:,:,10) ) 412 CALL iom_put( "TZOODOM", zw2d(:,:,11) ) 413 CALL iom_put( "TNH4NO3", zw2d(:,:,12) ) 414 CALL iom_put( "TDOMNH4", zw2d(:,:,13) ) 415 CALL iom_put( "TDETNH4", zw2d(:,:,14) ) 416 CALL iom_put( "TPHYTOT", zw2d(:,:,15) ) 417 CALL iom_put( "TZOOTOT", zw2d(:,:,16) ) 418 ! 419 CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) ) 420 CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) ) 421 CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 422 ! 423 ELSE 401 CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 402 CALL iom_put( "TNH4PHY", zw2d(:,:,2) ) 403 CALL iom_put( "TPHYDOM", zw2d(:,:,3) ) 404 CALL iom_put( "TPHYNH4", zw2d(:,:,4) ) 405 CALL iom_put( "TPHYZOO", zw2d(:,:,5) ) 406 CALL iom_put( "TPHYDET", zw2d(:,:,6) ) 407 CALL iom_put( "TDETZOO", zw2d(:,:,7) ) 408 CALL iom_put( "TZOODET", zw2d(:,:,8) ) 409 CALL iom_put( "TZOOBOD", zw2d(:,:,9) ) 410 CALL iom_put( "TZOONH4", zw2d(:,:,10) ) 411 CALL iom_put( "TZOODOM", zw2d(:,:,11) ) 412 CALL iom_put( "TNH4NO3", zw2d(:,:,12) ) 413 CALL iom_put( "TDOMNH4", zw2d(:,:,13) ) 414 CALL iom_put( "TDETNH4", zw2d(:,:,14) ) 415 CALL iom_put( "TPHYTOT", zw2d(:,:,15) ) 416 CALL iom_put( "TZOOTOT", zw2d(:,:,16) ) 417 ! 418 CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) ) 419 CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) ) 420 CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 421 ! 422 ELSE 423 IF( ln_diatrc ) THEN 424 424 ! 425 425 trc2d(:,:,jp_pcs0_2d ) = zw2d(:,:,1) … … 457 457 IF( l_trdtrc ) THEN 458 458 DO jl = jp_pcs0_trd, jp_pcs1_trd 459 CALL trd_ mod_trc( trbio(:,:,:,jl), jl, kt ) ! handle the trend459 CALL trd_trc( trbio(:,:,:,jl), jl, kt ) ! handle the trend 460 460 END DO 461 461 ENDIF … … 467 467 ENDIF 468 468 ! 469 IF( ln_diatrc ) THEN469 IF( ln_diatrc .OR. lk_iomput ) THEN 470 470 CALL wrk_dealloc( jpi, jpj, 17, zw2d ) 471 471 CALL wrk_dealloc( jpi, jpj, jpk, 3, zw3d ) … … 598 598 599 599 !!====================================================================== 600 END MODULE 600 END MODULE p2zbio -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
- Property svn:keywords set to Id
r3446 r6225 22 22 USE lbclnk 23 23 USE prtctl_trc ! Print control for debbuging 24 USE trd mod_oce25 USE trd mod_trc24 USE trd_oce 25 USE trdtrc 26 26 USE iom 27 27 … … 41 41 REAL(wp) :: areacot !: surface coastal area 42 42 43 !! * Substitution44 # include " top_substitute.h90"43 !! * Substitutions 44 # include "vectopt_loop_substitute.h90" 45 45 !!---------------------------------------------------------------------- 46 46 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 47 !! $Id : trcexp.F90 3294 2012-01-28 16:44:18Z rblod$47 !! $Id$ 48 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- 50 51 50 CONTAINS 52 51 … … 94 93 DO jj = 2, jpjm1 95 94 DO ji = fs_2, fs_jpim1 96 ze3t = 1. / fse3t(ji,jj,jk)95 ze3t = 1. / e3t_n(ji,jj,jk) 97 96 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 98 97 END DO … … 109 108 DO ji = fs_2, fs_jpim1 110 109 ikt = mbkt(ji,jj) 111 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) 112 111 ! Deposition of organic matter in the sediment 113 112 zwork = vsed * trn(ji,jj,ikt,jpdet) … … 120 119 DO jj = 2, jpjm1 121 120 DO ji = fs_2, fs_jpim1 122 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) 123 122 END DO 124 123 END DO … … 127 126 128 127 ! Oa & Ek: diagnostics depending on jpdia2d ! left as example 129 IF( l n_diatrc ) THEN130 IF( lk_iomput ) THEN ;CALL iom_put( "SEDPOC" , sedpocn )131 ELSE ; trc2d(:,:,jp_pcs0_2d + 18) = sedpocn(:,:)132 ENDIF128 IF( lk_iomput ) THEN 129 CALL iom_put( "SEDPOC" , sedpocn ) 130 ELSE 131 IF( ln_diatrc ) trc2d(:,:,jp_pcs0_2d + 18) = sedpocn(:,:) 133 132 ENDIF 134 133 … … 164 163 ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:) 165 164 jl = jp_pcs0_trd + 16 166 CALL trd_ mod_trc( ztrbio, jl, kt ) ! handle the trend165 CALL trd_trc( ztrbio, jl, kt ) ! handle the trend 167 166 CALL wrk_dealloc( jpi, jpj, jpk, ztrbio ) ! temporary save of trends 168 167 ENDIF … … 211 210 DO jj = 1, jpj 212 211 DO ji = 1, jpi 213 zfluo = ( fsdepw(ji,jj,jk ) / fsdepw(ji,jj,jpkb) )**xhr214 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 215 214 IF( zfluo.GT.1. ) zfluo = 1._wp 216 215 zdm0(ji,jj,jk) = zfluo - zfluu -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
- Property svn:keywords set to Id
r4624 r6225 40 40 REAL(wp), PUBLIC :: reddom ! redfield ratio (C:N) for DOM 41 41 42 !!* Substitution43 # include "top_substitute.h90"44 42 !!---------------------------------------------------------------------- 45 43 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 46 !! $Id : trcopt.F90 3294 2012-01-28 16:44:18Z rblod$44 !! $Id$ 47 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 46 !!---------------------------------------------------------------------- 49 50 47 CONTAINS 51 48 … … 89 86 90 87 ! ! surface irradiance 91 zpar0m (:,:) = qsr (:,:) * 0.43 ! ------------------ 88 ! ! ------------------ 89 IF( ln_dm2dc ) THEN ; zpar0m(:,:) = qsr_mean(:,:) * 0.43 90 ELSE ; zpar0m(:,:) = qsr (:,:) * 0.43 91 ENDIF 92 92 zpar100(:,:) = zpar0m(:,:) * 0.01 93 93 zparr (:,:,1) = zpar0m(:,:) * 0.5 … … 102 102 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 103 103 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 104 zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )105 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) ) 106 106 END DO 107 107 END DO … … 113 113 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 114 114 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 115 zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )116 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) ) ) 117 117 etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 118 118 END DO … … 128 128 IF( etot(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk + 1 129 129 ! ! nb. this is to ensure compatibility with 130 ! ! nmld_trc definition in trd_m ld_trc_zint130 ! ! nmld_trc definition in trd_mxl_trc_zint 131 131 END DO 132 132 END DO … … 135 135 DO jj = 1, jpj 136 136 DO ji = 1, jpi 137 heup(ji,jj) = fsdepw(ji,jj,neln(ji,jj))137 heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj)) 138 138 END DO 139 139 END DO -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
- Property svn:keywords set to Id
r4624 r6225 18 18 USE sms_pisces 19 19 USE lbclnk 20 USE trd mod_oce21 USE trd mod_trc20 USE trd_oce 21 USE trdtrc 22 22 USE iom 23 23 USE prtctl_trc ! Print control for debbuging … … 34 34 REAL(wp), PUBLIC :: xhr ! coeff for martin''s remineralisation profile 35 35 36 !!* Substitution37 # include "top_substitute.h90"38 36 !!---------------------------------------------------------------------- 39 37 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 40 !! $Id : p2z_sed.F90 3294 2012-01-28 16:44:18Z rblod$38 !! $Id$ 41 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 40 !!---------------------------------------------------------------------- … … 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 … … 108 106 END DO 109 107 110 IF( ln_diatrc ) THEN 111 CALL wrk_alloc( jpi, jpj, zw2d ) 112 zw2d(:,:) = ztra(:,:,1) * fse3t(:,:,1) * 86400. 113 DO jk = 2, jpkm1 114 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400. 115 END DO 116 IF( lk_iomput ) THEN 117 CALL iom_put( "TDETSED", zw2d ) 118 ELSE 119 trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:) 108 IF( lk_iomput ) THEN 109 IF( iom_use( "TDETSED" ) ) THEN 110 CALL wrk_alloc( jpi, jpj, zw2d ) 111 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 112 DO jk = 2, jpkm1 113 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 114 END DO 115 CALL iom_put( "TDETSED", zw2d ) 116 CALL wrk_dealloc( jpi, jpj, zw2d ) 120 117 ENDIF 121 CALL wrk_dealloc( jpi, jpj, zw2d ) 118 ELSE 119 IF( ln_diatrc ) THEN 120 CALL wrk_alloc( jpi, jpj, zw2d ) 121 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 122 DO jk = 2, jpkm1 123 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 124 END DO 125 trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:) 126 CALL wrk_dealloc( jpi, jpj, zw2d ) 127 ENDIF 122 128 ENDIF 123 129 ! … … 128 134 ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:) 129 135 jl = jp_pcs0_trd + 7 130 CALL trd_ mod_trc( ztrbio, jl, kt ) ! handle the trend136 CALL trd_trc( ztrbio, jl, kt ) ! handle the trend 131 137 CALL wrk_dealloc( jpi, jpj, jpk, ztrbio ) 132 138 ENDIF -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
- Property svn:keywords set to Id
r4624 r6225 20 20 USE p2zsed 21 21 USE p2zexp 22 USE trd mod_oce23 USE trd mod_trc_oce24 USE trd mod_trc25 USE trdm ld_trc22 USE trd_oce 23 USE trdtrc_oce 24 USE trdtrc 25 USE trdmxl_trc 26 26 27 27 IMPLICIT NONE … … 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 34 !! $Id : p2zsms.F90 3294 2012-01-28 16:44:18Z rblod$34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- … … 61 61 IF( l_trdtrc ) THEN 62 62 DO jn = jp_pcs0, jp_pcs1 63 CALL trd_ mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt ) ! save trends63 CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends 64 64 END DO 65 65 END IF 66 66 67 IF( lk_trdm ld_trc ) CALL trd_mld_bio( kt ) ! trends: Mixed-layer67 IF( lk_trdmxl_trc ) CALL trd_mxl_bio( kt ) ! trends: Mixed-layer 68 68 ! 69 69 IF ( lwm .AND. kt == nittrc000 ) CALL FLUSH ( numonp ) ! flush output namelist PISCES … … 84 84 85 85 !!====================================================================== 86 END MODULE 86 END MODULE p2zsms -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r4529 r6225 34 34 PUBLIC p4z_bio 35 35 36 !!* Substitution37 # include "top_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 46 SUBROUTINE p4z_bio ( kt, jnt )43 SUBROUTINE p4z_bio ( kt, knt ) 47 44 !!--------------------------------------------------------------------- 48 45 !! *** ROUTINE p4z_bio *** … … 54 51 !! ** Method : - ??? 55 52 !!--------------------------------------------------------------------- 56 INTEGER, INTENT(in) :: kt, jnt 57 INTEGER :: ji, jj, jk, jn 58 REAL(wp) :: ztra 59 #if defined key_kriest 60 REAL(wp) :: zcoef1, zcoef2 61 #endif 53 INTEGER, INTENT(in) :: kt, knt 54 INTEGER :: ji, jj, jk, jn 62 55 CHARACTER (len=25) :: charout 63 56 … … 74 67 DO jj = 1, jpj 75 68 DO ji = 1, jpi 76 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 77 71 END DO 78 72 END DO 79 73 END DO 80 74 81 82 CALL p4z_opt ( kt, jnt ) ! Optic: PAR in the water column 83 CALL p4z_sink ( kt, jnt ) ! vertical flux of particulate organic matter 84 CALL p4z_fechem(kt, jnt ) ! Iron chemistry/scavenging 85 CALL p4z_lim ( kt, jnt ) ! co-limitations by the various nutrients 86 CALL p4z_prod ( kt, jnt ) ! phytoplankton growth rate over the global ocean. 75 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column 76 CALL p4z_sink ( kt, knt ) ! vertical flux of particulate organic matter 77 CALL p4z_fechem(kt, knt ) ! Iron chemistry/scavenging 78 CALL p4z_lim ( kt, knt ) ! co-limitations by the various nutrients 79 CALL p4z_prod ( kt, knt ) ! phytoplankton growth rate over the global ocean. 87 80 ! ! (for each element : C, Si, Fe, Chl ) 88 81 CALL p4z_mort ( kt ) ! phytoplankton mortality 89 90 CALL p4z_micro( kt, jnt ) ! microzooplankton91 CALL p4z_meso ( kt, jnt ) ! mesozooplankton92 CALL p4z_rem ( kt, jnt ) ! remineralization terms of organic matter+scavenging of Fe82 ! ! zooplankton sources/sinks routines 83 CALL p4z_micro( kt, knt ) ! microzooplankton 84 CALL p4z_meso ( kt, knt ) ! mesozooplankton 85 CALL p4z_rem ( kt, knt ) ! remineralization terms of organic matter+scavenging of Fe 93 86 ! ! test if tracers concentrations fall below 0. 94 xnegtr(:,:,:) = 1.e0 95 DO jn = jp_pcs0, jp_pcs1 96 DO jk = 1, jpk 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 IF( ( trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 100 ztra = ABS( trn(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 101 102 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 103 ENDIF 104 END DO 105 END DO 106 END DO 107 END DO 108 ! ! where at least 1 tracer concentration becomes negative 109 ! ! 110 DO jn = jp_pcs0, jp_pcs1 111 trn(:,:,:,jn) = trn(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 112 END DO 113 114 115 tra(:,:,:,:) = 0.e0 116 117 #if defined key_kriest 118 ! 119 zcoef1 = 1.e0 / xkr_massp 120 zcoef2 = 1.e0 / xkr_massp / 1.1 121 DO jk = 1,jpkm1 122 trn(:,:,jk,jpnum) = MAX( trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef1 / xnumm(jk) ) 123 trn(:,:,jk,jpnum) = MIN( trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef2 ) 124 END DO 125 #endif 126 127 ! 87 ! ! 128 88 IF(ln_ctl) THEN ! print mean trends (used for debugging) 129 89 WRITE(charout, FMT="('bio ')") 130 90 CALL prt_ctl_trc_info(charout) 131 CALL prt_ctl_trc(tab4d=tr n, mask=tmask, clinfo=ctrcnm)91 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 132 92 ENDIF 133 93 ! … … 146 106 147 107 !!====================================================================== 148 END MODULE p4zbio 149 108 END MODULE p4zbio -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
- Property svn:keywords set to Id
r3557 r6225 164 164 REAL(wp) :: devk55 = 0.3692E-3 165 165 166 !!* Substitution167 #include "top_substitute.h90"168 166 !!---------------------------------------------------------------------- 169 167 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 170 !! $Id : p4zche.F90 3294 2012-01-28 16:44:18Z rblod$168 !! $Id$ 171 169 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 172 170 !!---------------------------------------------------------------------- … … 195 193 ! CHEMICAL CONSTANTS - SURFACE LAYER 196 194 ! ---------------------------------- 197 !CDIR NOVERRCHK198 195 DO jj = 1, jpj 199 !CDIR NOVERRCHK200 196 DO ji = 1, jpi 201 197 ! ! SET ABSOLUTE TEMPERATURE … … 227 223 ! OXYGEN SOLUBILITY - DEEP OCEAN 228 224 ! ------------------------------- 229 !CDIR NOVERRCHK230 225 DO jk = 1, jpk 231 !CDIR NOVERRCHK232 226 DO jj = 1, jpj 233 !CDIR NOVERRCHK234 227 DO ji = 1, jpi 235 228 ztkel = tsn(ji,jj,jk,jp_tem) + 273.16 … … 249 242 250 243 251 252 244 ! CHEMICAL CONSTANTS - DEEP OCEAN 253 245 ! ------------------------------- 254 !CDIR NOVERRCHK255 246 DO jk = 1, jpk 256 !CDIR NOVERRCHK257 247 DO jj = 1, jpj 258 !CDIR NOVERRCHK259 248 DO ji = 1, jpi 260 249 261 250 ! SET PRESSION 262 zpres = 1.025e-1 * fsdept(ji,jj,jk)251 zpres = 1.025e-1 * gdept_n(ji,jj,jk) 263 252 264 253 ! SET ABSOLUTE TEMPERATURE … … 396 385 397 386 !!====================================================================== 398 END MODULE 387 END MODULE p4zche -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r4624 r6225 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 !!* Substitution42 # include "top_substitute.h90"43 41 !!---------------------------------------------------------------------- 44 42 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 48 46 CONTAINS 49 47 50 SUBROUTINE p4z_fechem( kt, jnt )48 SUBROUTINE p4z_fechem( kt, knt ) 51 49 !!--------------------------------------------------------------------- 52 50 !! *** ROUTINE p4z_fechem *** … … 61 59 !! and one particulate form (ln_fechem) 62 60 !!--------------------------------------------------------------------- 63 ! 64 INTEGER, INTENT(in) :: kt, jnt ! 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. … … 101 97 ! ------------------------------------------------- 102 98 IF( ln_ligvar ) THEN 103 ztotlig(:,:,:) = 0.09 * tr n(:,:,:,jpdoc) * 1E6 + ligand * 1E999 ztotlig(:,:,:) = 0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9 104 100 ztotlig(:,:,:) = MIN( ztotlig(:,:,:), 10. ) 105 101 ELSE … … 113 109 ! Chemistry is supposed to be fast enough to be at equilibrium 114 110 ! ------------------------------------------------------------ 115 !CDIR NOVERRCHK116 111 DO jk = 1, jpkm1 117 !CDIR NOVERRCHK118 112 DO jj = 1, jpj 119 !CDIR NOVERRCHK120 113 DO ji = 1, jpi 121 114 ! Calculate ligand concentrations : assume 2/3rd of excess goes to … … 127 120 zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn ) 128 121 zph = -LOG10( MAX( hi(ji,jj,jk), rtrn) ) 129 zoxy = tr n(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 )122 zoxy = trb(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 ) 130 123 ! Fe2+ oxydation rate from Santana-Casiano et al. (2005) 131 124 zkox = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tsn(ji,jj,jk,jp_tem) + 273.15 ) & … … 137 130 zkph1 = zkph2 / 5. 138 131 ! pass the dfe concentration from PISCES 139 ztfe = tr n(ji,jj,jk,jpfer) * 1e9132 ztfe = trb(ji,jj,jk,jpfer) * 1e9 140 133 ! ---------------------------------------------------------- 141 134 ! ANALYTICAL SOLUTION OF ROOTS OF THE FE3+ EQUATION … … 195 188 ! Chemistry is supposed to be fast enough to be at equilibrium 196 189 ! ------------------------------------------------------------ 197 !CDIR NOVERRCHK198 190 DO jk = 1, jpkm1 199 !CDIR NOVERRCHK200 191 DO jj = 1, jpj 201 !CDIR NOVERRCHK202 192 DO ji = 1, jpi 203 193 zTL1(ji,jj,jk) = ztotlig(ji,jj,jk) 204 194 zkeq = fekeq(ji,jj,jk) 205 195 zfesatur = zTL1(ji,jj,jk) * 1E-9 206 ztfe = tr n(ji,jj,jk,jpfer)196 ztfe = trb(ji,jj,jk,jpfer) 207 197 ! Fe' is the root of a 2nd order polynom 208 198 zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe ) & … … 210 200 & + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 211 201 zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 212 zFeL1(ji,jj,jk) = MAX( 0., tr n(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )202 zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) ) 213 203 END DO 214 204 END DO … … 216 206 ! 217 207 ENDIF 218 208 ! 219 209 zdust = 0. ! if no dust available 220 !CDIR NOVERRCHK 210 ! 221 211 DO jk = 1, jpkm1 222 !CDIR NOVERRCHK223 212 DO jj = 1, jpj 224 !CDIR NOVERRCHK225 213 DO ji = 1, jpi 226 214 zstep = xstep … … 240 228 ENDIF 241 229 #if defined key_kriest 242 ztrc = ( tr n(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6230 ztrc = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 243 231 #else 244 ztrc = ( tr n(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6232 ztrc = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 245 233 #endif 246 IF( ln_dust ) zdust = dust(ji,jj) / ( wdust *rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s234 IF( ln_dust ) zdust = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s 247 235 zlam1b = 3.e-5 + xlamdust * zdust + xlam1 * ztrc 248 236 zscave = zfeequi * zlam1b * zstep … … 251 239 ! to later allocate scavenged iron to the different organic pools 252 240 ! --------------------------------------------------------- 253 zdenom1 = xlam1 * tr n(ji,jj,jk,jppoc) / zlam1b241 zdenom1 = xlam1 * trb(ji,jj,jk,jppoc) / zlam1b 254 242 #if ! defined key_kriest 255 zdenom2 = xlam1 * tr n(ji,jj,jk,jpgoc) / zlam1b243 zdenom2 = xlam1 * trb(ji,jj,jk,jpgoc) / zlam1b 256 244 #endif 257 245 … … 261 249 zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 262 250 zlamfac = MIN( 1. , zlamfac ) 263 zdep = MIN( 1., 1000. / fsdept(ji,jj,jk) ) 264 zlam1b = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 265 zcoag = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trn(ji,jj,jk,jpfer) 251 !!gm very small BUG : it is unlikely but possible that gdept_n = 0 ..... 252 zdep = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 253 zlam1b = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 254 zcoag = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer) 266 255 267 256 ! Compute the coagulation of colloidal iron. This parameterization … … 269 258 ! It requires certainly some more work as it is very poorly constrained. 270 259 ! ---------------------------------------------------------------- 271 zlam1a = ( 0.369 * 0.3 * tr n(ji,jj,jk,jpdoc) + 102.4 * trn(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) &272 & + ( 114. * 0.3 * tr n(ji,jj,jk,jpdoc) + 5.09E3 * trn(ji,jj,jk,jppoc) )260 zlam1a = ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) & 261 & + ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) + 5.09E3 * trb(ji,jj,jk,jppoc) ) 273 262 zaggdfea = zlam1a * zstep * zfecoll 274 263 #if defined key_kriest … … 278 267 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb 279 268 #else 280 zlam1b = 3.53E3 * tr n(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)269 zlam1b = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 281 270 zaggdfeb = zlam1b * zstep * zfecoll 282 271 ! … … 292 281 ! ---------------------------------------- 293 282 IF( ln_fechem ) THEN 294 biron(:,:,:) = MAX( 0., tr n(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 )283 biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 295 284 ELSE 296 biron(:,:,:) = tr n(:,:,:,jpfer)285 biron(:,:,:) = trb(:,:,:,jpfer) 297 286 ENDIF 298 287 299 288 ! Output of some diagnostics variables 300 289 ! --------------------------------- 301 IF( ln_diatrc .AND. lk_iomput ) THEN 302 IF( jnt == nrdttrc ) THEN 303 CALL iom_put("Fe3" , zFe3 (:,:,:) * tmask(:,:,:) ) ! Fe3+ 304 CALL iom_put("FeL1" , zFeL1 (:,:,:) * tmask(:,:,:) ) ! FeL1 305 CALL iom_put("TL1" , zTL1 (:,:,:) * tmask(:,:,:) ) ! TL1 306 CALL iom_put("Totlig" , ztotlig(:,:,:) * tmask(:,:,:) ) ! TL 307 CALL iom_put("Biron" , biron (:,:,:) * 1e9 * tmask(:,:,:) ) ! biron 308 IF( ln_fechem ) THEN 309 CALL iom_put("Fe2" , zFe2 (:,:,:) * tmask(:,:,:) ) ! Fe2+ 310 CALL iom_put("FeL2", zFeL2 (:,:,:) * tmask(:,:,:) ) ! FeL2 311 CALL iom_put("FeP" , zFeP (:,:,:) * tmask(:,:,:) ) ! FeP 312 CALL iom_put("TL2" , zTL2 (:,:,:) * tmask(:,:,:) ) ! TL2 313 ENDIF 290 IF( lk_iomput .AND. knt == nrdttrc ) THEN 291 IF( iom_use("Fe3") ) CALL iom_put("Fe3" , zFe3 (:,:,:) * tmask(:,:,:) ) ! Fe3+ 292 IF( iom_use("FeL1") ) CALL iom_put("FeL1" , zFeL1 (:,:,:) * tmask(:,:,:) ) ! FeL1 293 IF( iom_use("TL1") ) CALL iom_put("TL1" , zTL1 (:,:,:) * tmask(:,:,:) ) ! TL1 294 IF( iom_use("Totlig") ) CALL iom_put("Totlig" , ztotlig(:,:,:) * tmask(:,:,:) ) ! TL 295 IF( iom_use("Biron") ) CALL iom_put("Biron" , biron (:,:,:) * 1e9 * tmask(:,:,:) ) ! biron 296 IF( ln_fechem ) THEN 297 IF( iom_use("Fe2") ) CALL iom_put("Fe2" , zFe2 (:,:,:) * tmask(:,:,:) ) ! Fe2+ 298 IF( iom_use("FeL2") ) CALL iom_put("FeL2" , zFeL2 (:,:,:) * tmask(:,:,:) ) ! FeL2 299 IF( iom_use("FeP") ) CALL iom_put("FeP" , zFeP (:,:,:) * tmask(:,:,:) ) ! FeP 300 IF( iom_use("TL2") ) CALL iom_put("TL2" , zTL2 (:,:,:) * tmask(:,:,:) ) ! TL2 314 301 ENDIF 315 302 ENDIF -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
- Property svn:keywords set to Id
r4624 r6225 59 59 REAL(wp) :: xconv = 0.01_wp / 3600._wp !: coefficients for conversion 60 60 61 !!* Substitution62 # include "top_substitute.h90"63 61 !!---------------------------------------------------------------------- 64 62 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 65 !! $Id : p4zflx.F90 3294 2012-01-28 16:44:18Z rblod$63 !! $Id$ 66 64 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 67 65 !!---------------------------------------------------------------------- 68 66 CONTAINS 69 67 70 SUBROUTINE p4z_flx ( kt )68 SUBROUTINE p4z_flx ( kt, knt ) 71 69 !!--------------------------------------------------------------------- 72 70 !! *** ROUTINE p4z_flx *** … … 81 79 !!--------------------------------------------------------------------- 82 80 ! 83 INTEGER, INTENT(in) :: kt !81 INTEGER, INTENT(in) :: kt, knt ! 84 82 ! 85 83 INTEGER :: ji, jj, jm, iind, iindm1 … … 89 87 REAL(wp) :: zyr_dec, zdco2dt 90 88 CHARACTER (len=25) :: charout 91 REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx 89 REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx, zw2d 92 90 !!--------------------------------------------------------------------- 93 91 ! … … 101 99 ! IS USED TO COMPUTE AIR-SEA FLUX OF CO2 102 100 103 IF( kt /= nit000 ) CALL p4z_patm( kt ) ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs101 IF( kt /= nit000 .AND. knt == 1 ) CALL p4z_patm( kt ) ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 104 102 105 103 IF( ln_co2int ) THEN … … 122 120 123 121 DO jm = 1, 10 124 !CDIR NOVERRCHK125 122 DO jj = 1, jpj 126 !CDIR NOVERRCHK127 123 DO ji = 1, jpi 128 124 … … 130 126 zbot = borat(ji,jj,1) 131 127 zfact = rhop(ji,jj,1) / 1000. + rtrn 132 zdic = tr n(ji,jj,1,jpdic) / zfact128 zdic = trb(ji,jj,1,jpdic) / zfact 133 129 zph = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 134 zalka = tr n(ji,jj,1,jptal) / zfact130 zalka = trb(ji,jj,1,jptal) / zfact 135 131 136 132 ! CALCULATE [ALK]([CO3--], [HCO3-]) … … 155 151 ! ------------------------------------------- 156 152 157 !CDIR NOVERRCHK158 153 DO jj = 1, jpj 159 !CDIR NOVERRCHK160 154 DO ji = 1, jpi 161 155 ztc = MIN( 35., tsn(ji,jj,1,jp_tem) ) … … 184 178 zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) * (m/s) 185 179 zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) (m/s) ? 186 oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.180 oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 187 181 ! compute the trend 188 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1)182 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) 189 183 190 184 ! Compute O2 flux 191 185 zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj) ! (mol/L) * (m/s) 192 zflu16 = tr n(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj)186 zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 193 187 zoflx(ji,jj) = zfld16 - zflu16 194 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) / fse3t(ji,jj,1)188 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1) 195 189 END DO 196 190 END DO 197 191 198 t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) ) ! Cumulative Total Flux of Carbon 199 t_atm_co2_flx = glob_sum( satmco2(:,:) * e1e2t(:,:) ) ! Total atmospheric pCO2 200 192 t_oce_co2_flx = glob_sum( oce_co2(:,:) ) ! Total Flux of Carbon 193 t_oce_co2_flx_cum = t_oce_co2_flx_cum + t_oce_co2_flx ! Cumulative Total Flux of Carbon 194 ! t_atm_co2_flx = glob_sum( satmco2(:,:) * e1e2t(:,:) ) ! Total atmospheric pCO2 195 t_atm_co2_flx = atcco2 ! Total atmospheric pCO2 196 201 197 IF(ln_ctl) THEN ! print mean trends (used for debugging) 202 198 WRITE(charout, FMT="('flx ')") … … 205 201 ENDIF 206 202 207 IF( ln_diatrc ) THEN 208 IF( lk_iomput ) THEN 209 CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact ) 210 CALL iom_put( "Oflx" , zoflx(:,:) * 1000 * tmask(:,:,1) ) 211 CALL iom_put( "Kg" , zkgco2(:,:) * tmask(:,:,1) ) 212 CALL iom_put( "Dpco2", ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 213 CALL iom_put( "Dpo2" , ( atcox * patm(:,:) - trn(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1) ) 214 ELSE 215 trc2d(:,:,jp_pcs0_2d ) = oce_co2(:,:) / e1e2t(:,:) / rfact 203 IF( lk_iomput .AND. knt == nrdttrc ) THEN 204 CALL wrk_alloc( jpi, jpj, zw2d ) 205 IF( iom_use( "Cflx" ) ) THEN 206 zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 207 CALL iom_put( "Cflx" , zw2d ) 208 ENDIF 209 IF( iom_use( "Oflx" ) ) THEN 210 zw2d(:,:) = zoflx(:,:) * 1000 * tmask(:,:,1) 211 CALL iom_put( "Oflx" , zw2d ) 212 ENDIF 213 IF( iom_use( "Kg" ) ) THEN 214 zw2d(:,:) = zkgco2(:,:) * tmask(:,:,1) 215 CALL iom_put( "Kg" , zw2d ) 216 ENDIF 217 IF( iom_use( "Dpco2" ) ) THEN 218 zw2d(:,:) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 219 CALL iom_put( "Dpco2" , zw2d ) 220 ENDIF 221 IF( iom_use( "Dpo2" ) ) THEN 222 zw2d(:,:) = ( atcox * patm(:,:) - trb(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1) 223 CALL iom_put( "Dpo2" , zw2d ) 224 ENDIF 225 IF( iom_use( "tcflx" ) ) CALL iom_put( "tcflx" , t_oce_co2_flx * rfact2r ) ! molC/s 226 CALL iom_put( "tcflxcum" , t_oce_co2_flx_cum ) ! molC 227 ! 228 CALL wrk_dealloc( jpi, jpj, zw2d ) 229 ELSE 230 IF( ln_diatrc ) THEN 231 trc2d(:,:,jp_pcs0_2d ) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 216 232 trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1) 217 233 trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) … … 290 306 ! 291 307 oce_co2(:,:) = 0._wp ! Initialization of Flux of Carbon 308 t_oce_co2_flx = 0._wp 292 309 t_atm_co2_flx = 0._wp 293 t_oce_co2_flx = 0._wp294 310 ! 295 311 CALL p4z_patm( nit000 ) … … 378 394 379 395 !!====================================================================== 380 END MODULE 396 END MODULE p4zflx -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
- Property svn:keywords set to Id
r3446 r6225 26 26 !!---------------------------------------------------------------------- 27 27 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 28 !! $Id : p4zint.F90 3294 2012-01-28 16:44:18Z rblod$28 !! $Id$ 29 29 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 30 30 !!---------------------------------------------------------------------- … … 56 56 DO ji = 1, jpi 57 57 DO jj = 1, jpj 58 zvar = tr n(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil)58 zvar = trb(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil) 59 59 xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 60 60 END DO … … 81 81 82 82 !!====================================================================== 83 END MODULE 83 END MODULE p4zint -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r4624 r6225 52 52 REAL(wp) :: xcoef2 = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5 53 53 REAL(wp) :: xcoef3 = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 54 !!* Substitution 55 # include "top_substitute.h90" 54 56 55 !!---------------------------------------------------------------------- 57 56 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 62 61 CONTAINS 63 62 64 SUBROUTINE p4z_lim( kt, jnt )63 SUBROUTINE p4z_lim( kt, knt ) 65 64 !!--------------------------------------------------------------------- 66 65 !! *** ROUTINE p4z_lim *** … … 72 71 !!--------------------------------------------------------------------- 73 72 ! 74 INTEGER, INTENT(in) :: kt, jnt73 INTEGER, INTENT(in) :: kt, knt 75 74 ! 76 75 INTEGER :: ji, jj, jk 77 76 REAL(wp) :: zlim1, zlim2, zlim3, zlim4, zno3, zferlim 78 77 REAL(wp) :: zconcd, zconcd2, zconcn, zconcn2 79 REAL(wp) :: z1_tr ndia, z1_trnphy, ztem1, ztem2, zetot1, zetot278 REAL(wp) :: z1_trbdia, z1_trbphy, ztem1, ztem2, zetot1, zetot2 80 79 REAL(wp) :: zdenom, zratio, zironmin 81 80 REAL(wp) :: zconc1d, zconc1dnh4, zconc0n, zconc0nnh4 … … 90 89 ! Tuning of the iron concentration to a minimum level that is set to the detection limit 91 90 !------------------------------------- 92 zno3 = tr n(ji,jj,jk,jpno3) / 40.e-691 zno3 = trb(ji,jj,jk,jpno3) / 40.e-6 93 92 zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 94 93 zferlim = MIN( zferlim, 7e-11 ) 95 tr n(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim )94 trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim ) 96 95 97 96 ! Computation of a variable Ks for iron on diatoms taking into account 98 97 ! that increasing biomass is made of generally bigger cells 99 98 !------------------------------------------------ 100 zconcd = MAX( 0.e0 , tr n(ji,jj,jk,jpdia) - xsizedia )101 zconcd2 = tr n(ji,jj,jk,jpdia) - zconcd102 zconcn = MAX( 0.e0 , tr n(ji,jj,jk,jpphy) - xsizephy )103 zconcn2 = tr n(ji,jj,jk,jpphy) - zconcn104 z1_tr nphy = 1. / ( trn(ji,jj,jk,jpphy) + rtrn )105 z1_tr ndia = 1. / ( trn(ji,jj,jk,jpdia) + rtrn )106 107 concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_tr ndia )108 zconc1d = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_tr ndia )109 zconc1dnh4 = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_tr ndia )110 111 concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_tr nphy )112 zconc0n = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_tr nphy )113 zconc0nnh4 = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_tr nphy )99 zconcd = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 100 zconcd2 = trb(ji,jj,jk,jpdia) - zconcd 101 zconcn = MAX( 0.e0 , trb(ji,jj,jk,jpphy) - xsizephy ) 102 zconcn2 = trb(ji,jj,jk,jpphy) - zconcn 103 z1_trbphy = 1. / ( trb(ji,jj,jk,jpphy) + rtrn ) 104 z1_trbdia = 1. / ( trb(ji,jj,jk,jpdia) + rtrn ) 105 106 concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia ) 107 zconc1d = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia ) 108 zconc1dnh4 = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia ) 109 110 concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy ) 111 zconc0n = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy ) 112 zconc0nnh4 = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy ) 114 113 115 114 ! Michaelis-Menten Limitation term for nutrients Small bacteria 116 115 ! ------------------------------------------------------------- 117 zdenom = 1. / ( concbno3 * concbnh4 + concbnh4 * tr n(ji,jj,jk,jpno3) + concbno3 * trn(ji,jj,jk,jpnh4) )118 xnanono3(ji,jj,jk) = tr n(ji,jj,jk,jpno3) * concbnh4 * zdenom119 xnanonh4(ji,jj,jk) = tr n(ji,jj,jk,jpnh4) * concbno3 * zdenom116 zdenom = 1. / ( concbno3 * concbnh4 + concbnh4 * trb(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) ) 117 xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * concbnh4 * zdenom 118 xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * concbno3 * zdenom 120 119 ! 121 120 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 122 zlim2 = tr n(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concbnh4 )123 zlim3 = tr n(ji,jj,jk,jpfer) / ( concbfe + trn(ji,jj,jk,jpfer) )124 zlim4 = tr n(ji,jj,jk,jpdoc) / ( xkdoc + trn(ji,jj,jk,jpdoc) )121 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 ) 122 zlim3 = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) ) 123 zlim4 = trb(ji,jj,jk,jpdoc) / ( xkdoc + trb(ji,jj,jk,jpdoc) ) 125 124 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 126 125 xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 … … 128 127 ! Michaelis-Menten Limitation term for nutrients Small flagellates 129 128 ! ----------------------------------------------- 130 zdenom = 1. / ( zconc0n * zconc0nnh4 + zconc0nnh4 * tr n(ji,jj,jk,jpno3) + zconc0n * trn(ji,jj,jk,jpnh4) )131 xnanono3(ji,jj,jk) = tr n(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom132 xnanonh4(ji,jj,jk) = tr n(ji,jj,jk,jpnh4) * zconc0n * zdenom129 zdenom = 1. / ( zconc0n * zconc0nnh4 + zconc0nnh4 * trb(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) ) 130 xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom 131 xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc0n * zdenom 133 132 ! 134 133 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 135 zlim2 = tr n(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc0nnh4 )136 zratio = tr n(ji,jj,jk,jpnfe) * z1_trnphy137 zironmin = xcoef1 * tr n(ji,jj,jk,jpnch) * z1_trnphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)134 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 ) 135 zratio = trb(ji,jj,jk,jpnfe) * z1_trbphy 136 zironmin = xcoef1 * trb(ji,jj,jk,jpnch) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 138 137 zlim3 = MAX( 0.,( zratio - zironmin ) / qnfelim ) 139 138 xnanopo4(ji,jj,jk) = zlim2 … … 143 142 ! Michaelis-Menten Limitation term for nutrients Diatoms 144 143 ! ---------------------------------------------- 145 zdenom = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * tr n(ji,jj,jk,jpno3) + zconc1d * trn(ji,jj,jk,jpnh4) )146 xdiatno3(ji,jj,jk) = tr n(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom147 xdiatnh4(ji,jj,jk) = tr n(ji,jj,jk,jpnh4) * zconc1d * zdenom144 zdenom = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trb(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) ) 145 xdiatno3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom 146 xdiatnh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc1d * zdenom 148 147 ! 149 148 zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 150 zlim2 = tr n(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4 )151 zlim3 = tr n(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) )152 zratio = tr n(ji,jj,jk,jpdfe) * z1_trndia153 zironmin = xcoef1 * tr n(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)149 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4 ) 150 zlim3 = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) ) 151 zratio = trb(ji,jj,jk,jpdfe) * z1_trbdia 152 zironmin = xcoef1 * trb(ji,jj,jk,jpdch) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 154 153 zlim4 = MAX( 0., ( zratio - zironmin ) / qdfelim ) 155 154 xdiatpo4(ji,jj,jk) = zlim2 … … 166 165 DO jj = 1, jpj 167 166 DO ji = 1, jpi 168 zlim1 = ( tr n(ji,jj,jk,jpno3) * concnnh4 + trn(ji,jj,jk,jpnh4) * concnno3 ) &169 & / ( concnno3 * concnnh4 + concnnh4 * tr n(ji,jj,jk,jpno3) + concnno3 * trn(ji,jj,jk,jpnh4) )170 zlim2 = tr n(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 )171 zlim3 = tr n(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + 5.E-11 )167 zlim1 = ( trb(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 ) & 168 & / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) ) 169 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 ) 170 zlim3 = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) + 5.E-11 ) 172 171 ztem1 = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 173 172 ztem2 = tsn(ji,jj,jk,jp_tem) - 10. 174 zetot1 = MAX( 0., etot (ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) )175 zetot2 = 30. / ( 30. + etot (ji,jj,jk) )173 zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 174 zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) 176 175 177 176 xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & 178 177 & * ztem1 / ( 0.1 + ztem1 ) & 179 & * MAX( 1., tr n(ji,jj,jk,jpphy) * 1.e6 / 2. ) &178 & * MAX( 1., trb(ji,jj,jk,jpphy) * 1.e6 / 2. ) & 180 179 & * zetot1 * zetot2 & 181 180 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & … … 187 186 END DO 188 187 ! 189 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) THEN ! save output diagnostics 190 ! 191 CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) ) ! euphotic layer deptht 192 CALL iom_put( "LNnut" , xlimphy(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term 193 CALL iom_put( "LDnut" , xlimdia(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term 194 CALL iom_put( "LNFe" , xlimnfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term 195 CALL iom_put( "LDFe" , xlimdfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term 196 ! 188 ! 189 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics 190 IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) ) ! euphotic layer deptht 191 IF( iom_use( "LNnut" ) ) CALL iom_put( "LNnut" , xlimphy(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term 192 IF( iom_use( "LDnut" ) ) CALL iom_put( "LDnut" , xlimdia(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term 193 IF( iom_use( "LNFe" ) ) CALL iom_put( "LNFe" , xlimnfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term 194 IF( iom_use( "LDFe" ) ) CALL iom_put( "LDFe" , xlimdfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term 197 195 ENDIF 198 199 196 ! 200 197 IF( nn_timing == 1 ) CALL timing_stop('p4z_lim') … … 267 264 268 265 !!====================================================================== 269 END MODULE 266 END MODULE p4zlim -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r4624 r6225 48 48 CONTAINS 49 49 50 SUBROUTINE p4z_lys( kt )50 SUBROUTINE p4z_lys( kt, knt ) 51 51 !!--------------------------------------------------------------------- 52 52 !! *** ROUTINE p4z_lys *** … … 59 59 !!--------------------------------------------------------------------- 60 60 ! 61 INTEGER, INTENT(in) :: kt ! ocean time step61 INTEGER, INTENT(in) :: kt, knt ! ocean time step 62 62 INTEGER :: ji, jj, jk, jn 63 63 REAL(wp) :: zalk, zdic, zph, zah2 64 64 REAL(wp) :: zdispot, zfact, zcalcon, zalka, zaldi 65 65 REAL(wp) :: zomegaca, zexcess, zexcess0 66 REAL(wp) :: zrfact267 66 CHARACTER (len=25) :: charout 68 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss … … 81 80 DO jn = 1, 5 ! BEGIN OF ITERATION 82 81 ! 83 !CDIR NOVERRCHK84 82 DO jk = 1, jpkm1 85 !CDIR NOVERRCHK86 83 DO jj = 1, jpj 87 !CDIR NOVERRCHK88 84 DO ji = 1, jpi 89 85 zfact = rhop(ji,jj,jk) / 1000. + rtrn 90 86 zph = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 91 zdic = tr n(ji,jj,jk,jpdic) / zfact92 zalka = tr n(ji,jj,jk,jptal) / zfact87 zdic = trb(ji,jj,jk,jpdic) / zfact 88 zalka = trb(ji,jj,jk,jptal) / zfact 93 89 ! CALCULATE [ALK]([CO3--], [HCO3-]) 94 90 zalk = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) … … 130 126 ! (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 131 127 ! CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 132 zdispot = kdca * zexcess * tr n(ji,jj,jk,jpcal)128 zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal) 133 129 # if defined key_degrad 134 130 zdispot = zdispot * facvol(ji,jj,jk) … … 136 132 ! CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 137 133 ! AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 138 zcaldiss(ji,jj,jk) = zdispot / rmtss! calcite dissolution139 zco3(ji,jj,jk) = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact134 zcaldiss(ji,jj,jk) = zdispot * rfact2 / rmtss ! calcite dissolution 135 zco3(ji,jj,jk) = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) 140 136 ! 141 137 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) … … 146 142 END DO 147 143 ! 148 IF( ln_diatrc ) THEN 149 ! 150 IF( lk_iomput ) THEN 151 zrfact2 = 1.e3 * rfact2r 152 CALL iom_put( "PH" , -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) ) 153 CALL iom_put( "CO3" , zco3 (:,:,:) * 1e+3 * tmask(:,:,:) ) 154 CALL iom_put( "CO3sat", aksp (:,:,:) * 1e+3 / calcon * tmask(:,:,:) ) 155 CALL iom_put( "DCAL" , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 156 ELSE 157 trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 158 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 159 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 160 ENDIF 161 ! 144 145 IF( lk_iomput .AND. knt == nrdttrc ) THEN 146 IF( iom_use( "PH" ) ) CALL iom_put( "PH" , -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) ) 147 IF( iom_use( "CO3" ) ) CALL iom_put( "CO3" , zco3(:,:,:) * 1.e+3 * tmask(:,:,:) ) 148 IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", aksp(:,:,:) * 1.e+3 / calcon * tmask(:,:,:) ) 149 IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 150 ELSE 151 trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 152 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 153 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 162 154 ENDIF 163 155 ! … … 228 220 #endif 229 221 !!====================================================================== 230 END MODULE 222 END MODULE p4zlys -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r4624 r6225 50 50 REAL(wp), PUBLIC :: grazflux !: mesozoo flux feeding rate 51 51 52 !!* Substitution53 # include "top_substitute.h90"54 52 !!---------------------------------------------------------------------- 55 53 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 60 58 CONTAINS 61 59 62 SUBROUTINE p4z_meso( kt, jnt )60 SUBROUTINE p4z_meso( kt, knt ) 63 61 !!--------------------------------------------------------------------- 64 62 !! *** ROUTINE p4z_meso *** … … 68 66 !! ** Method : - ??? 69 67 !!--------------------------------------------------------------------- 70 INTEGER, INTENT(in) :: kt, jnt ! ocean time step68 INTEGER, INTENT(in) :: kt, knt ! ocean time step 71 69 INTEGER :: ji, jj, jk 72 70 REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam … … 83 81 REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg 84 82 CHARACTER (len=25) :: charout 85 REAL(wp) :: zrfact2 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d 87 84 88 85 !!--------------------------------------------------------------------- … … 90 87 IF( nn_timing == 1 ) CALL timing_start('p4z_meso') 91 88 ! 92 IF( l n_diatrc .AND. lk_iomput ) THEN89 IF( lk_iomput ) THEN 93 90 CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 94 91 zgrazing(:,:,:) = 0._wp … … 98 95 DO jj = 1, jpj 99 96 DO ji = 1, jpi 100 zcompam = MAX( ( tr n(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )97 zcompam = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 101 98 # if defined key_degrad 102 99 zstep = xstep * facvol(ji,jj,jk) … … 108 105 ! Respiration rates of both zooplankton 109 106 ! ------------------------------------- 110 zrespz2 = resrat2 * zfact * tr n(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) &107 zrespz2 = resrat2 * zfact * trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) ) & 111 108 & + resrat2 * zfact * 3. * nitrfac(ji,jj,jk) 112 109 … … 114 111 ! no real reason except that it seems to be more stable and may mimic predation 115 112 ! --------------------------------------------------------------- 116 ztortz2 = mzrat2 * 1.e6 * zfact * tr n(ji,jj,jk,jpmes)113 ztortz2 = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes) 117 114 ! 118 zcompadi = MAX( ( tr n(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )119 zcompaz = MAX( ( tr n(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )115 zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 116 zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 120 117 ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 121 118 ! it is to predation by mesozooplankton 122 119 ! ------------------------------------------------------------------------------- 123 zcompaph = MAX( ( tr n(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &120 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) & 124 121 & * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 125 zcompapoc = MAX( ( tr n(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )122 zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 126 123 127 124 zfood = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc … … 129 126 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 130 127 zdenom2 = zdenom / ( zfood + rtrn ) 131 zgraze2 = grazrat2 * zstep * tgfunc2(ji,jj,jk) * tr n(ji,jj,jk,jpmes)128 zgraze2 = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) 132 129 133 130 zgrazd = zgraze2 * xprefc * zcompadi * zdenom2 … … 136 133 zgrazpoc = zgraze2 * xprefpoc * zcompapoc * zdenom2 137 134 138 zgraznf = zgrazn * tr n(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn)139 zgrazf = zgrazd * tr n(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn)140 zgrazpof = zgrazpoc * tr n(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn)135 zgraznf = zgrazn * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn) 136 zgrazf = zgrazd * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn) 137 zgrazpof = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 141 138 142 139 ! Mesozooplankton flux feeding on GOC … … 145 142 # if ! defined key_kriest 146 143 zgrazffeg = grazflux * zstep * wsbio4(ji,jj,jk) & 147 & * tgfunc2(ji,jj,jk) * tr n(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)148 zgrazfffg = zgrazffeg * tr n(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)144 & * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) 145 zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 149 146 # endif 150 147 zgrazffep = grazflux * zstep * wsbio3(ji,jj,jk) & 151 & * tgfunc2(ji,jj,jk) * tr n(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)152 zgrazfffp = zgrazffep * tr n(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)148 & * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) 149 zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 153 150 ! 154 151 # if ! defined key_kriest … … 159 156 ! diatoms based aggregates are more prone to fractionation 160 157 ! since they are more porous (marine snow instead of fecal pellets) 161 zratio = tr n(ji,jj,jk,jpgsi) / ( trn(ji,jj,jk,jpgoc) + rtrn )158 zratio = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 162 159 zratio2 = zratio * zratio 163 160 zfrac = zproport * grazflux * zstep * wsbio4(ji,jj,jk) & 164 & * tr n(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) &165 & * ( 0. 1 + 3.9* zratio2 / ( 1.**2 + zratio2 ) )166 zfracfe = zfrac * tr n(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)161 & * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) & 162 & * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 163 zfracfe = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 167 164 168 165 zgrazffep = zproport * zgrazffep … … 186 183 187 184 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 188 IF( l n_diatrc .AND. lk_iomput ) zgrazing(ji,jj,jk) = zgraztot185 IF( lk_iomput ) zgrazing(ji,jj,jk) = zgraztot 189 186 190 187 ! Mesozooplankton efficiency … … 216 213 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 217 214 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn 218 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * tr n(ji,jj,jk,jpnch) / ( trn(ji,jj,jk,jpphy) + rtrn )219 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * tr n(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )220 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * tr n(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )221 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * tr n(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )215 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn ) 216 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 217 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 218 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 222 219 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 223 220 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf … … 232 229 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 233 230 #if defined key_kriest 234 znumpoc = tr n(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )231 znumpoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 235 232 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortzgoc - zgrazpoc - zgrazffep + zgrapoc2 236 233 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc + zgrapoc2 * xkr_dmeso & … … 249 246 END DO 250 247 ! 251 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) THEN 252 zrfact2 = 1.e3 * rfact2r 253 CALL iom_put( "GRAZ2", zgrazing(:,:,:) * zrfact2 * tmask(:,:,:) ) ! Total grazing of phyto by zooplankton 254 CALL iom_put( "PCAL" , prodcal(:,:,:) * zrfact2 * tmask(:,:,:) ) ! Calcite production 248 IF( lk_iomput .AND. knt == nrdttrc ) THEN 249 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 250 IF( iom_use( "GRAZ2" ) ) THEN 251 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 252 CALL iom_put( "GRAZ2", zw3d ) 253 ENDIF 254 IF( iom_use( "PCAL" ) ) THEN 255 zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Calcite production 256 CALL iom_put( "PCAL", zw3d ) 257 ENDIF 258 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 255 259 ENDIF 256 260 ! … … 261 265 ENDIF 262 266 ! 263 IF( l n_diatrc .AND. lk_iomput ) CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )267 IF( lk_iomput ) CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 264 268 ! 265 269 IF( nn_timing == 1 ) CALL timing_stop('p4z_meso') … … 334 338 335 339 !!====================================================================== 336 END MODULE 340 END MODULE p4zmeso -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r4624 r6225 49 49 50 50 51 !!* Substitution52 # include "top_substitute.h90"53 51 !!---------------------------------------------------------------------- 54 52 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 59 57 CONTAINS 60 58 61 SUBROUTINE p4z_micro( kt, jnt )59 SUBROUTINE p4z_micro( kt, knt ) 62 60 !!--------------------------------------------------------------------- 63 61 !! *** ROUTINE p4z_micro *** … … 68 66 !!--------------------------------------------------------------------- 69 67 INTEGER, INTENT(in) :: kt ! ocean time step 70 INTEGER, INTENT(in) :: jnt68 INTEGER, INTENT(in) :: knt 71 69 ! 72 70 INTEGER :: ji, jj, jk … … 79 77 REAL(wp) :: zgrazp, zgrazm, zgrazsd 80 78 REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 81 REAL(wp) :: zrfact2 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d 83 80 CHARACTER (len=25) :: charout 84 81 !!--------------------------------------------------------------------- … … 86 83 IF( nn_timing == 1 ) CALL timing_start('p4z_micro') 87 84 ! 88 IF( l n_diatrc .AND. lk_iomput ) CALL wrk_alloc( jpi, jpj, jpk, zgrazing )85 IF( lk_iomput ) CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 89 86 ! 90 87 DO jk = 1, jpkm1 91 88 DO jj = 1, jpj 92 89 DO ji = 1, jpi 93 zcompaz = MAX( ( tr n(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )90 zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 94 91 zstep = xstep 95 92 # if defined key_degrad … … 100 97 ! Respiration rates of both zooplankton 101 98 ! ------------------------------------- 102 zrespz = resrat * zfact * tr n(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) &99 zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) ) & 103 100 & + resrat * zfact * 3. * nitrfac(ji,jj,jk) 104 101 … … 106 103 ! no real reason except that it seems to be more stable and may mimic predation. 107 104 ! --------------------------------------------------------------- 108 ztortz = mzrat * 1.e6 * zfact * tr n(ji,jj,jk,jpzoo)109 110 zcompadi = MIN( MAX( ( tr n(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )111 zcompaph = MAX( ( tr n(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )112 zcompapoc = MAX( ( tr n(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )105 ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) 106 107 zcompadi = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 108 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 109 zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 113 110 114 111 ! Microzooplankton grazing … … 118 115 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 119 116 zdenom2 = zdenom / ( zfood + rtrn ) 120 zgraze = grazrat * zstep * tgfunc2(ji,jj,jk) * tr n(ji,jj,jk,jpzoo)117 zgraze = grazrat * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) 121 118 122 119 zgrazp = zgraze * xpref2p * zcompaph * zdenom2 … … 124 121 zgrazsd = zgraze * xpref2d * zcompadi * zdenom2 125 122 126 zgrazpf = zgrazp * tr n(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)127 zgrazmf = zgrazm * tr n(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)128 zgrazsf = zgrazsd * tr n(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)123 zgrazpf = zgrazp * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn) 124 zgrazmf = zgrazm * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 125 zgrazsf = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 129 126 ! 130 127 zgraztot = zgrazp + zgrazm + zgrazsd … … 137 134 ! Various remineralization and excretion terms 138 135 ! -------------------------------------------- 139 zgrasrat = zgraztotf/ ( zgraztot + rtrn )140 zgrasratn = zgraztotn/ ( zgraztot + rtrn )136 zgrasrat = ( zgraztotf + rtrn ) / ( zgraztot + rtrn ) 137 zgrasratn = ( zgraztotn + rtrn ) / ( zgraztot + rtrn ) 141 138 zepshert = MIN( 1., zgrasratn, zgrasrat / ferat3) 142 139 zepsherv = zepshert * MIN( epsher, (1. - unass) * zgrasrat / ferat3, (1. - unass) * zgrasratn ) … … 166 163 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 167 164 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 168 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp * tr n(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)169 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * tr n(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn)170 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * tr n(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn)171 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * tr n(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn)165 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 166 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn) 167 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 168 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 172 169 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf 173 170 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf … … 185 182 #if defined key_kriest 186 183 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zmortz * xkr_dmicro & 187 - zgrazm * tr n(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )184 - zgrazm * trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 188 185 #endif 189 186 END DO … … 191 188 END DO 192 189 ! 193 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) THEN 194 zrfact2 = 1.e3 * rfact2r 195 CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * zrfact2 * tmask(:,:,:) ) ! Total grazing of phyto by zooplankton 190 IF( lk_iomput .AND. knt == nrdttrc ) THEN 191 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 192 IF( iom_use( "GRAZ1" ) ) THEN 193 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 194 CALL iom_put( "GRAZ1", zw3d ) 195 ENDIF 196 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 196 197 ENDIF 197 198 ! … … 202 203 ENDIF 203 204 ! 204 IF( l n_diatrc .AND. lk_iomput ) CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )205 IF( lk_iomput ) CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 205 206 ! 206 207 IF( nn_timing == 1 ) CALL timing_stop('p4z_micro') … … 270 271 271 272 !!====================================================================== 272 END MODULE 273 END MODULE p4zmicro -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
- Property svn:keywords set to Id
r4624 r6225 35 35 36 36 37 !!* Substitution38 # include "top_substitute.h90"39 37 !!---------------------------------------------------------------------- 40 38 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 41 !! $Id : p4zmort.F90 3160 2011-11-20 14:27:18Z cetlod$39 !! $Id$ 42 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 41 !!---------------------------------------------------------------------- … … 85 83 DO jj = 1, jpj 86 84 DO ji = 1, jpi 87 zcompaph = MAX( ( tr n(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )85 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 88 86 zstep = xstep 89 87 # if defined key_degrad … … 94 92 ! due to turbulence is negligible. Mortality is also set 95 93 ! to 0 96 zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * tr n(ji,jj,jk,jpphy)94 zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trb(ji,jj,jk,jpphy) 97 95 ! Squared mortality of Phyto similar to a sedimentation term during 98 96 ! blooms (Doney et al. 1996) … … 102 100 ! increased when nutrients are limiting phytoplankton growth 103 101 ! as observed for instance in case of iron limitation. 104 ztortp = mprat * xstep * zcompaph / ( xkmort + tr n(ji,jj,jk,jpphy) ) * zsizerat102 ztortp = mprat * xstep * zcompaph / ( xkmort + trb(ji,jj,jk,jpphy) ) * zsizerat 105 103 106 104 zmortp = zrespp + ztortp … … 108 106 ! Update the arrays TRA which contains the biological sources and sinks 109 107 110 zfactfe = tr n(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn)111 zfactch = tr n(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)108 zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn) 109 zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 112 110 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp 113 111 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch … … 172 170 DO ji = 1, jpi 173 171 174 zcompadi = MAX( ( tr n(ji,jj,jk,jpdia) - 1e-9), 0. )172 zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1e-9), 0. ) 175 173 176 174 ! Aggregation term for diatoms is increased in case of nutrient … … 186 184 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 187 185 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 188 zrespp2 = 1.e6 * zstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr n(ji,jj,jk,jpdia)186 zrespp2 = 1.e6 * zstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 189 187 190 188 ! Phytoplankton mortality. 191 189 ! ------------------------ 192 ztortp2 = mprat2 * zstep * tr n(ji,jj,jk,jpdia) / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi190 ztortp2 = mprat2 * zstep * trb(ji,jj,jk,jpdia) / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi 193 191 194 192 zmortp2 = zrespp2 + ztortp2 … … 196 194 ! Update the arrays tra which contains the biological sources and sinks 197 195 ! --------------------------------------------------------------------- 198 zfactch = tr n(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )199 zfactfe = tr n(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )200 zfactsi = tr n(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )196 zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 197 zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 198 zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 201 199 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 202 200 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch … … 277 275 278 276 !!====================================================================== 279 END MODULE 277 END MODULE p4zmort -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r4624 r6225 35 35 REAL(wp) :: parlux !: Fraction of shortwave as PAR 36 36 REAL(wp) :: xparsw !: parlux/3 37 REAL(wp) :: xsi0r !: 1. /rn_si0 37 38 38 39 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_par ! structure of input par … … 42 43 43 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat !: PAR for phyto, nano and diat 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy !: PAR over 24h in case of diurnal cycle 44 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy !: averaged PAR in the mixed layer 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr !: wavelength (Red-Green-Blue) 45 48 46 49 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) … … 48 51 REAL(wp), DIMENSION(3,61), PUBLIC :: xkrgb !: tabulated attenuation coefficients for RGB absorption 49 52 50 !!* Substitution51 # include "top_substitute.h90"52 53 !!---------------------------------------------------------------------- 53 54 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 57 58 CONTAINS 58 59 59 SUBROUTINE p4z_opt( kt, jnt )60 SUBROUTINE p4z_opt( kt, knt ) 60 61 !!--------------------------------------------------------------------- 61 62 !! *** ROUTINE p4z_opt *** … … 67 68 !!--------------------------------------------------------------------- 68 69 ! 69 INTEGER, INTENT(in) :: kt, jnt ! ocean time step70 INTEGER, INTENT(in) :: kt, knt ! ocean time step 70 71 ! 71 72 INTEGER :: ji, jj, jk 72 73 INTEGER :: irgb 73 REAL(wp) :: zchl , zxsi0r74 REAL(wp) :: zchl 74 75 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 75 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp , zetmp1, zetmp276 REAL(wp), POINTER, DIMENSION(:,:,:) :: z ekg, zekr, zekb, ze0, ze1, ze2, ze376 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 77 78 !!--------------------------------------------------------------------- 78 79 ! … … 80 81 ! 81 82 ! Allocate temporary workspace 82 CALL wrk_alloc( jpi, jpj, z depmoy, zetmp, zetmp1, zetmp2 )83 CALL wrk_alloc( jpi, jpj, jpk, z ekg, zekr, zekb, ze0, ze1, ze2, ze3 )84 85 IF( jnt == 1 .AND. ln_varpar ) CALL p4z_optsbc( kt )83 CALL wrk_alloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 84 CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 85 86 IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 86 87 87 88 ! Initialisation of variables used to compute PAR 88 89 ! ----------------------------------------------- 89 ze1(:,:,jpk) = 0._wp 90 ze2(:,:,jpk) = 0._wp 91 ze3(:,:,jpk) = 0._wp 92 90 ze1(:,:,:) = 0._wp 91 ze2(:,:,:) = 0._wp 92 ze3(:,:,:) = 0._wp 93 93 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 94 94 DO jk = 1, jpkm1 ! -------------------------------------------------------- 95 !CDIR NOVERRCHK96 95 DO jj = 1, jpj 97 !CDIR NOVERRCHK98 96 DO ji = 1, jpi 99 zchl = ( tr n(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e697 zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6 100 98 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 101 99 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 102 100 ! 103 zekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)104 zekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)105 zekr(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 108 106 END DO 109 110 111 107 ! !* Photosynthetically Available Radiation (PAR) 112 108 ! ! -------------------------------------- 113 114 IF( ln_varpar ) THEN 115 ze1(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) ) 116 ze2(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) ) 117 ze3(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) ) 109 IF( l_trcdm2dc ) THEN ! diurnal cycle 110 ! 1% of qsr to compute euphotic layer 111 zqsr100(:,:) = 0.01 * qsr_mean(:,:) ! daily mean qsr 112 ! 113 CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3 ) 114 ! 115 DO jk = 1, nksrp 116 etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 117 enano (:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 118 ediat (:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 119 END DO 120 ! 121 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 122 ! 123 DO jk = 1, nksrp 124 etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 125 END DO 126 ! 118 127 ELSE 119 ze1(:,:,1) = xparsw * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) ) 120 ze2(:,:,1) = xparsw * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) ) 121 ze3(:,:,1) = xparsw * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) ) 122 ENDIF 123 124 !CDIR NOVERRCHK 125 DO jj = 1, jpj 126 !CDIR NOVERRCHK 127 DO ji = 1, jpi 128 zc1 = ze1(ji,jj,1) 129 zc2 = ze2(ji,jj,1) 130 zc3 = ze3(ji,jj,1) 131 etot (ji,jj,1) = ( zc1 + zc2 + zc3 ) 132 enano(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 ) 133 ediat(ji,jj,1) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 ) 134 END DO 135 END DO 136 137 138 DO jk = 2, nksrp 139 !CDIR NOVERRCHK 140 DO jj = 1, jpj 141 !CDIR NOVERRCHK 142 DO ji = 1, jpi 143 zc1 = ze1(ji,jj,jk-1) * EXP( -0.5 * ( zekb(ji,jj,jk-1) + zekb(ji,jj,jk) ) ) 144 zc2 = ze2(ji,jj,jk-1) * EXP( -0.5 * ( zekg(ji,jj,jk-1) + zekg(ji,jj,jk) ) ) 145 zc3 = ze3(ji,jj,jk-1) * EXP( -0.5 * ( zekr(ji,jj,jk-1) + zekr(ji,jj,jk) ) ) 146 ze1 (ji,jj,jk) = zc1 147 ze2 (ji,jj,jk) = zc2 148 ze3 (ji,jj,jk) = zc3 149 etot (ji,jj,jk) = ( zc1 + zc2 + zc3 ) 150 enano(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 ) 151 ediat(ji,jj,jk) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 ) 152 END DO 153 END DO 154 END DO 128 ! 1% of qsr to compute euphotic layer 129 zqsr100(:,:) = 0.01 * qsr(:,:) 130 ! 131 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 132 ! 133 DO jk = 1, nksrp 134 etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 135 enano(:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 136 ediat(:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 137 END DO 138 etot_ndcy(:,:,:) = etot(:,:,:) 139 ENDIF 140 155 141 156 142 IF( ln_qsr_bio ) THEN !* heat flux accros w-level (used in the dynamics) 157 143 ! ! ------------------------ 158 zxsi0r = 1.e0 / rn_si0 159 ! 160 ze0(:,:,1) = rn_abs * qsr(:,:) 161 ! ! surface value : separation in R-G-B + near surface 162 IF( ln_varpar ) THEN 163 ze0(:,:,1) = ( 1. - 3. * par_varsw(:,:) ) * qsr(:,:) 164 ze1(:,:,1) = par_varsw(:,:) * qsr(:,:) 165 ze2(:,:,1) = par_varsw(:,:) * qsr(:,:) 166 ze3(:,:,1) = par_varsw(:,:) * qsr(:,:) 167 ELSE 168 ze0(:,:,1) = ( 1. - 3. * xparsw ) * qsr(:,:) 169 ze1(:,:,1) = xparsw * qsr(:,:) 170 ze2(:,:,1) = xparsw * qsr(:,:) 171 ze3(:,:,1) = xparsw * qsr(:,:) 172 ENDIF 144 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 145 ! 173 146 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 174 !175 !176 147 DO jk = 2, nksrp + 1 177 !CDIR NOVERRCHK 178 DO jj = 1, jpj 179 !CDIR NOVERRCHK 180 DO ji = 1, jpi 181 zc0 = ze0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * zxsi0r ) 182 zc1 = ze1(ji,jj,jk-1) * EXP( -zekb(ji,jj,jk-1 ) ) 183 zc2 = ze2(ji,jj,jk-1) * EXP( -zekg(ji,jj,jk-1 ) ) 184 zc3 = ze3(ji,jj,jk-1) * EXP( -zekr(ji,jj,jk-1 ) ) 185 ze0(ji,jj,jk) = zc0 186 ze1(ji,jj,jk) = zc1 187 ze2(ji,jj,jk) = zc2 188 ze3(ji,jj,jk) = zc3 189 etot3(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk) 190 END DO 191 ! 192 END DO 193 ! 194 END DO 195 ! 196 ENDIF 197 148 etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 149 END DO 150 ! ! ------------------------ 151 ENDIF 198 152 ! !* Euphotic depth and level 199 153 neln(:,:) = 1 ! ------------------------ … … 203 157 DO jj = 1, jpj 204 158 DO ji = 1, jpi 205 IF( etot (ji,jj,jk) * tmask(ji,jj,jk) >= 0.0043 * qsr(ji,jj) ) THEN159 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.43 * zqsr100(ji,jj) ) THEN 206 160 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 207 161 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 208 heup(ji,jj) = fsdepw(ji,jj,jk+1)! Euphotic layer depth162 heup(ji,jj) = gdepw_n(ji,jj,jk+1) ! Euphotic layer depth 209 163 ENDIF 210 164 END DO 211 165 END DO 212 166 END DO 213 167 ! 214 168 heup(:,:) = MIN( 300., heup(:,:) ) 215 216 169 ! !* mean light over the mixed layer 217 170 zdepmoy(:,:) = 0.e0 ! ------------------------------- 218 zetmp (:,:) = 0.e0219 171 zetmp1 (:,:) = 0.e0 220 172 zetmp2 (:,:) = 0.e0 173 zetmp3 (:,:) = 0.e0 174 zetmp4 (:,:) = 0.e0 221 175 222 176 DO jk = 1, nksrp 223 !CDIR NOVERRCHK224 177 DO jj = 1, jpj 225 !CDIR NOVERRCHK226 178 DO ji = 1, jpi 227 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 228 zetmp (ji,jj) = zetmp (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) 229 zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk) 230 zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk) 231 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) 232 185 ENDIF 233 186 END DO … … 235 188 END DO 236 189 ! 237 emoy(:,:,:) = etot(:,:,:) 190 emoy(:,:,:) = etot(:,:,:) ! remineralisation 191 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 238 192 ! 239 193 DO jk = 1, nksrp 240 !CDIR NOVERRCHK241 194 DO jj = 1, jpj 242 !CDIR NOVERRCHK243 195 DO ji = 1, jpi 244 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN196 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 245 197 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 246 emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep 247 enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep 248 ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep 198 emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 199 zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 200 enano(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 201 ediat(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 249 202 ENDIF 250 203 END DO 251 204 END DO 252 205 END DO 253 254 IF( ln_diatrc ) THEN ! save output diagnostics 206 ! 207 IF( lk_iomput ) THEN 208 IF( knt == nrdttrc ) THEN 209 IF( iom_use( "Heup" ) ) CALL iom_put( "Heup" , heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht 210 IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 211 IF( iom_use( "PAR" ) ) CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 212 ENDIF 213 ELSE 214 IF( ln_diatrc ) THEN ! save output diagnostics 215 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1) 216 trc3d(:,:,:,jp_pcs0_3d + 3) = etot(:,:,:) * tmask(:,:,:) 217 ENDIF 218 ENDIF 219 ! 220 CALL wrk_dealloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 221 CALL wrk_dealloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 222 ! 223 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt') 224 ! 225 END SUBROUTINE p4z_opt 226 227 SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 ) 228 !!---------------------------------------------------------------------- 229 !! *** routine p4z_opt_par *** 230 !! 231 !! ** purpose : compute PAR of each wavelength (Red-Green-Blue) 232 !! for a given shortwave radiation 233 !! 234 !!---------------------------------------------------------------------- 235 !! * arguments 236 INTEGER, INTENT(in) :: kt ! ocean time-step 237 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqsr ! shortwave 238 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 239 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 240 !! * local variables 241 INTEGER :: ji, jj, jk ! dummy loop indices 242 REAL(wp), DIMENSION(jpi,jpj) :: zqsr ! shortwave 243 !!---------------------------------------------------------------------- 244 245 ! Real shortwave 246 IF( ln_varpar ) THEN ; zqsr(:,:) = par_varsw(:,:) * pqsr(:,:) 247 ELSE ; zqsr(:,:) = xparsw * pqsr(:,:) 248 ENDIF 249 ! 250 IF( PRESENT( pe0 ) ) THEN ! W-level 251 ! 252 pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:) ! ( 1 - 3 * alpha ) * q 253 pe1(:,:,1) = zqsr(:,:) 254 pe2(:,:,1) = zqsr(:,:) 255 pe3(:,:,1) = zqsr(:,:) 256 ! 257 DO jk = 2, nksrp + 1 258 DO jj = 1, jpj 259 DO ji = 1, jpi 260 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 261 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) ) 262 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) ) 263 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) ) 264 END DO 265 ! 266 END DO 267 ! 268 END DO 255 269 ! 256 IF( lk_iomput ) THEN 257 IF( jnt == nrdttrc ) THEN 258 CALL iom_put( "Heup", heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht 259 CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 260 ENDIF 261 ELSE 262 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1) 263 trc3d(:,:,:,jp_pcs0_3d + 3) = etot(:,:,:) * tmask(:,:,:) 264 ENDIF 270 ELSE ! T- level 265 271 ! 266 ENDIF 267 ! 268 CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp, zetmp1, zetmp2 ) 269 CALL wrk_dealloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 270 ! 271 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt') 272 ! 273 END SUBROUTINE p4z_opt 274 275 SUBROUTINE p4z_optsbc( kt ) 276 !!---------------------------------------------------------------------- 277 !! *** routine p4z_optsbc *** 272 pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) ) 273 pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) ) 274 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 275 ! 276 DO jk = 2, nksrp 277 DO jj = 1, jpj 278 DO ji = 1, jpi 279 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 280 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 281 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 282 END DO 283 END DO 284 END DO 285 ! 286 ENDIF 287 ! 288 END SUBROUTINE p4z_opt_par 289 290 291 SUBROUTINE p4z_opt_sbc( kt ) 292 !!---------------------------------------------------------------------- 293 !! *** routine p4z_opt_sbc *** 278 294 !! 279 295 !! ** purpose : read and interpolate the variable PAR fraction … … 286 302 !!---------------------------------------------------------------------- 287 303 !! * arguments 288 INTEGER , INTENT( in ) :: kt! ocean time step304 INTEGER , INTENT(in) :: kt ! ocean time step 289 305 290 306 !! * local declarations … … 299 315 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN 300 316 CALL fld_read( kt, 1, sf_par ) 301 par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) /3.0317 par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0 302 318 ENDIF 303 319 ENDIF … … 305 321 IF( nn_timing == 1 ) CALL timing_stop('p4z_optsbc') 306 322 ! 307 END SUBROUTINE p4z_opt sbc323 END SUBROUTINE p4z_opt_sbc 308 324 309 325 SUBROUTINE p4z_opt_init … … 349 365 ! 350 366 xparsw = parlux / 3.0 367 xsi0r = 1.e0 / rn_si0 351 368 ! 352 369 ! Variable PAR at the surface of the ocean … … 374 391 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 375 392 ! 376 etot (:,:,:) = 0._wp 377 enano(:,:,:) = 0._wp 378 ediat(:,:,:) = 0._wp 379 IF( ln_qsr_bio ) etot3(:,:,:) = 0._wp 393 ekr (:,:,:) = 0._wp 394 ekb (:,:,:) = 0._wp 395 ekg (:,:,:) = 0._wp 396 etot (:,:,:) = 0._wp 397 etot_ndcy(:,:,:) = 0._wp 398 enano (:,:,:) = 0._wp 399 ediat (:,:,:) = 0._wp 400 IF( ln_qsr_bio ) etot3 (:,:,:) = 0._wp 380 401 ! 381 402 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt_init') … … 388 409 !! *** ROUTINE p4z_opt_alloc *** 389 410 !!---------------------------------------------------------------------- 390 ALLOCATE( enano(jpi,jpj,jpk), ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 411 ALLOCATE( ekb(jpi,jpj,jpk) , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk), & 412 & enano(jpi,jpj,jpk) , ediat(jpi,jpj,jpk), & 413 & etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 391 414 ! 392 415 IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') … … 404 427 405 428 !!====================================================================== 406 END MODULE 429 END MODULE p4zopt -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r4624 r6225 54 54 REAL(wp) :: texcret2 !: 1 - excret2 55 55 56 57 !!* Substitution58 # include "top_substitute.h90"59 56 !!---------------------------------------------------------------------- 60 57 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 64 61 CONTAINS 65 62 66 SUBROUTINE p4z_prod( kt , jnt )63 SUBROUTINE p4z_prod( kt , knt ) 67 64 !!--------------------------------------------------------------------- 68 65 !! *** ROUTINE p4z_prod *** … … 74 71 !!--------------------------------------------------------------------- 75 72 ! 76 INTEGER, INTENT(in) :: kt, jnt73 INTEGER, INTENT(in) :: kt, knt 77 74 ! 78 75 INTEGER :: ji, jj, jk … … 83 80 REAL(wp) :: zpislopen , zpislope2n 84 81 REAL(wp) :: zrum, zcodel, zargu, zval 85 REAL(wp) :: z rfact282 REAL(wp) :: zfact 86 83 CHARACTER (len=25) :: charout 87 REAL(wp), POINTER, DIMENSION(:,: ) :: zmixnano, zmixdiat, zstrn 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt 84 REAL(wp), POINTER, DIMENSION(:,: ) :: zmixnano, zmixdiat, zstrn, zw2d 85 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt, zw3d 89 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd 90 87 !!--------------------------------------------------------------------- … … 129 126 END DO 130 127 131 IF( ln_newprod ) THEN 132 ! Impact of the day duration on phytoplankton growth 133 DO jk = 1, jpkm1 134 DO jj = 1 ,jpj 135 DO ji = 1, jpi 136 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 137 zval = MAX( 1., zstrn(ji,jj) ) 138 zval = 1.5 * zval / ( 12. + zval ) 139 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 140 zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 141 ENDIF 142 END DO 143 END DO 144 END DO 145 ENDIF 128 ! Impact of the day duration on phytoplankton growth 129 DO jk = 1, jpkm1 130 DO jj = 1 ,jpj 131 DO ji = 1, jpi 132 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 133 zval = MAX( 1., zstrn(ji,jj) ) 134 zval = 1.5 * zval / ( 12. + zval ) 135 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 136 zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 137 ENDIF 138 END DO 139 END DO 140 END DO 146 141 147 142 ! Maximum light intensity … … 150 145 151 146 IF( ln_newprod ) THEN 152 !CDIR NOVERRCHK153 147 DO jk = 1, jpkm1 154 !CDIR NOVERRCHK155 148 DO jj = 1, jpj 156 !CDIR NOVERRCHK157 149 DO ji = 1, jpi 158 150 ! Computation of the P-I slope for nanos and diatoms 159 IF( etot (ji,jj,jk) > 1.E-3 ) THEN151 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 160 152 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 161 153 zadap = xadap * ztn / ( 2.+ ztn ) 162 zconctemp = MAX( 0.e0 , tr n(ji,jj,jk,jpdia) - xsizedia )163 zconctemp2 = tr n(ji,jj,jk,jpdia) - zconctemp154 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 155 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp 164 156 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 165 157 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 166 158 ! 167 159 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) ) & 168 & * tr n(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn)160 & * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 169 161 ! 170 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( tr n(ji,jj,jk,jpdia) + rtrn ) &171 & * tr n(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn)162 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) & 163 & * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 172 164 173 165 ! Computation of production function for Carbon … … 188 180 END DO 189 181 ELSE 190 !CDIR NOVERRCHK191 182 DO jk = 1, jpkm1 192 !CDIR NOVERRCHK193 183 DO jj = 1, jpj 194 !CDIR NOVERRCHK195 184 DO ji = 1, jpi 196 185 197 186 ! Computation of the P-I slope for nanos and diatoms 198 IF( etot (ji,jj,jk) > 1.E-3 ) THEN187 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 199 188 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 200 189 zadap = ztn / ( 2.+ ztn ) 201 zconctemp = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia ) 202 zconctemp2 = trn(ji,jj,jk,jpdia) - zconctemp 190 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 191 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp 192 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 193 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 203 194 ! 204 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( - 0.21 * enano(ji,jj,jk)) )205 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( tr n(ji,jj,jk,jpdia) + rtrn )206 207 zpislopen = zpislopead(ji,jj,jk) * tr n(ji,jj,jk,jpnch) &208 & / ( tr n(ji,jj,jk,jpphy) * 12. + rtrn ) &195 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) ) 196 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) 197 198 zpislopen = zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) & 199 & / ( trb(ji,jj,jk,jpphy) * 12. + rtrn ) & 209 200 & / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 210 201 211 zpislope2n = zpislopead2(ji,jj,jk) * tr n(ji,jj,jk,jpdch) &212 & / ( tr n(ji,jj,jk,jpdia) * 12. + rtrn ) &202 zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) & 203 & / ( trb(ji,jj,jk,jpdia) * 12. + rtrn ) & 213 204 & / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 214 205 215 206 ! Computation of production function for Carbon 216 207 ! --------------------------------------------- 217 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk)) )218 zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk)) )208 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 209 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 219 210 220 211 ! Computation of production function for Chlorophyll 221 212 !-------------------------------------------------- 222 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) * zstrn(ji,jj)) )223 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj)) )213 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 214 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 224 215 ENDIF 225 216 END DO … … 231 222 ! Computation of a proxy of the N/C ratio 232 223 ! --------------------------------------- 233 !CDIR NOVERRCHK234 224 DO jk = 1, jpkm1 235 !CDIR NOVERRCHK236 225 DO jj = 1, jpj 237 !CDIR NOVERRCHK238 226 DO ji = 1, jpi 239 227 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) ) & … … 252 240 DO ji = 1, jpi 253 241 254 IF( etot (ji,jj,jk) > 1.E-3 ) THEN242 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 255 243 ! Si/C of diatoms 256 244 ! ------------------------ … … 258 246 ! Si/C is arbitrariliy increased for very high Si concentrations 259 247 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 260 zlim = tr n(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 )248 zlim = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 ) 261 249 zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 262 250 zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 263 zsiborn = tr n(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil)251 zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) 264 252 IF (gphit(ji,jj) < -30 ) THEN 265 253 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) … … 287 275 DO jj = 1, jpj 288 276 DO ji = 1, jpi 289 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN277 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 290 278 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 291 279 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) … … 296 284 297 285 ! Computation of the various production terms 298 !CDIR NOVERRCHK299 286 DO jk = 1, jpkm1 300 !CDIR NOVERRCHK301 287 DO jj = 1, jpj 302 !CDIR NOVERRCHK303 288 DO ji = 1, jpi 304 IF( etot (ji,jj,jk) > 1.E-3 ) THEN289 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 305 290 ! production terms for nanophyto. 306 zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr n(ji,jj,jk,jpphy) * rfact2291 zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 307 292 zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 308 293 ! 309 zratio = tr n(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn )294 zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 310 295 zratio = zratio / fecnm 311 296 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) … … 313 298 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 314 299 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 315 & * zmax * tr n(ji,jj,jk,jpphy) * rfact2300 & * zmax * trb(ji,jj,jk,jpphy) * rfact2 316 301 ! production terms for diatomees 317 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr n(ji,jj,jk,jpdia) * rfact2302 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 318 303 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 319 304 ! 320 zratio = tr n(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )305 zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 321 306 zratio = zratio / fecdm 322 307 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) … … 324 309 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 325 310 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & 326 & * zmax * tr n(ji,jj,jk,jpdia) * rfact2311 & * zmax * trb(ji,jj,jk,jpdia) * rfact2 327 312 ENDIF 328 313 END DO … … 331 316 332 317 IF( ln_newprod ) THEN 333 !CDIR NOVERRCHK334 318 DO jk = 1, jpkm1 335 !CDIR NOVERRCHK336 319 DO jj = 1, jpj 337 !CDIR NOVERRCHK338 320 DO ji = 1, jpi 339 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN321 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 340 322 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 341 323 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 342 324 ENDIF 343 IF( etot (ji,jj,jk) > 1.E-3 ) THEN325 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 344 326 ! production terms for nanophyto. ( chlorophyll ) 345 327 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) … … 359 341 END DO 360 342 ELSE 361 !CDIR NOVERRCHK362 343 DO jk = 1, jpkm1 363 !CDIR NOVERRCHK364 344 DO jj = 1, jpj 365 !CDIR NOVERRCHK366 345 DO ji = 1, jpi 367 IF( etot (ji,jj,jk) > 1.E-3 ) THEN346 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 368 347 ! production terms for nanophyto. ( chlorophyll ) 369 znanotot = enano(ji,jj,jk) * zstrn(ji,jj)370 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * tr n(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk)348 znanotot = enano(ji,jj,jk) 349 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trb(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk) 371 350 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 372 351 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 144. * zprod & 373 & / ( zpislopead(ji,jj,jk) * tr n(ji,jj,jk,jpnch) * znanotot +rtrn )352 & / ( zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) * znanotot +rtrn ) 374 353 ! production terms for diatomees ( chlorophyll ) 375 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)376 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * tr n(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk)354 zdiattot = ediat(ji,jj,jk) 355 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trb(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk) 377 356 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 378 357 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 144. * zprod & 379 & / ( zpislopead2(ji,jj,jk) * tr n(ji,jj,jk,jpdch) * zdiattot +rtrn )358 & / ( zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) * zdiattot +rtrn ) 380 359 ENDIF 381 360 END DO … … 412 391 END DO 413 392 414 ! Total primary production per year 415 tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 416 417 IF( ln_diatrc ) THEN 418 ! 419 zrfact2 = 1.e3 * rfact2r ! conversion from mol/L/timestep into mol/m3/s 420 IF( lk_iomput ) THEN 421 IF( jnt == nrdttrc ) THEN 422 CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by nanophyto 423 CALL iom_put( "PPPHY2" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by diatom 424 CALL iom_put( "PPNEWN" , zpronew (:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by nanophyto 425 CALL iom_put( "PPNEWD" , zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by diatom 426 CALL iom_put( "PBSi" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 427 CALL iom_put( "PFeD" , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by diatom 428 CALL iom_put( "PFeN" , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by nanophyto 429 CALL iom_put( "Mumax" , prmax(:,:,:) * tmask(:,:,:) ) ! Maximum growth rate 430 CALL iom_put( "MuN" , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto 431 CALL iom_put( "MuD" , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms 432 CALL iom_put( "LNlight", zprbio (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term 433 CALL iom_put( "LDlight", zprdia (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term 434 ENDIF 435 ELSE 436 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 437 trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 438 trc3d(:,:,:,jp_pcs0_3d + 6) = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 439 trc3d(:,:,:,jp_pcs0_3d + 7) = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 440 trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 441 trc3d(:,:,:,jp_pcs0_3d + 9) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 393 394 ! Total primary production per year 395 IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) & 396 & tpp = glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 397 398 IF( lk_iomput ) THEN 399 IF( knt == nrdttrc ) THEN 400 CALL wrk_alloc( jpi, jpj, zw2d ) 401 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 402 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 403 ! 404 IF( iom_use( "PPPHY" ) .OR. iom_use( "PPPHY2" ) ) THEN 405 zw3d(:,:,:) = zprorca (:,:,:) * zfact * tmask(:,:,:) ! primary production by nanophyto 406 CALL iom_put( "PPPHY" , zw3d ) 407 ! 408 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) ! primary production by diatomes 409 CALL iom_put( "PPPHY2" , zw3d ) 410 ENDIF 411 IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) ) THEN 412 zw3d(:,:,:) = zpronew (:,:,:) * zfact * tmask(:,:,:) ! new primary production by nanophyto 413 CALL iom_put( "PPNEWN" , zw3d ) 414 ! 415 zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:) ! new primary production by diatomes 416 CALL iom_put( "PPNEWD" , zw3d ) 417 ENDIF 418 IF( iom_use( "PBSi" ) ) THEN 419 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production 420 CALL iom_put( "PBSi" , zw3d ) 421 ENDIF 422 IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) ) THEN 423 zw3d(:,:,:) = zprofen(:,:,:) * zfact * tmask(:,:,:) ! biogenic iron production by nanophyto 424 CALL iom_put( "PFeN" , zw3d ) 425 ! 426 zw3d(:,:,:) = zprofed(:,:,:) * zfact * tmask(:,:,:) ! biogenic iron production by diatomes 427 CALL iom_put( "PFeD" , zw3d ) 428 ENDIF 429 IF( iom_use( "Mumax" ) ) THEN 430 zw3d(:,:,:) = prmax(:,:,:) * tmask(:,:,:) ! Maximum growth rate 431 CALL iom_put( "Mumax" , zw3d ) 432 ENDIF 433 IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) ) THEN 434 zw3d(:,:,:) = zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ! Realized growth rate for nanophyto 435 CALL iom_put( "MuN" , zw3d ) 436 ! 437 zw3d(:,:,:) = zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ! Realized growth rate for diatoms 438 CALL iom_put( "MuD" , zw3d ) 439 ENDIF 440 IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) ) THEN 441 zw3d(:,:,:) = zprbio (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term 442 CALL iom_put( "LNlight" , zw3d ) 443 ! 444 zw3d(:,:,:) = zprdia (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term 445 CALL iom_put( "LDlight" , zw3d ) 446 ENDIF 447 IF( iom_use( "TPP" ) ) THEN 448 zw3d(:,:,:) = ( zprorca(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production 449 CALL iom_put( "TPP" , zw3d ) 450 ENDIF 451 IF( iom_use( "TPNEW" ) ) THEN 452 zw3d(:,:,:) = ( zpronew(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production 453 CALL iom_put( "TPNEW" , zw3d ) 454 ENDIF 455 IF( iom_use( "TPBFE" ) ) THEN 456 zw3d(:,:,:) = ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:) ! total biogenic iron production 457 CALL iom_put( "TPBFE" , zw3d ) 458 ENDIF 459 IF( iom_use( "INTPPPHY" ) .OR. iom_use( "INTPPPHY2" ) ) THEN 460 zw2d(:,:) = 0. 461 DO jk = 1, jpkm1 462 zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 463 ENDDO 464 CALL iom_put( "INTPPPHY" , zw2d ) 465 ! 466 zw2d(:,:) = 0. 467 DO jk = 1, jpkm1 468 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom 469 ENDDO 470 CALL iom_put( "INTPPPHY2" , zw2d ) 471 ENDIF 472 IF( iom_use( "INTPP" ) ) THEN 473 zw2d(:,:) = 0. 474 DO jk = 1, jpkm1 475 zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 476 ENDDO 477 CALL iom_put( "INTPP" , zw2d ) 478 ENDIF 479 IF( iom_use( "INTPNEW" ) ) THEN 480 zw2d(:,:) = 0. 481 DO jk = 1, jpkm1 482 zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod 483 ENDDO 484 CALL iom_put( "INTPNEW" , zw2d ) 485 ENDIF 486 IF( iom_use( "INTPBFE" ) ) THEN ! total biogenic iron production ( vertically integrated ) 487 zw2d(:,:) = 0. 488 DO jk = 1, jpkm1 489 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 490 ENDDO 491 CALL iom_put( "INTPBFE" , zw2d ) 492 ENDIF 493 IF( iom_use( "INTPBSI" ) ) THEN ! total biogenic silica production ( vertically integrated ) 494 zw2d(:,:) = 0. 495 DO jk = 1, jpkm1 496 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bsi prod 497 ENDDO 498 CALL iom_put( "INTPBSI" , zw2d ) 499 ENDIF 500 IF( iom_use( "tintpp" ) ) CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s 501 ! 502 CALL wrk_dealloc( jpi, jpj, zw2d ) 503 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 504 ENDIF 505 ELSE 506 IF( ln_diatrc ) THEN 507 zfact = 1.e+3 * rfact2r 508 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca (:,:,:) * zfact * tmask(:,:,:) 509 trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zfact * tmask(:,:,:) 510 trc3d(:,:,:,jp_pcs0_3d + 6) = zpronew (:,:,:) * zfact * tmask(:,:,:) 511 trc3d(:,:,:,jp_pcs0_3d + 7) = zpronewd(:,:,:) * zfact * tmask(:,:,:) 512 trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) 513 trc3d(:,:,:,jp_pcs0_3d + 9) = zprofed (:,:,:) * zfact * tmask(:,:,:) 442 514 # if ! defined key_kriest 443 trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2* tmask(:,:,:)515 trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zfact * tmask(:,:,:) 444 516 # endif 445 ENDIF 446 ! 447 ENDIF 448 449 IF(ln_ctl) THEN ! print mean trends (used for debugging) 517 ENDIF 518 ENDIF 519 520 IF(ln_ctl) THEN ! print mean trends (used for debugging) 450 521 WRITE(charout, FMT="('prod')") 451 522 CALL prt_ctl_trc_info(charout) 452 523 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 453 454 455 456 457 458 459 460 524 ENDIF 525 ! 526 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 527 CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 528 CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 529 ! 530 IF( nn_timing == 1 ) CALL timing_stop('p4z_prod') 531 ! 461 532 END SUBROUTINE p4z_prod 462 533 … … 537 608 538 609 !!====================================================================== 539 END MODULE 610 END MODULE p4zprod -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r4624 r6225 50 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitnh4 !: - - - - - 51 51 52 !!* Substitution53 # include "top_substitute.h90"54 52 !!---------------------------------------------------------------------- 55 53 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 59 57 CONTAINS 60 58 61 SUBROUTINE p4z_rem( kt, jnt )59 SUBROUTINE p4z_rem( kt, knt ) 62 60 !!--------------------------------------------------------------------- 63 61 !! *** ROUTINE p4z_rem *** … … 68 66 !!--------------------------------------------------------------------- 69 67 ! 70 INTEGER, INTENT(in) :: kt, jnt ! ocean time step68 INTEGER, INTENT(in) :: kt, knt ! ocean time step 71 69 ! 72 70 INTEGER :: ji, jj, jk … … 78 76 REAL(wp) :: zofer2 79 77 #endif 80 REAL(wp) :: zonitr, zstep, z rfact278 REAL(wp) :: zonitr, zstep, zfact 81 79 CHARACTER (len=25) :: charout 82 REAL(wp), POINTER, DIMENSION(:,: ) :: ztempbac 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod 80 REAL(wp), POINTER, DIMENSION(:,: ) :: ztempbac 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zw3d 84 82 !!--------------------------------------------------------------------- 85 83 ! … … 103 101 DO ji = 1, jpi 104 102 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 105 IF( fsdept(ji,jj,jk) < zdep ) THEN106 zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr n(ji,jj,jk,jpzoo) + 2.* trn(ji,jj,jk,jpmes) ), 4.e-6 )103 IF( gdept_n(ji,jj,jk) < zdep ) THEN 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 … … 119 117 DO ji = 1, jpi 120 118 ! denitrification factor computed from O2 levels 121 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr n(ji,jj,jk,jpoxy) ) &122 & / ( oxymin + tr n(ji,jj,jk,jpoxy) ) )119 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trb(ji,jj,jk,jpoxy) ) & 120 & / ( oxymin + trb(ji,jj,jk,jpoxy) ) ) 123 121 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 124 122 END DO … … 140 138 ! Ammonification in oxic waters with oxygen consumption 141 139 ! ----------------------------------------------------- 142 zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * tr n(ji,jj,jk,jpdoc)143 zolimi(ji,jj,jk) = MIN( ( tr n(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )140 zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 141 zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 144 142 ! Ammonification in suboxic waters with denitrification 145 143 ! ------------------------------------------------------- 146 denitr(ji,jj,jk) = MIN( ( tr n(ji,jj,jk,jpno3) - rtrn ) / rdenit, &147 & zremik * nitrfac(ji,jj,jk) * tr n(ji,jj,jk,jpdoc) )144 denitr(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, & 145 & zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) ) 148 146 ! 149 147 zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) … … 165 163 ! below 2 umol/L. Inhibited at strong light 166 164 ! ---------------------------------------------------------- 167 zonitr =nitrif * zstep * tr n(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )168 denitnh4(ji,jj,jk) = nitrif * zstep * tr n(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)165 zonitr =nitrif * zstep * trb(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 166 denitnh4(ji,jj,jk) = nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 169 167 ! Update of the tracers trends 170 168 ! ---------------------------- … … 192 190 ! ---------------------------------------------------------- 193 191 zbactfer = 10.e-6 * rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk) & 194 & * tr n(ji,jj,jk,jpfer) / ( 2.5E-10 + trn(ji,jj,jk,jpfer) ) &192 & * trb(ji,jj,jk,jpfer) / ( 2.5E-10 + trb(ji,jj,jk,jpfer) ) & 195 193 & * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk) 196 194 #if defined key_kriest … … 228 226 ! means a disaggregation constant about 0.5 the value in oxic zones 229 227 ! ----------------------------------------------------------------- 230 zorem = zremip * tr n(ji,jj,jk,jppoc)231 zofer = zremip * tr n(ji,jj,jk,jpsfe)228 zorem = zremip * trb(ji,jj,jk,jppoc) 229 zofer = zremip * trb(ji,jj,jk,jpsfe) 232 230 #if ! defined key_kriest 233 zorem2 = zremip * tr n(ji,jj,jk,jpgoc)234 zofer2 = zremip * tr n(ji,jj,jk,jpbfe)231 zorem2 = zremip * trb(ji,jj,jk,jpgoc) 232 zofer2 = zremip * trb(ji,jj,jk,jpbfe) 235 233 #else 236 zorem2 = zremip * tr n(ji,jj,jk,jpnum)234 zorem2 = zremip * trb(ji,jj,jk,jpnum) 237 235 #endif 238 236 … … 272 270 ! Remineralization rate of BSi depedant on T and saturation 273 271 ! --------------------------------------------------------- 274 zsatur = ( sio3eq(ji,jj,jk) - tr n(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn )272 zsatur = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 275 273 zsatur = MAX( rtrn, zsatur ) 276 274 zsatur2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 … … 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. ) 288 286 zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 289 zosil = zsiremin * tr n(ji,jj,jk,jpgsi)287 zosil = zsiremin * trb(ji,jj,jk,jpgsi) 290 288 ! 291 289 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil … … 315 313 END DO 316 314 317 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) THEN 318 zrfact2 = 1.e3 * rfact2r 319 CALL iom_put( "REMIN" , zolimi(:,:,:) * tmask(:,:,:) * zrfact2 ) ! Remineralisation rate 320 CALL iom_put( "DENIT" , denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zrfact2 ) ! Denitrification 321 ENDIF 315 IF( knt == nrdttrc ) THEN 316 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 317 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 318 ! 319 IF( iom_use( "REMIN" ) ) THEN 320 zw3d(:,:,:) = zolimi(:,:,:) * tmask(:,:,:) * zfact ! Remineralisation rate 321 CALL iom_put( "REMIN" , zw3d ) 322 ENDIF 323 IF( iom_use( "DENIT" ) ) THEN 324 zw3d(:,:,:) = denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zfact ! Denitrification 325 CALL iom_put( "DENIT" , zw3d ) 326 ENDIF 327 ! 328 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 329 ENDIF 322 330 323 331 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
- Property svn:keywords set to Id
r4624 r6225 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 REAL(wp) :: ryyss !: number of seconds per year 83 84 !!* Substitution 85 # include "top_substitute.h90" 80 !! * Substitutions 81 # include "vectopt_loop_substitute.h90" 86 82 !!---------------------------------------------------------------------- 87 83 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 88 !! $ Header:$84 !! $Id$ 89 85 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 90 86 !!---------------------------------------------------------------------- 91 92 87 CONTAINS 93 88 … … 118 113 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 119 114 CALL fld_read( kt, 1, sf_dust ) 120 dust(:,:) = sf_dust(1)%fnow(:,:,1) 115 IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN 116 dust(:,:) = sf_dust(1)%fnow(:,:,1) 117 ELSE 118 dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) ) 119 ENDIF 121 120 ENDIF 122 121 ENDIF … … 137 136 DO jj = 1, jpj 138 137 DO ji = 1, jpi 139 zcoef = ryyss * cvol(ji,jj,1)138 zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 140 139 rivalk(ji,jj) = sf_river(jr_dic)%fnow(ji,jj,1) & 141 140 & * 1.E3 / ( 12. * zcoef + rtrn ) … … 159 158 DO jj = 1, jpj 160 159 DO ji = 1, jpi 161 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 ) 162 161 END DO 163 162 END DO … … 188 187 INTEGER :: ierr, ierr1, ierr2, ierr3 189 188 INTEGER :: ios ! Local integer output status for namelist read 189 INTEGER :: ik50 ! last level where depth less than 50 m 190 INTEGER :: isrow ! index for ORCA1 starting row 190 191 REAL(wp) :: zexpide, zdenitide, zmaskt 191 192 REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep … … 208 209 IF( nn_timing == 1 ) CALL timing_start('p4z_sbc_init') 209 210 ! 210 ryyss = nyear_len(1) * rday ! number of seconds per year and per month211 !212 211 ! !* set file information 213 212 REWIND( numnatp_ref ) ! Namelist nampissbc in reference namelist : Pisces external sources of nutrients … … 219 218 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp ) 220 219 IF(lwm) WRITE ( numonp, nampissbc ) 220 221 IF ( ( nn_ice_tr >= 0 ) .AND. ln_ironice ) THEN 222 IF(lwp) THEN 223 WRITE(numout,*) ' ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr 224 WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead ' 225 WRITE(numout,*) ' ln_ironice is forced to .FALSE. ' 226 ln_ironice = .FALSE. 227 ENDIF 228 ENDIF 221 229 222 230 IF(lwp) THEN … … 250 258 ENDIF 251 259 260 ! set the number of level over which river runoffs are applied 261 ! online configuration : computed in sbcrnf 262 IF( lk_offline ) THEN 263 nk_rnf(:,:) = 1 264 h_rnf (:,:) = gdept_n(:,:,1) 265 ENDIF 266 252 267 ! dust input from the atmosphere 253 268 ! ------------------------------ … … 361 376 rivalkinput = 0._wp 362 377 END IF 363 364 378 ! nutrient input from dust 365 379 ! ------------------------ … … 413 427 CALL iom_close( numiron ) 414 428 ! 415 DO jk = 1, 5 429 ik50 = 5 ! last level where depth less than 50 m 430 DO jk = jpkm1, 1, -1 431 IF( gdept_1d(jk) > 50. ) ik50 = jk - 1 432 END DO 433 IF (lwp) WRITE(numout,*) 434 IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1) 435 IF (lwp) WRITE(numout,*) 436 DO jk = 1, ik50 416 437 DO jj = 2, jpjm1 417 438 DO ji = fs_2, fs_jpim1 … … 424 445 END DO 425 446 END DO 426 IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN 427 ii0 = 176 ; ii1 = 176 ! Southern Island : Kerguelen 428 ij0 = 37 ; ij1 = 37 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 429 ! 430 ii0 = 119 ; ii1 = 119 ! South Georgia 431 ij0 = 29 ; ij1 = 29 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 432 ! 433 ii0 = 111 ; ii1 = 111 ! Falklands 434 ij0 = 35 ; ij1 = 35 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 435 ! 436 ii0 = 168 ; ii1 = 168 ! Crozet 437 ij0 = 40 ; ij1 = 40 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 438 ! 439 ii0 = 119 ; ii1 = 119 ! South Orkney 440 ij0 = 28 ; ij1 = 28 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 441 ! 442 ii0 = 140 ; ii1 = 140 ! Bouvet Island 443 ij0 = 33 ; ij1 = 33 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 444 ! 445 ii0 = 178 ; ii1 = 178 ! Prince edwards 446 ij0 = 34 ; ij1 = 34 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 447 ! 448 ii0 = 43 ; ii1 = 43 ! Balleny islands 449 ij0 = 21 ; ij1 = 21 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 450 ENDIF 447 ! 451 448 CALL lbc_lnk( zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 449 ! 452 450 DO jk = 1, jpk 453 451 DO jj = 1, jpj 454 452 DO ji = 1, jpi 455 zexpide = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )453 zexpide = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) ) 456 454 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 457 455 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) … … 463 461 ironsed(:,:,jpk) = 0._wp 464 462 DO jk = 1, jpkm1 465 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday )463 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_n(:,:,jk) * rday ) 466 464 END DO 467 465 DEALLOCATE( zcmask) … … 517 515 518 516 !!====================================================================== 519 END MODULE 517 END MODULE p4zsbc -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
- Property svn:keywords set to Id
r4641 r6225 21 21 USE p4zopt ! optical model 22 22 USE p4zlim ! Co-limitations of differents nutrients 23 USE p4zrem ! Remineralisation of organic matter24 23 USE p4zsbc ! External source of nutrients 25 24 USE p4zint ! interpolation and computation of various fields … … 30 29 PRIVATE 31 30 32 PUBLIC p4z_sed 33 34 !! * Module variables 35 REAL(wp) :: ryyss !: number of seconds per year 36 REAL(wp) :: r1_ryyss !: inverse of ryyss 37 REAL(wp) :: rmtss !: number of seconds per month 31 PUBLIC p4z_sed 32 PUBLIC p4z_sed_alloc 33 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot !: Nitrogen fixation 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 INTEGER :: numnit41 42 43 !!* Substitution44 # include "top_substitute.h90"45 38 !!---------------------------------------------------------------------- 46 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 47 !! $ Header:$40 !! $Id$ 48 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 42 !!---------------------------------------------------------------------- 50 43 CONTAINS 51 44 52 SUBROUTINE p4z_sed( kt, jnt )45 SUBROUTINE p4z_sed( kt, knt ) 53 46 !!--------------------------------------------------------------------- 54 47 !! *** ROUTINE p4z_sed *** … … 61 54 !!--------------------------------------------------------------------- 62 55 ! 63 INTEGER, INTENT(in) :: kt, jnt ! ocean time step56 INTEGER, INTENT(in) :: kt, knt ! ocean time step 64 57 INTEGER :: ji, jj, jk, ikt 65 58 #if ! defined key_sed … … 72 65 REAL(wp) :: zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc 73 66 REAL(wp) :: ztrfer, ztrpo4, zwdust, zlight 74 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot75 67 ! 76 68 CHARACTER (len=25) :: charout 77 REAL(wp), POINTER, DIMENSION(:,: ) :: zpdep, zsidep, zwork1, zwork2, zwork3 , zwork469 REAL(wp), POINTER, DIMENSION(:,: ) :: zpdep, zsidep, zwork1, zwork2, zwork3 78 70 REAL(wp), POINTER, DIMENSION(:,: ) :: zdenit2d, zironice, zbureff 79 71 REAL(wp), POINTER, DIMENSION(:,: ) :: zwsbio3, zwsbio4, zwscal 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: z nitrpot, zirondep, zsoufer72 REAL(wp), POINTER, DIMENSION(:,:,:) :: zirondep, zsoufer 81 73 !!--------------------------------------------------------------------- 82 74 ! 83 75 IF( nn_timing == 1 ) CALL timing_start('p4z_sed') 84 76 ! 85 IF( kt == nittrc000 .AND. jnt == 1 ) THEN 86 ryyss = nyear_len(1) * rday ! number of seconds per year and per month 87 rmtss = ryyss / raamo 88 r1_rday = 1. / rday 89 r1_ryyss = 1. / ryyss 90 IF( ln_check_mass .AND. lwp) & 91 & CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 92 ENDIF 77 IF( kt == nittrc000 .AND. knt == 1 ) r1_rday = 1. / rday 93 78 ! 94 79 ! Allocate temporary workspace 95 CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, z work4, zbureff )80 CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 96 81 CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 97 CALL wrk_alloc( jpi, jpj, jpk, z nitrpot, zsoufer )82 CALL wrk_alloc( jpi, jpj, jpk, zsoufer ) 98 83 99 84 zdenit2d(:,:) = 0.e0 100 85 zbureff (:,:) = 0.e0 86 zwork1 (:,:) = 0.e0 87 zwork2 (:,:) = 0.e0 88 zwork3 (:,:) = 0.e0 101 89 102 90 ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. … … 108 96 DO jj = 1, jpj 109 97 DO ji = 1, jpi 110 zdep = rfact2 / fse3t(ji,jj,1)98 zdep = rfact2 / e3t_n(ji,jj,1) 111 99 zwflux = fmmflx(ji,jj) / 1000._wp 112 zfminus = MIN( 0._wp, -zwflux ) * tr n(ji,jj,1,jpfer) * zdep100 zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep 113 101 zfplus = MAX( 0._wp, -zwflux ) * icefeinput * zdep 114 102 zironice(ji,jj) = zfplus + zfminus … … 116 104 END DO 117 105 ! 118 trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + zironice(:,:) 119 ! 120 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) & 121 & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 106 tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 107 ! 108 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) ) & 109 & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 110 ! 122 111 CALL wrk_dealloc( jpi, jpj, zironice ) 123 112 ! … … 132 121 ! ! Iron and Si deposition at the surface 133 122 IF( ln_solub ) THEN 134 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 55.85 * rmtss )+ 3.e-10 * r1_ryyss123 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 135 124 ELSE 136 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 55.85 * rmtss )+ 3.e-10 * r1_ryyss125 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 137 126 ENDIF 138 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 28.1 * rmtss )139 zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 31. * rmtss )/ 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 140 129 ! ! Iron solubilization of particles in the water column 141 130 ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j 142 131 zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 143 132 DO jk = 2, jpkm1 144 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( - fsdept(:,:,jk) / 540. )133 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 145 134 END DO 146 135 ! ! Iron solubilization of particles in the water column 147 trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + zpdep (:,:) 148 trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep (:,:) 149 trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + zirondep(:,:,:) 150 ! 151 IF( ln_diatrc ) THEN 152 zfact = 1.e+3 * rfact2r 153 IF( lk_iomput ) THEN 154 IF( jnt == nrdttrc ) THEN 155 CALL iom_put( "Irondep", zirondep(:,:,1) * zfact * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 156 CALL iom_put( "pdust" , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface 157 ENDIF 158 ELSE 159 trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * zfact * fse3t(:,:,1) * tmask(:,:,1) 136 tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep (:,:) 137 tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:) 138 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 139 ! 140 IF( lk_iomput ) THEN 141 IF( knt == nrdttrc ) THEN 142 IF( iom_use( "Irondep" ) ) & 143 & CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 144 IF( iom_use( "pdust" ) ) & 145 & CALL iom_put( "pdust" , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface 160 146 ENDIF 147 ELSE 148 IF( ln_diatrc ) & 149 & trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 161 150 ENDIF 162 151 CALL wrk_dealloc( jpi, jpj, zpdep, zsidep ) … … 168 157 ! ---------------------------------------------------------- 169 158 IF( ln_river ) THEN 170 trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivdip(:,:) * rfact2 171 trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + rivdin(:,:) * rfact2 172 trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivdic(:,:) * 5.e-5 * rfact2 173 trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + rivdsi(:,:) * rfact2 174 trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivdic(:,:) * rfact2 175 trn(:,:,1,jptal) = trn(:,:,1,jptal) + ( rivalk(:,:) - rno3 * rivdin(:,:) ) * rfact2 159 DO jj = 1, jpj 160 DO ji = 1, jpi 161 DO jk = 1, nk_rnf(ji,jj) 162 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + rivdip(ji,jj) * rfact2 163 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + rivdin(ji,jj) * rfact2 164 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + rivdic(ji,jj) * 5.e-5 * rfact2 165 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + rivdsi(ji,jj) * rfact2 166 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + rivdic(ji,jj) * rfact2 167 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2 168 ENDDO 169 ENDDO 170 ENDDO 176 171 ENDIF 177 172 … … 179 174 ! ---------------------------------------------------------- 180 175 IF( ln_ndepo ) THEN 181 tr n(:,:,1,jpno3) = trn(:,:,1,jpno3) + nitdep(:,:) * rfact2182 tr n(:,:,1,jptal) = trn(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2176 tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 177 tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 183 178 ENDIF 184 179 … … 186 181 ! ------------------------------------------------------ 187 182 IF( ln_ironsed ) THEN 188 tr n(:,:,:,jpfer) = trn(:,:,:,jpfer) + ironsed(:,:,:) * rfact2183 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 189 184 ! 190 IF( l n_diatrc .AND. lk_iomput .AND. jnt == nrdttrc) &185 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) & 191 186 & CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments 192 187 ENDIF … … 195 190 ! ------------------------------------------------------ 196 191 IF( ln_hydrofe ) THEN 197 tr n(:,:,:,jpfer) = trn(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2192 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 198 193 ! 199 IF( l n_diatrc .AND. lk_iomput .AND. jnt == nrdttrc) &194 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) ) & 200 195 & CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input 201 196 ENDIF 202 203 197 204 198 ! OA: Warning, the following part is necessary, especially with Kriest … … 208 202 DO ji = 1, jpi 209 203 ikt = mbkt(ji,jj) 210 zdep = fse3t(ji,jj,ikt) / xstep204 zdep = e3t_n(ji,jj,ikt) / xstep 211 205 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 212 206 zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) ) … … 224 218 ikt = mbkt(ji,jj) 225 219 # if defined key_kriest 226 zflx = tr n(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) * 1E3 * 1E6 / 1E4220 zflx = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) * 1E3 * 1E6 / 1E4 227 221 # else 228 zflx = ( tr n(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &229 & + tr n(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4222 zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) & 223 & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4 230 224 #endif 231 225 zflx = LOG10( MAX( 1E-3, zflx ) ) 232 zo2 = LOG10( MAX( 10. , tr n(ji,jj,ikt,jpoxy) * 1E6 ) )233 zno3 = LOG10( MAX( 1. , tr n(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )234 zdep = LOG10( fsdepw(ji,jj,ikt+1) )226 zo2 = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 227 zno3 = LOG10( MAX( 1. , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 228 zdep = LOG10( gdepw_n(ji,jj,ikt+1) ) 235 229 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 & 236 230 & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 237 231 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 238 232 ! 239 zflx = ( tr n(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &240 & + tr n(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6233 zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) & 234 & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 241 235 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 242 236 ENDIF … … 250 244 DO jj = 1, jpj 251 245 DO ji = 1, jpi 252 ikt = mbkt(ji,jj) 246 IF( tmask(ji,jj,1) == 1 ) THEN 247 ikt = mbkt(ji,jj) 253 248 # if defined key_kriest 254 zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwscal (ji,jj)255 zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)249 zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwscal (ji,jj) 250 zwork2(ji,jj) = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 256 251 # else 257 zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)258 zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)252 zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 253 zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 259 254 # endif 260 ! For calcite, burial efficiency is made a function of saturation 261 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 262 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 263 zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 255 ! For calcite, burial efficiency is made a function of saturation 256 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 257 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 258 zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 259 ENDIF 264 260 END DO 265 261 END DO … … 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 284 280 # if defined key_kriest 285 zsiloss = tr n(ji,jj,ikt,jpgsi) * zws4281 zsiloss = trb(ji,jj,ikt,jpgsi) * zws4 286 282 # else 287 zsiloss = tr n(ji,jj,ikt,jpgsi) * zwsc283 zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 288 284 # endif 289 zcaloss = tr n(ji,jj,ikt,jpcal) * zwsc285 zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 290 286 ! 291 tr n(ji,jj,ikt,jpgsi) = trn(ji,jj,ikt,jpgsi) - zsiloss292 tr n(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zcaloss287 tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss 288 tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss 293 289 #if ! defined key_sed 294 tr n(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zsiloss * zrivsil290 tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil 295 291 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 296 292 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 297 293 zrivalk = 1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn ) 298 tr n(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0299 tr n(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zcaloss * zrivalk294 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 295 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 300 296 #endif 301 297 END DO … … 304 300 DO jj = 1, jpj 305 301 DO ji = 1, jpi 306 ikt 307 zdep = xstep / fse3t(ji,jj,ikt)302 ikt = mbkt(ji,jj) 303 zdep = xstep / e3t_n(ji,jj,ikt) 308 304 zws4 = zwsbio4(ji,jj) * zdep 309 305 zws3 = zwsbio3(ji,jj) * zdep 310 306 zrivno3 = 1. - zbureff(ji,jj) 311 307 # if ! defined key_kriest 312 tr n(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - trn(ji,jj,ikt,jpgoc) * zws4313 tr n(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3314 tr n(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * zws4315 tr n(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3316 zwstpoc = trn(ji,jj,ikt,jpgoc) * zws4 + trn(ji,jj,ikt,jppoc) * zws3308 tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4 309 tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 310 tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4 311 tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 312 zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 317 313 # else 318 tr n(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - trn(ji,jj,ikt,jpnum) * zws4319 tr n(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3320 tr n(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3321 zwstpoc = tr n(ji,jj,ikt,jppoc) * zws3314 tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4 315 tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 316 tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 317 zwstpoc = trb(ji,jj,ikt,jppoc) * zws3 322 318 # endif 323 319 … … 325 321 ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification 326 322 ! in the sediments and just above the sediments. Not very clever, but simpliest option. 327 zpdenit = MIN( 0.5 * ( tr n(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )323 zpdenit = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 328 324 z1pdenit = zwstpoc * zrivno3 - zpdenit 329 zolimit = MIN( ( tr n(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )330 zdenitt = MIN( 0.5 * ( tr n(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )331 tr n(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt332 tr n(ji,jj,ikt,jppo4) = trn(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt333 tr n(ji,jj,ikt,jpnh4) = trn(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt334 tr n(ji,jj,ikt,jpno3) = trn(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)335 tr n(ji,jj,ikt,jpoxy) = trn(ji,jj,ikt,jpoxy) - zolimit * o2ut336 tr n(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )337 tr n(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt338 zwork4(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)325 zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 326 zdenitt = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) ) 327 tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt 328 tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt 329 tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt 330 tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt) 331 tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut 332 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 333 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 334 sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 339 335 #endif 340 336 END DO … … 356 352 #endif 357 353 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 358 ztrpo4 = tr n (ji,jj,jk,jppo4) / ( concnnh4 + trn(ji,jj,jk,jppo4) )359 zlight = ( 1.- EXP( -etot (ji,jj,jk) / diazolight ) )360 znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) &354 ztrpo4 = trb (ji,jj,jk,jppo4) / ( concnnh4 + trb (ji,jj,jk,jppo4) ) 355 zlight = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) 356 nitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) & 361 357 & * zfact * MIN( ztrfer, ztrpo4 ) * zlight 362 358 zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk)) … … 370 366 DO jj = 1, jpj 371 367 DO ji = 1, jpi 372 zfact = znitrpot(ji,jj,jk) * nitrfix373 tr n(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact374 tr n(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3 * zfact375 tr n(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + o2nit * zfact376 tr n(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trn(ji,jj,jk,jppo4) ) &377 & * 0.002 * tr n(ji,jj,jk,jpdoc) * rfact2 / rday378 tr n(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday368 zfact = nitrpot(ji,jj,jk) * nitrfix 369 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact 370 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact 371 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit * zfact 372 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 373 & * 0.002 * trb(ji,jj,jk,jpdoc) * xstep 374 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep 379 375 END DO 380 376 END DO 381 377 END DO 382 378 383 384 IF( ln_check_mass) THEN385 ! Global budget of N SMS : denitrification in the water column and in the sediment386 ! nitrogen fixation by the diazotrophs387 ! --------------------------------------------------------------------------------388 zrdenittot = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )389 zsdenittot = glob_sum ( zwork4(:,:) * e1e2t(:,:) )390 znitrpottot = glob_sum ( znitrpot(:,:,:) * nitrfix * cvol(:,:,:))391 IF( kt == nitend .AND. jnt == nrdttrc ) THEN392 zfact = 1.e+3 * rfact2r * rno3 * ryyss * 14. / 1e12393 IF(lwp) WRITE(numnit,9100) ndastp, znitrpottot * nitrfix * zfact, zrdenittot * zfact , zsdenittot * zfact379 IF( lk_iomput ) THEN 380 IF( knt == nrdttrc ) THEN 381 zfact = 1.e+3 * rfact2r * rno3 ! conversion from molC/l/kt to molN/m3/s 382 IF( iom_use("Nfix" ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) ) ! nitrogen fixation 383 IF( iom_use("INTNFIX") ) THEN ! nitrogen fixation rate in ocean ( vertically integrated ) 384 zwork1(:,:) = 0. 385 DO jk = 1, jpkm1 386 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 387 ENDDO 388 CALL iom_put( "INTNFIX" , zwork1 ) 389 ENDIF 394 390 ENDIF 395 ENDIF 396 ! 397 IF( ln_diatrc ) THEN 398 zfact = 1.e+3 * rfact2r 399 IF( lk_iomput ) THEN 400 IF( jnt == nrdttrc ) THEN 401 CALL iom_put( "Nfix" , znitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) ) ! nitrogen fixation 402 CALL iom_put( "Sdenit", zwork4(:,:) * rno3 * zfact * tmask(:,:,1) ) ! Nitrate reduction in the sediments 403 ENDIF 404 ELSE 405 trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * zfact * fse3t(:,:,1) * tmask(:,:,1) 406 ENDIF 391 ELSE 392 IF( ln_diatrc ) & 393 & trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 407 394 ENDIF 408 395 ! … … 410 397 WRITE(charout, fmt="('sed ')") 411 398 CALL prt_ctl_trc_info(charout) 412 CALL prt_ctl_trc(tab4d=tr n, mask=tmask, clinfo=ctrcnm)413 ENDIF 414 ! 415 CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, z work4, zbureff )399 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 400 ENDIF 401 ! 402 CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 416 403 CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 417 CALL wrk_dealloc( jpi, jpj, jpk, z nitrpot, zsoufer )404 CALL wrk_dealloc( jpi, jpj, jpk, zsoufer ) 418 405 ! 419 406 IF( nn_timing == 1 ) CALL timing_stop('p4z_sed') … … 422 409 ! 423 410 END SUBROUTINE p4z_sed 411 412 413 INTEGER FUNCTION p4z_sed_alloc() 414 !!---------------------------------------------------------------------- 415 !! *** ROUTINE p4z_sed_alloc *** 416 !!---------------------------------------------------------------------- 417 ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc ) 418 ! 419 IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc: failed to allocate arrays') 420 ! 421 END FUNCTION p4z_sed_alloc 422 424 423 425 424 #else … … 433 432 434 433 !!====================================================================== 435 END MODULE 434 END MODULE p4zsed -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r4624 r6225 41 41 #endif 42 42 43 INTEGER :: ik sed = 1043 INTEGER :: ik100 44 44 45 45 #if defined key_kriest … … 65 65 #endif 66 66 67 !!* Substitution68 # include "top_substitute.h90"69 67 !!---------------------------------------------------------------------- 70 68 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 79 77 !!---------------------------------------------------------------------- 80 78 81 SUBROUTINE p4z_sink ( kt, jnt )79 SUBROUTINE p4z_sink ( kt, knt ) 82 80 !!--------------------------------------------------------------------- 83 81 !! *** ROUTINE p4z_sink *** … … 88 86 !! ** Method : - ??? 89 87 !!--------------------------------------------------------------------- 90 INTEGER, INTENT(in) :: kt, jnt88 INTEGER, INTENT(in) :: kt, knt 91 89 INTEGER :: ji, jj, jk, jit 92 90 INTEGER :: iiter1, iiter2 … … 94 92 REAL(wp) :: zagg , zaggfe, zaggdoc, zaggdoc2, zaggdoc3 95 93 REAL(wp) :: zfact, zwsmax, zmax, zstep 96 REAL(wp) :: zrfact297 INTEGER :: ik198 94 CHARACTER (len=25) :: charout 95 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d 96 REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d 99 97 !!--------------------------------------------------------------------- 100 98 ! … … 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 ) ) … … 199 197 zfact = zstep * xdiss(ji,jj,jk) 200 198 ! Part I : Coagulation dependent on turbulence 201 zagg1 = 25.9 * zfact * tr n(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)202 zagg2 = 4452. * zfact * tr n(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)199 zagg1 = 25.9 * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 200 zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 203 201 204 202 ! Part II : Differential settling 205 203 206 204 ! Aggregation of small into large particles 207 zagg3 = 47.1 * zstep * tr n(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)208 zagg4 = 3.3 * zstep * tr n(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)205 zagg3 = 47.1 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 206 zagg4 = 3.3 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 209 207 210 208 zagg = zagg1 + zagg2 + zagg3 + zagg4 211 zaggfe = zagg * tr n(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn )209 zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn ) 212 210 213 211 ! Aggregation of DOC to POC : … … 215 213 ! 2nd term is shear aggregation of DOC-POC 216 214 ! 3rd term is differential settling of DOC-POC 217 zaggdoc = ( ( 0.369 * 0.3 * tr n(ji,jj,jk,jpdoc) + 102.4 * trn(ji,jj,jk,jppoc) ) * zfact &218 & + 2.4 * zstep * tr n(ji,jj,jk,jppoc) ) * 0.3 * trn(ji,jj,jk,jpdoc)215 zaggdoc = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact & 216 & + 2.4 * zstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc) 219 217 ! transfer of DOC to GOC : 220 218 ! 1st term is shear aggregation 221 219 ! 2nd term is differential settling 222 zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * tr n(ji,jj,jk,jpgoc) * 0.3 * trn(ji,jj,jk,jpdoc)220 zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc) 223 221 ! tranfer of DOC to POC due to brownian motion 224 zaggdoc3 = ( 5095. * tr n(ji,jj,jk,jppoc) + 114. * 0.3 * trn(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trn(ji,jj,jk,jpdoc)222 zaggdoc3 = ( 5095. * trb(ji,jj,jk,jppoc) + 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trb(ji,jj,jk,jpdoc) 225 223 226 224 ! Update the trends … … 235 233 END DO 236 234 237 ! Total primary production per year 238 t_oce_co2_exp = t_oce_co2_exp + glob_sum( ( sinking(:,:,iksed+1) + sinking2(:,:,iksed+1) ) * e1e2t(:,:) * tmask(:,:,1) ) 235 236 ! Total carbon export per year 237 IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) & 238 & t_oce_co2_exp = glob_sum( ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) ) 239 239 ! 240 IF( ln_diatrc ) THEN 241 zrfact2 = 1.e3 * rfact2r 242 ik1 = iksed + 1 243 IF( lk_iomput ) THEN 244 IF( jnt == nrdttrc ) THEN 245 CALL iom_put( "EPC100" , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 246 CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 247 CALL iom_put( "EPCAL100", sinkcal(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of calcite at 100m 248 CALL iom_put( "EPSI100" , sinksil(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 249 ENDIF 250 ELSE 251 trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 252 trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 253 trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 254 trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 255 trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 256 trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 240 IF( lk_iomput ) THEN 241 IF( knt == nrdttrc ) THEN 242 CALL wrk_alloc( jpi, jpj, zw2d ) 243 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 244 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 245 ! 246 IF( iom_use( "EPC100" ) ) THEN 247 zw2d(:,:) = ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of carbon at 100m 248 CALL iom_put( "EPC100" , zw2d ) 249 ENDIF 250 IF( iom_use( "EPFE100" ) ) THEN 251 zw2d(:,:) = ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of iron at 100m 252 CALL iom_put( "EPFE100" , zw2d ) 253 ENDIF 254 IF( iom_use( "EPCAL100" ) ) THEN 255 zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m 256 CALL iom_put( "EPCAL100" , zw2d ) 257 ENDIF 258 IF( iom_use( "EPSI100" ) ) THEN 259 zw2d(:,:) = sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m 260 CALL iom_put( "EPSI100" , zw2d ) 261 ENDIF 262 IF( iom_use( "EXPC" ) ) THEN 263 zw3d(:,:,:) = ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of carbon in the water column 264 CALL iom_put( "EXPC" , zw3d ) 265 ENDIF 266 IF( iom_use( "EXPFE" ) ) THEN 267 zw3d(:,:,:) = ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of iron 268 CALL iom_put( "EXPFE" , zw3d ) 269 ENDIF 270 IF( iom_use( "EXPCAL" ) ) THEN 271 zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite 272 CALL iom_put( "EXPCAL" , zw3d ) 273 ENDIF 274 IF( iom_use( "EXPSI" ) ) THEN 275 zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica 276 CALL iom_put( "EXPSI" , zw3d ) 277 ENDIF 278 IF( iom_use( "tcexp" ) ) CALL iom_put( "tcexp" , t_oce_co2_exp * zfact ) ! molC/s 279 ! 280 CALL wrk_dealloc( jpi, jpj, zw2d ) 281 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 282 ENDIF 283 ELSE 284 IF( ln_diatrc ) THEN 285 zfact = 1.e3 * rfact2r 286 trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik100) * zfact * tmask(:,:,1) 287 trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik100) * zfact * tmask(:,:,1) 288 trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik100) * zfact * tmask(:,:,1) 289 trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik100) * zfact * tmask(:,:,1) 290 trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik100) * zfact * tmask(:,:,1) 291 trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik100) * zfact * tmask(:,:,1) 257 292 ENDIF 258 293 ENDIF … … 272 307 !! *** ROUTINE p4z_sink_init *** 273 308 !!---------------------------------------------------------------------- 274 309 INTEGER :: jk 310 311 ik100 = 10 ! last level where depth less than 100 m 312 DO jk = jpkm1, 1, -1 313 IF( gdept_1d(jk) > 100. ) ik100 = jk - 1 314 END DO 315 IF (lwp) WRITE(numout,*) 316 IF (lwp) WRITE(numout,*) ' Level corresponding to 100m depth ', ik100 + 1 317 IF (lwp) WRITE(numout,*) 318 ! 275 319 t_oce_co2_exp = 0._wp 276 320 ! … … 282 326 !!---------------------------------------------------------------------- 283 327 284 SUBROUTINE p4z_sink ( kt, jnt )328 SUBROUTINE p4z_sink ( kt, knt ) 285 329 !!--------------------------------------------------------------------- 286 330 !! *** ROUTINE p4z_sink *** … … 292 336 !!--------------------------------------------------------------------- 293 337 ! 294 INTEGER, INTENT(in) :: kt, jnt338 INTEGER, INTENT(in) :: kt, knt 295 339 ! 296 340 INTEGER :: ji, jj, jk, jit, niter1, niter2 … … 300 344 REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 301 345 REAL(wp) :: zval1, zval2, zval3, zval4 302 REAL(wp) :: z rfact2346 REAL(wp) :: zfact 303 347 INTEGER :: ik1 304 348 CHARACTER (len=25) :: charout 305 349 REAL(wp), POINTER, DIMENSION(:,:,:) :: znum3d 350 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d 351 REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d 306 352 !!--------------------------------------------------------------------- 307 353 ! … … 325 371 DO ji = 1, jpi 326 372 IF( tmask(ji,jj,jk) /= 0.e0 ) THEN 327 znum = tr n(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp373 znum = trb(ji,jj,jk,jppoc) / ( trb(ji,jj,jk,jpnum) + rtrn ) / xkr_massp 328 374 ! -------------- To avoid sinking speed over 50 m/day ------- 329 375 znum = MIN( xnumm(jk), znum ) … … 387 433 IF( tmask(ji,jj,jk) /= 0.e0 ) THEN 388 434 389 znum = tr n(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp435 znum = trb(ji,jj,jk,jppoc)/(trb(ji,jj,jk,jpnum)+rtrn) / xkr_massp 390 436 !-------------- To avoid sinking speed over 50 m/day ------- 391 437 znum = min(xnumm(jk),znum) … … 405 451 ! ---------------------------------------------- 406 452 407 zagg1 = 0.163 * tr n(ji,jj,jk,jpnum)**2 &453 zagg1 = 0.163 * trb(ji,jj,jk,jpnum)**2 & 408 454 & * 2.*( (zfm-1.)*(zfm*xkr_mass_max**3-xkr_mass_min**3) & 409 455 & * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min) & 410 456 & * (zfm*xkr_mass_max**2-xkr_mass_min**2) & 411 457 & * (zeps-1.)**2/(zdiv2*zdiv3)) 412 zagg2 = 2*0.163*tr n(ji,jj,jk,jpnum)**2*zfm* &458 zagg2 = 2*0.163*trb(ji,jj,jk,jpnum)**2*zfm* & 413 459 & ((xkr_mass_max**3+3.*(xkr_mass_max**2 & 414 460 & *xkr_mass_min*(zeps-1.)/zdiv2 & … … 418 464 & (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1)) 419 465 420 zagg3 = 0.163*tr n(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3466 zagg3 = 0.163*trb(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3 421 467 422 468 ! Aggregation of small into large particles … … 424 470 ! ---------------------------------------------- 425 471 426 zagg4 = 2.*3.141*0.125*tr n(ji,jj,jk,jpnum)**2* &472 zagg4 = 2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2* & 427 473 & xkr_wsbio_min*(zeps-1.)**2 & 428 474 & *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4) & … … 431 477 & *xkr_eta)/(zdiv*zdiv3*zdiv5) ) 432 478 433 zagg5 = 2.*3.141*0.125*tr n(ji,jj,jk,jpnum)**2 &479 zagg5 = 2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2 & 434 480 & *(zeps-1.)*zfm*xkr_wsbio_min & 435 481 & *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2) & … … 441 487 ! ------------------------------------ 442 488 443 zfract = 2.*3.141*0.125*tr n(ji,jj,jk,jpmes)*12./0.12/0.06**3*trn(ji,jj,jk,jpnum) &489 zfract = 2.*3.141*0.125*trb(ji,jj,jk,jpmes)*12./0.12/0.06**3*trb(ji,jj,jk,jpnum) & 444 490 & * (0.01/xkr_mass_min)**(1.-zeps)*0.1**2 & 445 491 & * 10000.*xstep … … 448 494 ! -------------------------------------- 449 495 450 zaggdoc = 0.83 * tr n(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) &451 & + 0.005 * 231. * tr n(ji,jj,jk,jpdoc) * xstep * trn(ji,jj,jk,jpdoc)452 zaggdoc1 = 271. * tr n(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) &453 & + 0.02 * 16706. * tr n(ji,jj,jk,jppoc) * xstep * trn(ji,jj,jk,jpdoc)496 zaggdoc = 0.83 * trb(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc) & 497 & + 0.005 * 231. * trb(ji,jj,jk,jpdoc) * xstep * trb(ji,jj,jk,jpdoc) 498 zaggdoc1 = 271. * trb(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc) & 499 & + 0.02 * 16706. * trb(ji,jj,jk,jppoc) * xstep * trb(ji,jj,jk,jpdoc) 454 500 455 501 # if defined key_degrad … … 466 512 zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 467 513 ! 468 znumdoc = tr n(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )514 znumdoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 469 515 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc + zaggdoc1 470 516 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zfract + zaggdoc / xkr_massp - zagg … … 477 523 478 524 ! Total primary production per year 479 t_oce_co2_exp = t_oce_co2_exp + glob_sum( ( sinking(:,:, :) ) * cvol(:,:,:) )525 t_oce_co2_exp = t_oce_co2_exp + glob_sum( ( sinking(:,:,ik100) * e1e2t(:,:) * tmask(:,:,1) ) 480 526 ! 481 IF( ln_diatrc ) THEN 482 ! 483 ik1 = iksed + 1 484 zrfact2 = 1.e3 * rfact2r 485 IF( jnt == nrdttrc ) THEN 486 CALL iom_put( "POCFlx" , sinking (:,:,:) * zrfact2 * tmask(:,:,:) ) ! POC export 487 CALL iom_put( "NumFlx" , sinking2 (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Num export 488 CALL iom_put( "SiFlx" , sinksil (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Silica export 489 CALL iom_put( "CaCO3Flx", sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Calcite export 490 CALL iom_put( "xnum" , znum3d (:,:,:) * tmask(:,:,:) ) ! Number of particles in aggregats 491 CALL iom_put( "W1" , wsbio3 (:,:,:) * tmask(:,:,:) ) ! sinking speed of POC 492 CALL iom_put( "W2" , wsbio4 (:,:,:) * tmask(:,:,:) ) ! sinking speed of aggregats 527 IF( lk_iomput ) THEN 528 IF( knt == nrdttrc ) THEN 529 CALL wrk_alloc( jpi, jpj, zw2d ) 530 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 531 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 532 ! 533 IF( iom_use( "EPC100" ) ) THEN 534 zw2d(:,:) = sinking(:,:,ik100) * zfact * tmask(:,:,1) ! Export of carbon at 100m 535 CALL iom_put( "EPC100" , zw2d ) 536 ENDIF 537 IF( iom_use( "EPN100" ) ) THEN 538 zw2d(:,:) = sinking2(:,:,ik100) * zfact * tmask(:,:,1) ! Export of number of aggregates ? 539 CALL iom_put( "EPN100" , zw2d ) 540 ENDIF 541 IF( iom_use( "EPCAL100" ) ) THEN 542 zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m 543 CALL iom_put( "EPCAL100" , zw2d ) 544 ENDIF 545 IF( iom_use( "EPSI100" ) ) THEN 546 zw2d(:,:) = sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m 547 CALL iom_put( "EPSI100" , zw2d ) 548 ENDIF 549 IF( iom_use( "EXPC" ) ) THEN 550 zw3d(:,:,:) = sinking(:,:,:) * zfact * tmask(:,:,:) ! Export of carbon in the water column 551 CALL iom_put( "EXPC" , zw3d ) 552 ENDIF 553 IF( iom_use( "EXPN" ) ) THEN 554 zw3d(:,:,:) = sinking(:,:,:) * zfact * tmask(:,:,:) ! Export of carbon in the water column 555 CALL iom_put( "EXPN" , zw3d ) 556 ENDIF 557 IF( iom_use( "EXPCAL" ) ) THEN 558 zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite 559 CALL iom_put( "EXPCAL" , zw3d ) 560 ENDIF 561 IF( iom_use( "EXPSI" ) ) THEN 562 zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica 563 CALL iom_put( "EXPSI" , zw3d ) 564 ENDIF 565 IF( iom_use( "XNUM" ) ) THEN 566 zw3d(:,:,:) = znum3d(:,:,:) * tmask(:,:,:) ! Number of particles on aggregats 567 CALL iom_put( "XNUM" , zw3d ) 568 ENDIF 569 IF( iom_use( "WSC" ) ) THEN 570 zw3d(:,:,:) = wsbio3(:,:,:) * tmask(:,:,:) ! Sinking speed of carbon particles 571 CALL iom_put( "WSC" , zw3d ) 572 ENDIF 573 IF( iom_use( "WSN" ) ) THEN 574 zw3d(:,:,:) = wsbio4(:,:,:) * tmask(:,:,:) ! Sinking speed of particles number 575 CALL iom_put( "WSN" , zw3d ) 576 ENDIF 577 ! 578 CALL wrk_dealloc( jpi, jpj, zw2d ) 579 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 580 ELSE 581 IF( ln_diatrc ) THEN 582 zfact = 1.e3 * rfact2r 583 trc2d(:,: ,jp_pcs0_2d + 4) = sinking (:,:,ik100) * zfact * tmask(:,:,1) 584 trc2d(:,: ,jp_pcs0_2d + 5) = sinking2(:,:,ik100) * zfact * tmask(:,:,1) 585 trc2d(:,: ,jp_pcs0_2d + 6) = sinkfer (:,:,ik100) * zfact * tmask(:,:,1) 586 trc2d(:,: ,jp_pcs0_2d + 7) = sinksil (:,:,ik100) * zfact * tmask(:,:,1) 587 trc2d(:,: ,jp_pcs0_2d + 8) = sinkcal (:,:,ik100) * zfact * tmask(:,:,1) 588 trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:) * zfact * tmask(:,:,:) 589 trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:) * zfact * tmask(:,:,:) 590 trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:) * zfact * tmask(:,:,:) 591 trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:) * zfact * tmask(:,:,:) 592 trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d (:,:,:) * tmask(:,:,:) 593 trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3 (:,:,:) * tmask(:,:,:) 594 trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4 (:,:,:) * tmask(:,:,:) 493 595 ENDIF 494 # if ! defined key_iomput495 trc2d(:,: ,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1)496 trc2d(:,: ,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1)497 trc2d(:,: ,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1)498 trc2d(:,: ,jp_pcs0_2d + 7) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1)499 trc2d(:,: ,jp_pcs0_2d + 8) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1)500 trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:) * zrfact2 * tmask(:,:,:)501 trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:) * zrfact2 * tmask(:,:,:)502 trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:) * zrfact2 * tmask(:,:,:)503 trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:)504 trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d (:,:,:) * tmask(:,:,:)505 trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3 (:,:,:) * tmask(:,:,:)506 trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4 (:,:,:) * tmask(:,:,:)507 # endif508 !509 596 ENDIF 597 510 598 ! 511 599 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 610 698 zl = zmin 611 699 zr = zmax 612 wmax = 0.5 * fse3t(1,1,jk) * rday * float(niter1max) / rfact2700 wmax = 0.5 * e3t_n(1,1,jk) * rday * float(niter1max) / rfact2 613 701 zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 614 702 znum = zl - 1. … … 663 751 END DO 664 752 ! 753 ik100 = 10 ! last level where depth less than 100 m 754 DO jk = jpkm1, 1, -1 755 IF( gdept_1d(jk) > 100. ) iksed = jk - 1 756 END DO 757 IF (lwp) WRITE(numout,*) 758 IF (lwp) WRITE(numout,*) ' Level corresponding to 100m depth ', ik100 + 1 759 IF (lwp) WRITE(numout,*) 760 ! 665 761 t_oce_co2_exp = 0._wp 666 762 ! … … 702 798 ztraz(:,:,:) = 0.e0 703 799 zakz (:,:,:) = 0.e0 704 ztrb (:,:,:) = tr n(:,:,:,jp_tra)800 ztrb (:,:,:) = trb(:,:,:,jp_tra) 705 801 706 802 DO jk = 1, jpkm1 … … 717 813 ! first guess of the slopes interior values 718 814 DO jk = 2, jpkm1 719 ztraz(:,:,jk) = ( tr n(:,:,jk-1,jp_tra) - trn(:,:,jk,jp_tra) ) * tmask(:,:,jk)815 ztraz(:,:,jk) = ( trb(:,:,jk-1,jp_tra) - trb(:,:,jk,jp_tra) ) * tmask(:,:,jk) 720 816 END DO 721 817 ztraz(:,:,1 ) = 0.0 … … 746 842 DO jj = 1, jpj 747 843 DO ji = 1, jpi 748 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) 749 845 zew = zwsink2(ji,jj,jk+1) 750 psinkflx(ji,jj,jk+1) = -zew * ( tr n(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep846 psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 751 847 END DO 752 848 END DO … … 760 856 DO jj = 1,jpj 761 857 DO ji = 1, jpi 762 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk)763 tr n(ji,jj,jk,jp_tra) = trn(ji,jj,jk,jp_tra) + zflx858 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 859 trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx 764 860 END DO 765 861 END DO … … 771 867 DO jj = 1,jpj 772 868 DO ji = 1, jpi 773 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) 774 870 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 775 871 END DO … … 777 873 END DO 778 874 779 tr n(:,:,:,jp_tra) = ztrb(:,:,:)875 trb(:,:,:,jp_tra) = ztrb(:,:,:) 780 876 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 781 877 ! … … 815 911 816 912 !!====================================================================== 817 END MODULE 913 END MODULE p4zsink -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r4624 r6225 11 11 !! 'key_pisces' PISCES bio-model 12 12 !!---------------------------------------------------------------------- 13 !! p4zsms : Time loop of passive tracers sms13 !! p4zsms : Time loop of passive tracers sms 14 14 !!---------------------------------------------------------------------- 15 15 USE oce_trc ! shared variables between ocean and passive tracers … … 24 24 USE p4zsed ! Sedimentation 25 25 USE p4zint ! time interpolation 26 USE p4zrem ! remineralisation 26 27 USE iom ! I/O manager 27 USE trd mod_oce! Ocean trends variables28 USE trd mod_trc! TOP trends variables28 USE trd_oce ! Ocean trends variables 29 USE trdtrc ! TOP trends variables 29 30 USE sedmodel ! Sediment model 30 31 USE prtctl_trc ! print control for debugging … … 33 34 PRIVATE 34 35 35 PUBLIC p4z_sms_init ! called in p4zsms.F90 36 PUBLIC p4z_sms ! called in p4zsms.F90 37 38 REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget 39 INTEGER :: numco2, numnut !: logical unit for co2 budget 36 PUBLIC p4z_sms_init ! called in p4zsms.F90 37 PUBLIC p4z_sms ! called in p4zsms.F90 38 39 REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget 40 REAL(wp) :: xfact1, xfact2, xfact3 41 INTEGER :: numco2, numnut, numnit !: logical unit for co2 budget 42 43 !!* Array used to indicate negative tracer values 44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr !: ??? 45 40 46 41 47 !!---------------------------------------------------------------------- … … 61 67 INTEGER, INTENT( in ) :: kt ! ocean time-step index 62 68 !! 63 INTEGER :: jnt, jn, jl 69 INTEGER :: ji, jj, jk, jnt, jn, jl 70 REAL(wp) :: ztra 71 #if defined key_kriest 72 REAL(wp) :: zcoef1, zcoef2 73 #endif 64 74 CHARACTER (len=25) :: charout 65 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrdpis66 75 !!--------------------------------------------------------------------- 67 76 ! 68 77 IF( nn_timing == 1 ) CALL timing_start('p4z_sms') 69 78 ! 70 IF( l_trdtrc ) THEN71 CALL wrk_alloc( jpi, jpj, jpk, jp_pisces, ztrdpis )72 DO jn = 1, jp_pisces73 jl = jn + jp_pcs0 - 174 ztrdpis(:,:,:,jn) = trn(:,:,:,jl)75 ENDDO76 ENDIF77 !78 79 IF( kt == nittrc000 ) THEN 80 ! 81 ALLOCATE( xnegtr(jpi,jpj,jpk) ) 79 82 ! 80 83 CALL p4z_che ! initialize the chemical constants … … 88 91 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers 89 92 ! 93 ! ! set time step size (Euler/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 ENDIF 97 ! 98 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN 99 rfactr = 1. / rfact 100 rfact2 = rfact / FLOAT( nrdttrc ) 101 rfact2r = 1. / rfact2 102 xstep = rfact2 / rday ! Time step duration for biology 103 IF(lwp) WRITE(numout,*) 104 IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdt 105 IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2 106 IF(lwp) WRITE(numout,*) 107 ENDIF 108 109 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 110 DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter 111 trb(:,:,:,jn) = trn(:,:,:,jn) 112 END DO 113 ENDIF 114 ! 90 115 IF( ndayflxtr /= nday_year ) THEN ! New days 91 116 ! … … 105 130 DO jnt = 1, nrdttrc ! Potential time splitting if requested 106 131 ! 107 CALL p4z_bio (kt, jnt) ! Biology 108 CALL p4z_sed (kt, jnt) ! Sedimentation 109 ! 132 CALL p4z_bio( kt, jnt ) ! Biology 133 CALL p4z_sed( kt, jnt ) ! Sedimentation 134 CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation 135 CALL p4z_flx( kt, jnt ) ! Compute surface fluxes 136 ! 137 xnegtr(:,:,:) = 1.e0 110 138 DO jn = jp_pcs0, jp_pcs1 111 trb(:,:,:,jn) = trn(:,:,:,jn) 112 ENDDO 113 ! 139 DO jk = 1, jpk 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 143 ztra = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 144 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 145 ENDIF 146 END DO 147 END DO 148 END DO 149 END DO 150 ! ! where at least 1 tracer concentration becomes negative 151 ! ! 152 DO jn = jp_pcs0, jp_pcs1 153 trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 154 END DO 155 ! 156 DO jn = jp_pcs0, jp_pcs1 157 tra(:,:,:,jn) = 0._wp 158 END DO 159 ! 160 IF( ln_top_euler ) THEN 161 DO jn = jp_pcs0, jp_pcs1 162 trn(:,:,:,jn) = trb(:,:,:,jn) 163 END DO 164 ENDIF 114 165 END DO 115 166 116 IF( l_trdtrc ) THEN 117 DO jn = 1, jp_pisces 118 jl = jn + jp_pcs0 - 1 119 ztrdpis(:,:,:,jn) = ( ztrdpis(:,:,:,jn) - trn(:,:,:,jl) ) * rfact2r 120 ENDDO 121 ENDIF 122 123 CALL p4z_lys( kt ) ! Compute CaCO3 saturation 124 CALL p4z_flx( kt ) ! Compute surface fluxes 125 126 DO jn = jp_pcs0, jp_pcs1 127 CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 128 CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 129 CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. ) 167 #if defined key_kriest 168 ! 169 zcoef1 = 1.e0 / xkr_massp 170 zcoef2 = 1.e0 / xkr_massp / 1.1 171 DO jk = 1,jpkm1 172 trb(:,:,jk,jpnum) = MAX( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk) ) 173 trb(:,:,jk,jpnum) = MIN( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2 ) 130 174 END DO 131 175 ! 176 #endif 177 ! 178 ! 179 IF( l_trdtrc ) THEN 180 DO jn = jp_pcs0, jp_pcs1 181 CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends 182 END DO 183 END IF 184 ! 132 185 IF( lk_sed ) THEN 133 186 ! … … 135 188 ! 136 189 DO jn = jp_pcs0, jp_pcs1 137 CALL lbc_lnk( tr n(:,:,:,jn), 'T', 1. )190 CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 138 191 END DO 139 192 ! … … 142 195 IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' ) !* Write PISCES informations in restart file 143 196 ! 144 IF( l_trdtrc ) THEN 145 DO jn = 1, jp_pisces 146 jl = jn + jp_pcs0 - 1 147 ztrdpis(:,:,:,jn) = ztrdpis(:,:,:,jn) + tra(:,:,:,jl) 148 CALL trd_mod_trc( ztrdpis(:,:,:,jn), jn, jptra_trd_sms, kt ) ! save trends 149 END DO 150 CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdpis ) 151 END IF 152 ! 153 CALL p4z_chk_mass( kt ) ! Mass conservation checking 197 198 IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt ) ! Mass conservation checking 154 199 155 200 IF ( lwm .AND. kt == nittrc000 ) CALL FLUSH ( numonp ) ! flush output namelist PISCES … … 281 326 ztmas = tmask(ji,jj,jk) 282 327 ztmas1 = 1. - tmask(ji,jj,jk) 283 zcaralk = tr n(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) )284 zco3 = ( zcaralk - tr n(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1285 zbicarb = ( 2. * tr n(ji,jj,jk,jpdic) - zcaralk )328 zcaralk = trb(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 329 zco3 = ( zcaralk - trb(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 330 zbicarb = ( 2. * trb(ji,jj,jk,jpdic) - zcaralk ) 286 331 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 287 332 END DO … … 328 373 ENDIF 329 374 ! 375 IF( iom_varid( numrtr, 'tcflxcum', ldstop = .FALSE. ) > 0 ) THEN ! cumulative total flux of carbon 376 CALL iom_get( numrtr, 'tcflxcum' , t_oce_co2_flx_cum ) 377 ELSE 378 t_oce_co2_flx_cum = 0._wp 379 ENDIF 380 ! 330 381 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 331 382 IF( kt == nitrst ) THEN … … 337 388 CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 338 389 CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 390 CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum ) 339 391 ENDIF 340 392 ! … … 355 407 REAL(wp) :: silmean = 91.51 ! mean value of silicate 356 408 ! 357 REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum 409 REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn 410 REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb 358 411 !!--------------------------------------------------------------------- 359 412 … … 368 421 zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6 369 422 370 zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea371 zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r372 zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3373 zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea423 zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea 424 zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 425 zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 426 zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 374 427 375 IF(lwp) WRITE(numout,*) ' TALK mean : ', zalksum 376 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum 377 378 IF(lwp) WRITE(numout,*) ' PO4 mean : ', zpo4sum 379 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum 380 381 IF(lwp) WRITE(numout,*) ' NO3 mean : ', zno3sum 382 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum 383 384 IF(lwp) WRITE(numout,*) ' SiO3 mean : ', zsilsum 385 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum ) 386 ! 387 ENDIF 388 428 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn 429 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 430 431 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn 432 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 433 434 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn 435 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 436 437 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn 438 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 439 ! 440 ! 441 IF( .NOT. ln_top_euler ) THEN 442 zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea 443 zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 444 zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 445 zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 446 447 IF(lwp) WRITE(numout,*) ' ' 448 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 449 trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 450 451 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 452 trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 453 454 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 455 trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 456 457 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 458 trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 459 ENDIF 460 ! 461 ENDIF 462 ! 389 463 END SUBROUTINE p4z_dmp 390 464 … … 399 473 ! 400 474 INTEGER, INTENT( in ) :: kt ! ocean time-step index 401 !! 475 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 476 CHARACTER(LEN=100) :: cltxt 477 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol 478 INTEGER :: jk 479 !!---------------------------------------------------------------------- 480 481 ! 402 482 !!--------------------------------------------------------------------- 403 483 … … 406 486 CALL ctl_opn( numco2, 'carbon.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 407 487 CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 488 CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 489 xfact1 = rfact2r * 12. / 1.e15 * ryyss ! conversion molC/kt --> PgC/yr 490 xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss ! conversion molC/l/s ----> TgN/m3/yr 491 xfact3 = 1.e+3 * rfact2r * rno3 ! conversion molC/l/kt ----> molN/m3/s 492 cltxt='time-step Alkalinity Nitrate Phosphorus Silicate Iron' 493 IF( lwp ) WRITE(numnut,*) TRIM(cltxt) 494 IF( lwp ) WRITE(numnut,*) 408 495 ENDIF 409 496 ENDIF 410 497 411 IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer 498 ! 499 IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 500 ! Compute the budget of NO3, ALK, Si, Fer 412 501 no3budget = glob_sum( ( trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) & 413 502 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & … … 417 506 & + trn(:,:,:,jpgoc) & 418 507 #endif 419 & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) ) 420 ! 508 & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) ) 509 ! 510 no3budget = no3budget / areatot 511 CALL iom_put( "pno3tot", no3budget ) 512 ENDIF 513 ! 514 IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 515 po4budget = glob_sum( ( trn(:,:,:,jppo4) & 516 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & 517 & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) & 518 & + trn(:,:,:,jppoc) & 519 #if ! defined key_kriest 520 & + trn(:,:,:,jpgoc) & 521 #endif 522 & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) ) 523 po4budget = po4budget / areatot 524 CALL iom_put( "ppo4tot", po4budget ) 525 ENDIF 526 ! 527 IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 421 528 silbudget = glob_sum( ( trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) & 422 529 & + trn(:,:,:,jpdsi) ) * cvol(:,:,:) ) 423 ! 530 ! 531 silbudget = silbudget / areatot 532 CALL iom_put( "psiltot", silbudget ) 533 ENDIF 534 ! 535 IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 424 536 alkbudget = glob_sum( ( trn(:,:,:,jpno3) * rno3 & 425 537 & + trn(:,:,:,jptal) & 426 538 & + trn(:,:,:,jpcal) * 2. ) * cvol(:,:,:) ) 427 ! 539 ! 540 alkbudget = alkbudget / areatot 541 CALL iom_put( "palktot", alkbudget ) 542 ENDIF 543 ! 544 IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 428 545 ferbudget = glob_sum( ( trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) & 429 546 & + trn(:,:,:,jpdfe) & … … 434 551 & + trn(:,:,:,jpzoo) * ferat3 & 435 552 & + trn(:,:,:,jpmes) * ferat3 ) * cvol(:,:,:) ) 436 437 ! 553 ! 554 ferbudget = ferbudget / areatot 555 CALL iom_put( "pfertot", ferbudget ) 556 ENDIF 557 ! 558 559 ! Global budget of N SMS : denitrification in the water column and in the sediment 560 ! nitrogen fixation by the diazotrophs 561 ! -------------------------------------------------------------------------------- 562 IF( iom_use( "tnfix" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 563 znitrpottot = glob_sum ( nitrpot(:,:,:) * nitrfix * cvol(:,:,:) ) 564 CALL iom_put( "tnfix" , znitrpottot * 1.e+3 * rno3 ) ! Global nitrogen fixation molC/l to molN/m3 565 ENDIF 566 ! 567 IF( iom_use( "tdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 568 zrdenittot = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) ) 569 CALL iom_put( "tdenit" , zrdenittot * 1.e+3 * rno3 ) ! Total denitrification molC/l to molN/m3 570 ENDIF 571 ! 572 IF( iom_use( "Sdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 573 zsdenittot = glob_sum ( sdenit(:,:) * e1e2t(:,:) ) 574 CALL iom_put( "Sdenit", sdenit(:,:) * xfact3 * tmask(:,:,1) ) ! Nitrate reduction in the sediments 575 ENDIF 576 577 IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer 438 578 t_atm_co2_flx = t_atm_co2_flx / glob_sum( e1e2t(:,:) ) 439 t_oce_co2_flx = t_oce_co2_flx * 12. / 1.e15* (-1 )440 tpp = tpp * 1000. * 12. / 1.E15441 t_oce_co2_exp = t_oce_co2_exp * 1000. * 12. / 1.E15442 !443 no3budget = no3budget / areatot444 silbudget = silbudget / areatot445 alkbudget = alkbudget / areatot446 ferbudget = ferbudget / areatot447 !448 IF(lwp) THEN449 WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp450 WRITE(numnut,9500) ndastp, alkbudget, no3budget, silbudget, ferbudget451 ENDIF452 ! 453 ENDIF 454 579 t_oce_co2_flx = t_oce_co2_flx * xfact1 * (-1 ) 580 tpp = tpp * 1000. * xfact1 581 t_oce_co2_exp = t_oce_co2_exp * 1000. * xfact1 582 IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp 583 IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget * 1.e+06, & 584 & no3budget * rno3 * 1.e+06, & 585 & po4budget * po4r * 1.e+06, & 586 & silbudget * 1.e+06, & 587 & ferbudget * 1.e+09 588 ! 589 IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2 , & 590 & zrdenittot * xfact2 , & 591 & zsdenittot * xfact2 592 593 ENDIF 594 ! 455 595 9000 FORMAT(i8,f10.5,e18.10,f10.5,f10.5) 456 9500 FORMAT(i8,4e18.10) 596 9100 FORMAT(i8,5e18.10) 597 9200 FORMAT(i8,3f10.5) 598 457 599 ! 458 600 END SUBROUTINE p4z_chk_mass -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90
- Property svn:keywords set to Id
r3443 r6225 7 7 !! ! 06-12 (C. Ethe) Orignal 8 8 !!---------------------------------------------------------------------- 9 !! $Id$ 9 10 #if defined key_sed 10 11 !! Domain characteristics -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90
- Property svn:keywords set to Id
r4292 r6225 160 160 INTEGER, PUBLIC :: numsed = 27 ! units 161 161 162 !! $Id$ 162 163 CONTAINS 163 164 -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90
- Property svn:keywords set to Id
r3443 r6225 23 23 REAL(wp) :: eps = 1.e-13 24 24 25 !! $Id$ 25 26 CONTAINS 26 27 … … 438 439 !! MODULE sedbtb : Dummy module 439 440 !!====================================================================== 441 !! $Id$ 440 442 CONTAINS 441 443 SUBROUTINE sed_adv( kt ) ! Empty routine -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90
- Property svn:keywords set to Id
r3443 r6225 29 29 !!---------------------------------------------------------------------- 30 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 31 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtab.F90,v 1.2 2005/03/27 18:34:42 opalod Exp$31 !! $Id$ 32 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 33 !!---------------------------------------------------------------------- -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90
- Property svn:keywords set to Id
r3443 r6225 12 12 13 13 14 !! $Id$ 14 15 CONTAINS 15 16 … … 77 78 !! MODULE sedbtb : Dummy module 78 79 !!====================================================================== 80 !! $Id$ 79 81 CONTAINS 80 82 SUBROUTINE sed_btb( kt ) ! Empty routine -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90
- Property svn:keywords set to Id
r3443 r6225 163 163 DATA Ddsw / 999.842594 , 6.793952E-2 , -9.095290E-3, 1.001685E-4, -1.120083E-6, 6.536332E-9/ 164 164 165 !! $Id$ 165 166 CONTAINS 166 167 … … 559 560 !! MODULE sedchem : Dummy module 560 561 !!====================================================================== 562 !! $Id$ 561 563 CONTAINS 562 564 SUBROUTINE sed_chem( kt ) ! Empty routine -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90
- Property svn:keywords set to Id
r3443 r6225 23 23 !!---------------------------------------------------------------------- 24 24 25 !! $Id$ 25 26 CONTAINS 26 27 … … 188 189 !! MODULE sedco3 : Dummy module 189 190 !!====================================================================== 191 !! $Id$ 190 192 CONTAINS 191 193 SUBROUTINE sed_co3( kt ) ! Empty routine -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90
- Property svn:keywords set to Id
r3443 r6225 20 20 REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: dens_mol_wgt ! molecular density 21 21 22 !! $Id$ 22 23 CONTAINS 23 24 … … 530 531 !! MODULE seddsr : Dummy module 531 532 !!====================================================================== 533 !! $Id$ 532 534 CONTAINS 533 535 SUBROUTINE sed_dsr ( kt ) -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90
- Property svn:keywords set to Id
r3443 r6225 28 28 #endif 29 29 30 !! $Id$ 30 31 CONTAINS 31 32 … … 268 269 !! MODULE seddta : Dummy module 269 270 !!====================================================================== 271 !! $Id$ 270 272 CONTAINS 271 273 SUBROUTINE sed_dta ( kt ) -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90
- Property svn:keywords set to Id
r4292 r6225 55 55 PUBLIC sed_init ! routine called by opa.F90 56 56 57 !! $Id$ 57 58 CONTAINS 58 59 … … 856 857 !! Dummy module : NO Sediment model 857 858 !!---------------------------------------------------------------------- 859 !! $Id$ 858 860 CONTAINS 859 861 SUBROUTINE sed_ini ! Empty routine -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90
- Property svn:keywords set to Id
r3443 r6225 22 22 23 23 24 !! $Id$ 24 25 CONTAINS 25 26 … … 257 258 !! MODULE sedmat : Dummy module 258 259 !!====================================================================== 260 !! $Id$ 259 261 CONTAINS 260 262 SUBROUTINE sed_mat ! Empty routine -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90
- Property svn:keywords set to Id
r3443 r6225 36 36 REAL(wp) :: src13ca 37 37 38 !! $Id$ 38 39 CONTAINS 39 40 … … 311 312 !! MODULE sedmbc : Dummy module 312 313 !!====================================================================== 314 !! $Id$ 313 315 CONTAINS 314 316 SUBROUTINE sed_mbc( kt ) ! Empty routine -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90
- Property svn:keywords set to Id
r3443 r6225 17 17 LOGICAL, PUBLIC, PARAMETER :: lk_sed = .TRUE. !: sediment flag 18 18 19 !! $Id$ 19 20 CONTAINS 20 21 … … 47 48 !!====================================================================== 48 49 LOGICAL, PUBLIC, PARAMETER :: lk_sed = .FALSE. !: sediment flag 50 !! $Id$ 49 51 CONTAINS 50 52 SUBROUTINE sed_model( kt ) ! Empty routine -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90
- Property svn:keywords set to Id
r3443 r6225 25 25 26 26 27 !! $Id$ 27 28 CONTAINS 28 29 … … 59 60 60 61 ALLOCATE( zdta(jpi,jpj,jpksed,jptrased), zdta1(jpi,jpj,jpksed,2), zhipor(jpoce,jpksed) ) 61 62 IF ( jprstlib == jprstdimg ) THEN63 ! eventually read netcdf file (monobloc) for restarting on different number of processors64 ! if restart_sed.nc exists, then set jlibalt to jpnf9065 INQUIRE( FILE = 'restart_sed.nc', EXIST = llok )66 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF67 ENDIF68 62 69 63 CALL iom_open( 'restart_sed', numrsr, kiolib = jlibalt ) … … 270 264 !! MODULE sedrst : Dummy module 271 265 !!====================================================================== 266 !! $Id$ 272 267 CONTAINS 273 268 SUBROUTINE sed_rst_read ! Empty routines -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90
- Property svn:keywords set to Id
r3443 r6225 12 12 PUBLIC sed_sfc 13 13 14 !! $Id$ 14 15 CONTAINS 15 16 … … 67 68 !! MODULE sedsfc : Dummy module 68 69 !!====================================================================== 70 !! $Id$ 69 71 CONTAINS 70 72 SUBROUTINE sed_sfc ( kt ) -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90
- Property svn:keywords set to Id
r3443 r6225 23 23 PUBLIC sed_stp ! called by step.F90 24 24 25 !! $Id$ 25 26 CONTAINS 26 27 … … 69 70 !! MODULE sedstp : Dummy module 70 71 !!====================================================================== 72 !! $Id$ 71 73 CONTAINS 72 74 SUBROUTINE sed_stp( kt ) ! Empty routine -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90
- Property svn:keywords set to Id
r3443 r6225 25 25 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51 26 26 27 !! $Id$ 27 28 CONTAINS 28 29 … … 264 265 !! MODULE sedwri : Dummy module 265 266 !!====================================================================== 267 !! $Id$ 266 268 CONTAINS 267 269 SUBROUTINE sed_wri( kt ) ! Empty routine -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90
r3680 r6225 63 63 INTEGER, PUBLIC, PARAMETER :: jpdia = 11 !: Diatoms Concentration 64 64 INTEGER, PUBLIC, PARAMETER :: jpmes = 12 !: Mesozooplankton Concentration 65 INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: (big)Silicate Concentration65 INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: Diatoms Silicate Concentration 66 66 INTEGER, PUBLIC, PARAMETER :: jpfer = 14 !: Iron Concentration 67 67 INTEGER, PUBLIC, PARAMETER :: jpnum = 15 !: Big iron particles Concentration 68 68 INTEGER, PUBLIC, PARAMETER :: jpsfe = 16 !: number of particulate organic phosphate concentration 69 69 INTEGER, PUBLIC, PARAMETER :: jpdfe = 17 !: Diatoms iron Concentration 70 INTEGER, PUBLIC, PARAMETER :: jpgsi = 18 !: DiatomsSilicate Concentration70 INTEGER, PUBLIC, PARAMETER :: jpgsi = 18 !: (big) Silicate Concentration 71 71 INTEGER, PUBLIC, PARAMETER :: jpnfe = 19 !: Nano iron Concentration 72 72 INTEGER, PUBLIC, PARAMETER :: jpnch = 20 !: Nano Chlorophyll Concentration … … 102 102 INTEGER, PUBLIC, PARAMETER :: jpdia = 11 !: Diatoms Concentration 103 103 INTEGER, PUBLIC, PARAMETER :: jpmes = 12 !: Mesozooplankton Concentration 104 INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: (big)Silicate Concentration104 INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: Diatoms Silicate Concentration 105 105 INTEGER, PUBLIC, PARAMETER :: jpfer = 14 !: Iron Concentration 106 106 INTEGER, PUBLIC, PARAMETER :: jpbfe = 15 !: Big iron particles Concentration … … 108 108 INTEGER, PUBLIC, PARAMETER :: jpsfe = 17 !: Small iron particles Concentration 109 109 INTEGER, PUBLIC, PARAMETER :: jpdfe = 18 !: Diatoms iron Concentration 110 INTEGER, PUBLIC, PARAMETER :: jpgsi = 19 !: DiatomsSilicate Concentration110 INTEGER, PUBLIC, PARAMETER :: jpgsi = 19 !: (big) Silicate Concentration 111 111 INTEGER, PUBLIC, PARAMETER :: jpnfe = 20 !: Nano iron Concentration 112 112 INTEGER, PUBLIC, PARAMETER :: jpnch = 21 !: Nano Chlorophyll Concentration -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r4529 r6225 36 36 REAL(wp) :: rfact2, rfact2r !: ??? 37 37 REAL(wp) :: xstep !: Time step duration for biology 38 REAL(wp) :: ryyss !: number of seconds per year 39 REAL(wp) :: r1_ryyss !: inverse number of seconds per year 40 38 41 39 42 !!* Biological parameters … … 53 56 REAL(wp) :: t_oce_co2_exp !: total carbon export 54 57 REAL(wp) :: t_oce_co2_flx !: Total ocean carbon flux 58 REAL(wp) :: t_oce_co2_flx_cum !: Cumulative Total ocean carbon flux 55 59 REAL(wp) :: t_atm_co2_flx !: global mean of atmospheric pco2 56 60 … … 102 106 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc2 !: Temp. dependancy of mesozooplankton rates 103 107 104 !!* Array used to indicate negative tracer values105 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr !: ???106 107 108 #if defined key_kriest 108 109 !!* Kriest parameter for aggregation … … 127 128 !!---------------------------------------------------------------------- 128 129 USE lib_mpp , ONLY: ctl_warn 129 INTEGER :: ierr( 6) ! Local variables130 INTEGER :: ierr(5) ! Local variables 130 131 !!---------------------------------------------------------------------- 131 132 ierr(:) = 0 … … 158 159 ALLOCATE( tgfunc(jpi,jpj,jpk) , tgfunc2(jpi,jpj,jpk) , STAT=ierr(5) ) 159 160 ! 160 !* Array used to indicate negative tracer values161 ALLOCATE( xnegtr(jpi,jpj,jpk) , STAT=ierr(6) )162 161 #endif 163 162 ! -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r4521 r6225 27 27 PUBLIC trc_ini_pisces ! called by trcini.F90 module 28 28 29 30 # include "top_substitute.h90"31 29 !!---------------------------------------------------------------------- 32 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 71 69 USE p4zmort ! Mortality terms for phytoplankton 72 70 USE p4zlys ! Calcite saturation 71 USE p4zsed ! Sedimentation & burial 73 72 ! 74 73 REAL(wp), SAVE :: sco2 = 2.312e-3_wp 75 REAL(wp), SAVE :: alka0 = 2.42 3e-3_wp74 REAL(wp), SAVE :: alka0 = 2.426e-3_wp 76 75 REAL(wp), SAVE :: oxyg0 = 177.6e-6_wp 77 REAL(wp), SAVE :: po4 = 2.1 74e-6_wp76 REAL(wp), SAVE :: po4 = 2.165e-6_wp 78 77 REAL(wp), SAVE :: bioma0 = 1.000e-8_wp 79 REAL(wp), SAVE :: silic1 = 91. 65e-6_wp80 REAL(wp), SAVE :: no3 = 3 1.04e-6_wp * 7.625_wp78 REAL(wp), SAVE :: silic1 = 91.51e-6_wp 79 REAL(wp), SAVE :: no3 = 30.9e-6_wp * 7.625_wp 81 80 ! 82 81 INTEGER :: ji, jj, jk, ierr … … 97 96 ierr = ierr + p4z_rem_alloc() 98 97 ierr = ierr + p4z_flx_alloc() 98 ierr = ierr + p4z_sed_alloc() 99 99 ! 100 100 IF( lk_mpp ) CALL mpp_sum( ierr ) 101 101 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'pisces_alloc: unable to allocate PISCES arrays' ) 102 102 ! 103 ryyss = nyear_len(1) * rday ! number of seconds per year 104 r1_ryyss = 1. / ryyss 105 ! 103 106 104 107 CALL p4z_sms_init ! Maint routine 105 108 ! ! Time-step 106 rfact = rdttrc(1) ! ---------107 rfactr = 1. / rfact108 rfact2 = rfact / FLOAT( nrdttrc )109 rfact2r = 1. / rfact2110 111 IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdttra(1)112 IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2113 114 115 109 116 110 ! Set biological ratios … … 162 156 END IF 163 157 164 ! Time step duration for biology165 xstep = rfact2 / rday166 158 167 159 CALL p4z_sink_init ! vertical flux of particulate organic matter -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90
r4624 r6225 19 19 USE trc ! TOP variables 20 20 USE sms_pisces ! sms trends 21 USE trd mod_trc_oce21 USE trdtrc_oce 22 22 USE iom ! I/O manager 23 23 … … 123 123 #if defined key_pisces_reduced 124 124 125 IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdm ld_trc ) THEN125 IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdmxl_trc ) THEN 126 126 ! 127 127 ! Namelist nampisdbi -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90
r4292 r6225 21 21 PUBLIC trc_wri_pisces 22 22 23 # include "top_substitute.h90" 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 !!---------------------------------------------------------------------- 24 28 CONTAINS 25 29 … … 30 34 !! ** Purpose : output passive tracers fields 31 35 !!--------------------------------------------------------------------- 32 CHARACTER (len=20) :: cltra 33 REAL(wp) :: zrfact 34 INTEGER :: jn 36 CHARACTER (len=20) :: cltra 37 REAL(wp) :: zfact 38 INTEGER :: ji, jj, jk, jn 39 REAL(wp), DIMENSION(jpi,jpj) :: zdic, zo2min, zdepo2min 35 40 !!--------------------------------------------------------------------- 36 41 … … 40 45 DO jn = jp_pcs0, jp_pcs1 41 46 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 42 IF( lk_vvl ) THEN 43 CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) ) 44 ELSE 45 CALL iom_put( cltra, trn(:,:,:,jn) ) 46 ENDIF 47 CALL iom_put( cltra, trn(:,:,:,jn) * zrfact ) 47 CALL iom_put( cltra, trn(:,:,:,jn) ) 48 48 END DO 49 49 #else 50 50 DO jn = jp_pcs0, jp_pcs1 51 z rfact = 1.0e+652 IF( jn == jpno3 .OR. jn == jpnh4 ) z rfact = rno3 * 1.0e+653 IF( jn == jppo4 ) z rfact = po4r * 1.0e+651 zfact = 1.0e+6 52 IF( jn == jpno3 .OR. jn == jpnh4 ) zfact = rno3 * 1.0e+6 53 IF( jn == jppo4 ) zfact = po4r * 1.0e+6 54 54 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 55 IF( lk_vvl ) THEN 56 CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) * zrfact ) 57 ELSE 58 CALL iom_put( cltra, trn(:,:,:,jn) * zrfact ) 59 ENDIF 55 IF( iom_use( cltra ) ) CALL iom_put( cltra, trn(:,:,:,jn) * zfact ) 60 56 END DO 57 58 IF( iom_use( "INTDIC" ) ) THEN ! DIC content in kg/m2 59 zdic(:,:) = 0. 60 DO jk = 1, jpkm1 61 zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 62 ENDDO 63 CALL iom_put( 'INTDIC', zdic ) 64 ENDIF 65 ! 66 IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth 67 zo2min (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 68 zdepo2min(:,:) = gdepw_n(:,:,1) * tmask(:,:,1) 69 DO jk = 2, jpkm1 70 DO jj = 1, jpj 71 DO ji = 1, jpi 72 IF( tmask(ji,jj,jk) == 1 ) then 73 IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 74 zo2min (ji,jj) = trn(ji,jj,jk,jpoxy) 75 zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 76 ENDIF 77 ENDIF 78 END DO 79 END DO 80 END DO 81 ! 82 CALL iom_put('O2MIN' , zo2min ) ! oxygen minimum concentration 83 CALL iom_put('ZO2MIN', zdepo2min ) ! depth of oxygen minimum concentration 84 ! 85 ENDIF 61 86 #endif 62 87 ! -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r4610 r6225 4 4 !! Ocean passive tracers: advection trend 5 5 !!============================================================================== 6 !! History : 2.0 ! 05-11 (G. Madec) Original code 7 !! 3.0 ! 10-06 (C. Ethe) Adapted to passive tracers 6 !! History : 2.0 ! 2005-11 (G. Madec) Original code 7 !! 3.0 ! 2010-06 (C. Ethe) Adapted to passive tracers 8 !! 3.7 ! 2014-05 (G. Madec, C. Ethe) Add 2nd/4th order cases for CEN and FCT schemes 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_top … … 11 12 !! 'key_top' TOP models 12 13 !!---------------------------------------------------------------------- 13 !! trc_adv : compute ocean tracer advection trend 14 !! trc_adv_ctl : control the different options of advection scheme 15 !!---------------------------------------------------------------------- 16 USE oce_trc ! ocean dynamics and active tracers 17 USE trc ! ocean passive tracers variables 18 USE trcnam_trp ! passive tracers transport namelist variables 19 USE traadv_cen2 ! 2nd order centered scheme (tra_adv_cen2 routine) 20 USE traadv_tvd ! TVD scheme (tra_adv_tvd routine) 21 USE traadv_muscl ! MUSCL scheme (tra_adv_muscl routine) 22 USE traadv_muscl2 ! MUSCL2 scheme (tra_adv_muscl2 routine) 23 USE traadv_ubs ! UBS scheme (tra_adv_ubs routine) 24 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) 25 USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine) 26 USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine) 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 USE prtctl_trc ! Print control 14 !! trc_adv : compute ocean tracer advection trend 15 !! trc_adv_ini : control the different options of advection scheme 16 !!---------------------------------------------------------------------- 17 USE oce_trc ! ocean dynamics and active tracers 18 USE trc ! ocean passive tracers variables 19 USE traadv_cen ! centered scheme (tra_adv_cen routine) 20 USE traadv_fct ! FCT scheme (tra_adv_fct routine) 21 USE traadv_mus ! MUSCL scheme (tra_adv_mus routine) 22 USE traadv_ubs ! UBS scheme (tra_adv_ubs routine) 23 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) 24 USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine) 25 USE ldftra ! lateral diffusion coefficient on tracers 26 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 27 ! 28 USE prtctl_trc ! Print control 29 29 30 30 IMPLICIT NONE 31 31 PRIVATE 32 32 33 PUBLIC trc_adv ! routine called by step module 34 PUBLIC trc_adv_alloc ! routine called by nemogcm module 35 36 INTEGER :: nadv ! choice of the type of advection scheme 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 38 ! ! except at nitrrc000 (=rdttra) if neuler=0 33 PUBLIC trc_adv 34 PUBLIC trc_adv_ini 35 36 ! !!* Namelist namtrc_adv * 37 LOGICAL :: ln_trcadv_cen ! centered scheme flag 38 INTEGER :: nn_cen_h, nn_cen_v ! =2/4 : horizontal and vertical choices of the order of CEN scheme 39 LOGICAL :: ln_trcadv_fct ! FCT scheme flag 40 INTEGER :: nn_fct_h, nn_fct_v ! =2/4 : horizontal and vertical choices of the order of FCT scheme 41 INTEGER :: nn_fct_zts ! >=1 : 2nd order FCT with vertical sub-timestepping 42 LOGICAL :: ln_trcadv_mus ! MUSCL scheme flag 43 LOGICAL :: ln_mus_ups ! use upstream scheme in vivcinity of river mouths 44 LOGICAL :: ln_trcadv_ubs ! UBS scheme flag 45 INTEGER :: nn_ubs_v ! =2/4 : vertical choice of the order of UBS scheme 46 LOGICAL :: ln_trcadv_qck ! QUICKEST scheme flag 47 48 ! ! choices of advection scheme: 49 INTEGER, PARAMETER :: np_NO_adv = 0 ! no T-S advection 50 INTEGER, PARAMETER :: np_CEN = 1 ! 2nd/4th order centered scheme 51 INTEGER, PARAMETER :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme 52 INTEGER, PARAMETER :: np_FCT_zts = 3 ! 2nd order FCT scheme with vertical sub-timestepping 53 INTEGER, PARAMETER :: np_MUS = 4 ! MUSCL scheme 54 INTEGER, PARAMETER :: np_UBS = 5 ! 3rd order Upstream Biased Scheme 55 INTEGER, PARAMETER :: np_QCK = 6 ! QUICK scheme 56 57 INTEGER :: nadv ! chosen advection scheme 58 ! 59 REAL(wp) :: r2dttrc ! vertical profile time-step, = 2 rdt 60 ! ! except at nitrrc000 (=rdt) if neuler=0 39 61 40 62 !! * Substitutions 41 # include "domzgr_substitute.h90"42 63 # include "vectopt_loop_substitute.h90" 43 64 !!---------------------------------------------------------------------- 44 !! NEMO/TOP 3. 3 , NEMO Consortium (2010)65 !! NEMO/TOP 3.7 , NEMO Consortium (2015) 45 66 !! $Id$ 46 67 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 47 68 !!---------------------------------------------------------------------- 48 69 CONTAINS 49 50 INTEGER FUNCTION trc_adv_alloc()51 !!----------------------------------------------------------------------52 !! *** ROUTINE trc_adv_alloc ***53 !!----------------------------------------------------------------------54 55 ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc )56 57 IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')58 59 END FUNCTION trc_adv_alloc60 61 70 62 71 SUBROUTINE trc_adv( kt ) … … 68 77 !! ** Method : - Update the tracer with the advection term following nadv 69 78 !!---------------------------------------------------------------------- 70 !!71 79 INTEGER, INTENT(in) :: kt ! ocean time-step index 72 80 ! 73 INTEGER :: jk 81 INTEGER :: jk ! dummy loop index 74 82 CHARACTER (len=22) :: charout 75 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn ! effective velocity 76 84 !!---------------------------------------------------------------------- 77 85 ! 78 IF( nn_timing == 1 ) CALL timing_start('trc_adv') 79 ! 80 CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 81 ! 82 83 IF( kt == nittrc000 ) CALL trc_adv_ctl ! initialisation & control of options 84 85 IF( ln_top_euler) THEN 86 r2dt(:) = rdttrc(:) ! = rdttrc (use Euler time stepping) 87 ELSE 88 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 89 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 90 ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1 91 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 92 ENDIF 93 ENDIF 94 95 ! ! effective transport 86 IF( nn_timing == 1 ) CALL timing_start('trc_adv') 87 ! 88 CALL wrk_alloc( jpi,jpj,jpk, zun, zvn, zwn ) 89 ! 90 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 91 r2dttrc = rdttrc ! = rdttrc (use or restarting with Euler time stepping) 92 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 93 r2dttrc = 2. * rdttrc ! = 2 rdttrc (leapfrog) 94 ENDIF 95 ! !== effective transport ==! 96 96 DO jk = 1, jpkm1 97 ! ! eulerian transport only 98 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) 99 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) 100 99 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 101 !102 100 END DO 103 101 ! 104 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 102 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 105 103 zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 106 104 zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 107 105 ENDIF 108 106 ! 109 zun(:,:,jpk) = 0._wp ! no transport trough the bottom 110 zvn(:,:,jpk) = 0._wp ! no transport trough the bottom 111 zwn(:,:,jpk) = 0._wp ! no transport trough the bottom 112 113 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & ! add the eiv transport (if necessary) 114 & CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 115 ! 116 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport (if necessary) 117 ! 118 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 119 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered 120 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD 121 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups ) ! MUSCL 122 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2 123 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS 124 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST 125 ! 126 CASE (-1 ) !== esopa: test all possibility with control print ==! 127 CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 128 WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout) 129 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 130 CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 131 WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout) 132 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 133 CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups ) 134 WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout) 135 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 136 CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 137 WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout) 138 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 139 CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 140 WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout) 141 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 142 CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 143 WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout) 144 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 145 ! 107 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 108 & CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the eiv transport 109 ! 110 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport 111 ! 112 zun(:,:,jpk) = 0._wp ! no transport trough the bottom 113 zvn(:,:,jpk) = 0._wp 114 zwn(:,:,jpk) = 0._wp 115 ! 116 ! 117 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 118 ! 119 CASE ( np_CEN ) ! Centered : 2nd / 4th order 120 CALL tra_adv_cen ( kt, nittrc000,'TRC', zun, zvn, zwn , trn, tra, jptra, nn_cen_h, nn_cen_v ) 121 CASE ( np_FCT ) ! FCT : 2nd / 4th order 122 CALL tra_adv_fct ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 123 CASE ( np_FCT_zts ) ! 2nd order FCT with vertical time-splitting 124 CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra , nn_fct_zts ) 125 CASE ( np_MUS ) ! MUSCL 126 CALL tra_adv_mus ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, tra, jptra , ln_mus_ups ) 127 CASE ( np_UBS ) ! UBS 128 CALL tra_adv_ubs ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra , nn_ubs_v ) 129 CASE ( np_QCK ) ! QUICKEST 130 CALL tra_adv_qck ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) 131 ! 146 132 END SELECT 147 148 ! ! print mean trends (used for debugging) 149 IF( ln_ctl ) THEN 133 ! 134 IF( ln_ctl ) THEN !== print mean trends (used for debugging) 150 135 WRITE(charout, FMT="('adv ')") ; CALL prt_ctl_trc_info(charout) 151 136 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 152 137 END IF 153 138 ! 154 CALL wrk_dealloc( jpi, jpj, jpk,zun, zvn, zwn )139 CALL wrk_dealloc( jpi,jpj,jpk, zun, zvn, zwn ) 155 140 ! 156 141 IF( nn_timing == 1 ) CALL timing_stop('trc_adv') … … 159 144 160 145 161 SUBROUTINE trc_adv_ ctl146 SUBROUTINE trc_adv_ini 162 147 !!--------------------------------------------------------------------- 163 !! *** ROUTINE trc_adv_ ctl***148 !! *** ROUTINE trc_adv_ini *** 164 149 !! 165 150 !! ** Purpose : Control the consistency between namelist options for … … 167 152 !!---------------------------------------------------------------------- 168 153 INTEGER :: ioptio 169 !!---------------------------------------------------------------------- 170 171 ioptio = 0 ! Parameter control 172 IF( ln_trcadv_cen2 ) ioptio = ioptio + 1 173 IF( ln_trcadv_tvd ) ioptio = ioptio + 1 174 IF( ln_trcadv_muscl ) ioptio = ioptio + 1 175 IF( ln_trcadv_muscl2 ) ioptio = ioptio + 1 176 IF( ln_trcadv_ubs ) ioptio = ioptio + 1 177 IF( ln_trcadv_qck ) ioptio = ioptio + 1 178 IF( lk_esopa ) ioptio = 1 179 154 INTEGER :: ios ! Local integer output status for namelist read 155 !! 156 NAMELIST/namtrc_adv/ ln_trcadv_cen, nn_cen_h, nn_cen_v, & ! CEN 157 & ln_trcadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts, & ! FCT 158 & ln_trcadv_mus, ln_mus_ups, & ! MUSCL 159 & ln_trcadv_ubs, nn_ubs_v, & ! UBS 160 & ln_trcadv_qck ! QCK 161 !!---------------------------------------------------------------------- 162 ! 163 REWIND( numnat_ref ) ! namtrc_adv in reference namelist 164 READ ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 165 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 166 167 REWIND( numnat_cfg ) ! namtrc_adv in configuration namelist 168 READ ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 169 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 170 IF(lwm) WRITE ( numont, namtrc_adv ) 171 172 IF(lwp) THEN ! Namelist print 173 WRITE(numout,*) 174 WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme' 175 WRITE(numout,*) '~~~~~~~~~~~' 176 WRITE(numout,*) ' Namelist namtrc_adv : chose a advection scheme for tracers' 177 WRITE(numout,*) ' centered scheme ln_trcadv_cen = ', ln_trcadv_cen 178 WRITE(numout,*) ' horizontal 2nd/4th order nn_cen_h = ', nn_fct_h 179 WRITE(numout,*) ' vertical 2nd/4th order nn_cen_v = ', nn_fct_v 180 WRITE(numout,*) ' Flux Corrected Transport scheme ln_trcadv_fct = ', ln_trcadv_fct 181 WRITE(numout,*) ' horizontal 2nd/4th order nn_fct_h = ', nn_fct_h 182 WRITE(numout,*) ' vertical 2nd/4th order nn_fct_v = ', nn_fct_v 183 WRITE(numout,*) ' 2nd order + vertical sub-timestepping nn_fct_zts = ', nn_fct_zts 184 WRITE(numout,*) ' MUSCL scheme ln_trcadv_mus = ', ln_trcadv_mus 185 WRITE(numout,*) ' + upstream scheme near river mouths ln_mus_ups = ', ln_mus_ups 186 WRITE(numout,*) ' UBS scheme ln_trcadv_ubs = ', ln_trcadv_ubs 187 WRITE(numout,*) ' vertical 2nd/4th order nn_ubs_v = ', nn_ubs_v 188 WRITE(numout,*) ' QUICKEST scheme ln_trcadv_qck = ', ln_trcadv_qck 189 ENDIF 190 ! 191 192 ioptio = 0 !== Parameter control ==! 193 IF( ln_trcadv_cen ) ioptio = ioptio + 1 194 IF( ln_trcadv_fct ) ioptio = ioptio + 1 195 IF( ln_trcadv_mus ) ioptio = ioptio + 1 196 IF( ln_trcadv_ubs ) ioptio = ioptio + 1 197 IF( ln_trcadv_qck ) ioptio = ioptio + 1 198 199 ! 200 IF( ioptio == 0 ) THEN 201 nadv = np_NO_adv 202 CALL ctl_warn( 'trc_adv_init: You are running without tracer advection.' ) 203 ENDIF 180 204 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' ) 181 182 ! ! Set nadv 183 IF( ln_trcadv_cen2 ) nadv = 1 184 IF( ln_trcadv_tvd ) nadv = 2 185 IF( ln_trcadv_muscl ) nadv = 3 186 IF( ln_trcadv_muscl2 ) nadv = 4 187 IF( ln_trcadv_ubs ) nadv = 5 188 IF( ln_trcadv_qck ) nadv = 6 189 IF( lk_esopa ) nadv = -1 190 205 ! 206 IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 ) & 207 .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 ) ) THEN 208 CALL ctl_stop( 'trc_adv_init: CEN scheme, choose 2nd or 4th order' ) 209 ENDIF 210 IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 ) & 211 .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 ) ) THEN 212 CALL ctl_stop( 'trc_adv_init: FCT scheme, choose 2nd or 4th order' ) 213 ENDIF 214 IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) THEN 215 IF( nn_fct_h == 4 ) THEN 216 nn_fct_h = 2 217 CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 218 ENDIF 219 IF( .NOT.ln_linssh ) THEN 220 CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 221 ENDIF 222 IF( nn_fct_zts == 1 ) CALL ctl_warn( 'trc_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' ) 223 ENDIF 224 IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 ) ) THEN 225 CALL ctl_stop( 'trc_adv_init: UBS scheme, choose 2nd or 4th order' ) 226 ENDIF 227 IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN 228 CALL ctl_warn( 'trc_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' ) 229 ENDIF 230 IF( ln_isfcav ) THEN ! ice-shelf cavities 231 IF( ln_trcadv_cen .AND. nn_cen_v /= 4 .OR. & ! NO 4th order with ISF 232 & ln_trcadv_fct .AND. nn_fct_v /= 4 ) CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' ) 233 ENDIF 234 ! 235 ! !== used advection scheme ==! 236 ! ! set nadv 237 IF( ln_trcadv_cen ) nadv = np_CEN 238 IF( ln_trcadv_fct ) nadv = np_FCT 239 IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) nadv = np_FCT_zts 240 IF( ln_trcadv_mus ) nadv = np_MUS 241 IF( ln_trcadv_ubs ) nadv = np_UBS 242 IF( ln_trcadv_qck ) nadv = np_QCK 243 ! 191 244 IF(lwp) THEN ! Print the choice 192 245 WRITE(numout,*) 193 IF( nadv == 1 ) WRITE(numout,*) ' 2nd order scheme is used' 194 IF( nadv == 2 ) WRITE(numout,*) ' TVD scheme is used' 195 IF( nadv == 3 ) WRITE(numout,*) ' MUSCL scheme is used' 196 IF( nadv == 4 ) WRITE(numout,*) ' MUSCL2 scheme is used' 197 IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used' 198 IF( nadv == 6 ) WRITE(numout,*) ' QUICKEST scheme is used' 199 IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme' 200 ENDIF 201 ! 202 END SUBROUTINE trc_adv_ctl 246 IF( nadv == np_NO_adv ) WRITE(numout,*) ' NO passive tracer advection' 247 IF( nadv == np_CEN ) WRITE(numout,*) ' CEN scheme is used. Horizontal order: ', nn_cen_h, & 248 & ' Vertical order: ', nn_cen_v 249 IF( nadv == np_FCT ) WRITE(numout,*) ' FCT scheme is used. Horizontal order: ', nn_fct_h, & 250 & ' Vertical order: ', nn_fct_v 251 IF( nadv == np_FCT_zts ) WRITE(numout,*) ' use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 252 IF( nadv == np_MUS ) WRITE(numout,*) ' MUSCL scheme is used' 253 IF( nadv == np_UBS ) WRITE(numout,*) ' UBS scheme is used' 254 IF( nadv == np_QCK ) WRITE(numout,*) ' QUICKEST scheme is used' 255 ENDIF 256 ! 257 END SUBROUTINE trc_adv_ini 203 258 204 259 #else -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r4513 r6225 22 22 USE oce_trc ! ocean dynamics and active tracers variables 23 23 USE trc ! ocean passive tracers variables 24 USE trcnam_trp ! passive tracers transport namelist variables25 24 USE trabbl ! 26 25 USE prtctl_trc ! Print control for debbuging 27 USE trd mod_oce26 USE trd_oce 28 27 USE trdtra 29 28 30 29 PUBLIC trc_bbl ! routine called by step.F90 31 30 32 33 !! * Substitutions34 # include "top_substitute.h90"35 31 !!---------------------------------------------------------------------- 36 32 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 93 89 DO jn = 1, jptra 94 90 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 95 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_bbl, ztrtrd(:,:,:,jn) )91 CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 96 92 END DO 97 93 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r4359 r6225 18 18 USE oce_trc ! ocean dynamics and tracers variables 19 19 USE trc ! ocean passive tracers variables 20 USE trcnam_trp ! passive tracers transport namelist variables21 20 USE trcdta 22 21 USE tradmp 23 22 USE prtctl_trc ! Print control for debbuging 24 23 USE trdtra 25 USE trdmod_oce 24 USE trd_oce 25 USE iom 26 26 27 27 IMPLICIT NONE 28 28 PRIVATE 29 29 30 PUBLIC trc_dmp ! routine called by step.F90 31 PUBLIC trc_dmp_clo ! routine called by step.F90 32 PUBLIC trc_dmp_alloc ! routine called by nemogcm.F90 30 PUBLIC trc_dmp 31 PUBLIC trc_dmp_clo 32 PUBLIC trc_dmp_alloc 33 PUBLIC trc_dmp_ini 34 35 INTEGER , PUBLIC :: nn_zdmp_tr ! = 0/1/2 flag for damping in the mixed layer 36 CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr !File containing restoration coefficient 33 37 34 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restotr ! restoring coeff. on tracers (s-1) … … 39 43 40 44 !! * Substitutions 41 # include " top_substitute.h90"45 # include "vectopt_loop_substitute.h90" 42 46 !!---------------------------------------------------------------------- 43 47 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 44 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp$48 !! $Id$ 45 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 50 !!---------------------------------------------------------------------- … … 75 79 !! ** Action : - update the tracer trends tra with the newtonian 76 80 !! damping trends. 77 !! - save the trends ('key_trdmld_trc') 78 !!---------------------------------------------------------------------- 79 !! 80 INTEGER, INTENT( in ) :: kt ! ocean time-step index 81 !! 82 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 83 REAL(wp) :: ztra ! temporary scalars 84 CHARACTER (len=22) :: charout 81 !! - save the trends ('key_trdmxl_trc') 82 !!---------------------------------------------------------------------- 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 85 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace88 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 87 89 !!---------------------------------------------------------------------- 88 90 ! 89 91 IF( nn_timing == 1 ) CALL timing_start('trc_dmp') 90 92 ! 91 ! 0. Initialization (first time-step only)92 ! --------------93 IF( kt == nittrc000 ) CALL trc_dmp_init94 95 93 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) ! temporary save of trends 96 94 ! … … 104 102 ! 105 103 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 106 104 ! 107 105 jl = n_trc_index(jn) 108 106 CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 109 107 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 110 108 ! 111 109 SELECT CASE ( nn_zdmp_tr ) 112 110 ! … … 115 113 DO jj = 2, jpjm1 116 114 DO ji = fs_2, fs_jpim1 ! vector opt. 117 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 118 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) ) 119 116 END DO 120 117 END DO 121 118 END DO 122 !119 ! 123 120 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==! 124 121 DO jk = 1, jpkm1 125 122 DO jj = 2, jpjm1 126 123 DO ji = fs_2, fs_jpim1 ! vector opt. 127 IF( avt(ji,jj,jk) <= 5.e-4 ) THEN 128 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 129 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 124 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 125 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 130 126 ENDIF 131 127 END DO 132 128 END DO 133 129 END DO 134 !130 ! 135 131 CASE ( 2 ) !== no damping in the mixed layer ==! 136 132 DO jk = 1, jpkm1 137 133 DO jj = 2, jpjm1 138 134 DO ji = fs_2, fs_jpim1 ! vector opt. 139 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 140 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 141 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) ) 142 137 END IF 143 138 END DO 144 139 END DO 145 140 END DO 146 !141 ! 147 142 END SELECT 148 143 ! … … 151 146 IF( l_trdtrc ) THEN 152 147 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 153 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_dmp, ztrtrd )148 CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd ) 154 149 END IF 155 150 ! ! =========== … … 161 156 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 162 157 ! ! print mean trends (used for debugging) 163 IF( ln_ctl ) THEN 164 WRITE(charout, FMT="('dmp ')") ; CALL prt_ctl_trc_info(charout) 165 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' ) 166 162 ENDIF 167 163 ! … … 169 165 ! 170 166 END SUBROUTINE trc_dmp 167 168 169 SUBROUTINE trc_dmp_ini 170 !!---------------------------------------------------------------------- 171 !! *** ROUTINE trc_dmp_ini *** 172 !! 173 !! ** Purpose : Initialization for the newtonian damping 174 !! 175 !! ** Method : read the nammbf namelist and check the parameters 176 !! called by trc_dmp at the first timestep (nittrc000) 177 !!---------------------------------------------------------------------- 178 INTEGER :: ios, imask ! local integers 179 !! 180 NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 181 !!---------------------------------------------------------------------- 182 ! 183 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init') 184 ! 185 REWIND( numnat_ref ) ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 186 READ ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 187 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 188 189 REWIND( numnat_cfg ) ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping 190 READ ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 191 910 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp ) 192 IF(lwm) WRITE ( numont, namtrc_dmp ) 193 194 IF(lwp) THEN ! Namelist print 195 WRITE(numout,*) 196 WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping' 197 WRITE(numout,*) '~~~~~~~' 198 WRITE(numout,*) ' Namelist namtrc_dmp : set damping parameter' 199 WRITE(numout,*) ' mixed layer damping option nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 200 WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr 201 ENDIF 202 ! 203 IF( lzoom .AND. .NOT.lk_c1d ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries 204 SELECT CASE ( nn_zdmp_tr ) 205 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping throughout the water column' 206 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline (avt > 5 cm2/s)' 207 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer' 208 CASE DEFAULT 209 WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr 210 CALL ctl_stop(ctmp1) 211 END SELECT 212 213 IF( .NOT.lk_c1d ) THEN 214 IF( .NOT. ln_tradmp ) & 215 & CALL ctl_stop( 'passive trace damping need ln_tradmp to compute damping coef.' ) 216 ! 217 ! ! Read damping coefficients from file 218 !Read in mask from file 219 CALL iom_open ( cn_resto_tr, imask) 220 CALL iom_get ( imask, jpdom_autoglo, 'resto', restotr) 221 CALL iom_close( imask ) 222 ! 223 ENDIF 224 IF( nn_timing == 1 ) CALL timing_stop('trc_dmp_init') 225 ! 226 END SUBROUTINE trc_dmp_ini 227 171 228 172 229 SUBROUTINE trc_dmp_clo( kt ) … … 182 239 !! nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 183 240 !!---------------------------------------------------------------------- 184 INTEGER, INTENT( in ) :: kt 185 ! 186 INTEGER :: ji, jj, jk, jn, jl, jc! dummy loop indicesa187 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace188 189 !!---------------------------------------------------------------------- 190 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 ! 191 248 IF( kt == nit000 ) THEN 192 249 ! initial values … … 200 257 ! 201 258 SELECT CASE ( jp_cfg ) 259 ! ! ======================= 260 CASE ( 1 ) ! eORCA_R1 configuration 261 ! ! ======================= 262 isrow = 332 - jpjglo 263 ! 264 ! Caspian Sea 265 nctsi1(1) = 332 ; nctsj1(1) = 243 - isrow 266 nctsi2(1) = 344 ; nctsj2(1) = 275 - isrow 267 ! 202 268 ! ! ======================= 203 269 CASE ( 2 ) ! ORCA_R2 configuration … … 291 357 END SUBROUTINE trc_dmp_clo 292 358 293 294 SUBROUTINE trc_dmp_init295 !!----------------------------------------------------------------------296 !! *** ROUTINE trc_dmp_init ***297 !!298 !! ** Purpose : Initialization for the newtonian damping299 !!300 !! ** Method : read the nammbf namelist and check the parameters301 !! called by trc_dmp at the first timestep (nittrc000)302 !!----------------------------------------------------------------------303 !304 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init')305 !306 SELECT CASE ( nn_hdmp_tr )307 CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' tracer damping in the Med & Red seas only'308 CASE ( 1:90 ) ; IF(lwp) WRITE(numout,*) ' tracer damping poleward of', nn_hdmp_tr, ' degrees'309 CASE DEFAULT310 WRITE(ctmp1,*) ' bad flag value for nn_hdmp_tr = ', nn_hdmp_tr311 CALL ctl_stop(ctmp1)312 END SELECT313 314 IF( lzoom ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries315 SELECT CASE ( nn_zdmp_tr )316 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping throughout the water column'317 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline (avt > 5 cm2/s)'318 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer'319 CASE DEFAULT320 WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr321 CALL ctl_stop(ctmp1)322 END SELECT323 324 IF( .NOT. ln_tradmp ) &325 & CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' )326 !327 ! ! Damping coefficients initialization328 IF( lzoom ) THEN ; CALL dtacof_zoom( restotr )329 ELSE ; CALL dtacof( nn_hdmp_tr, rn_surf_tr, rn_bot_tr, rn_dep_tr, &330 & nn_file_tr, 'TRC' , restotr )331 ENDIF332 !333 IF( nn_timing == 1 ) CALL timing_stop('trc_dmp_init')334 !335 END SUBROUTINE trc_dmp_init336 337 359 #else 338 360 !!---------------------------------------------------------------------- … … 346 368 #endif 347 369 348 349 370 !!====================================================================== 350 371 END MODULE trcdmp -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r3294 r6225 4 4 !! Ocean Passive tracers : lateral diffusive trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 2005-11 (G. Madec) Original code 7 !! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 6 !! History : 1.0 ! 2005-11 (G. Madec) Original code 7 !! 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 8 !! 3.7 ! 2014-03 (G. Madec) LDF simplification 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_top … … 11 12 !! 'key_top' TOP models 12 13 !!---------------------------------------------------------------------- 13 !!---------------------------------------------------------------------- 14 !! trc_ldf : update the tracer trend with the lateral diffusion 15 !! ldf_ctl : initialization, namelist read, and parameters control 16 !!---------------------------------------------------------------------- 17 USE oce_trc ! ocean dynamics and active tracers 18 USE trc ! ocean passive tracers variables 19 USE trcnam_trp ! passive tracers transport namelist variables 20 USE ldftra_oce ! lateral diffusion coefficient on tracers 21 USE ldfslp ! ??? 22 USE traldf_bilapg ! lateral mixing (tra_ldf_bilapg routine) 23 USE traldf_bilap ! lateral mixing (tra_ldf_bilap routine) 24 USE traldf_iso ! lateral mixing (tra_ldf_iso routine) 25 USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine) 26 USE traldf_lap ! lateral mixing (tra_ldf_lap routine) 27 USE trdmod_oce 28 USE trdtra 29 USE prtctl_trc ! Print control 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 25 ! 26 USE prtctl_trc ! Print control 30 27 31 28 IMPLICIT NONE 32 29 PRIVATE 33 30 34 PUBLIC trc_ldf ! called by step.F90 35 ! !!: ** lateral mixing namelist (nam_trcldf) ** 36 REAL(wp) :: rldf_rat ! ratio between active and passive tracers diffusive coefficient 31 PUBLIC trc_ldf 32 PUBLIC trc_ldf_ini 33 ! 34 LOGICAL , PUBLIC :: ln_trcldf_lap !: laplacian operator 35 LOGICAL , PUBLIC :: ln_trcldf_blp !: bilaplacian operator 36 LOGICAL , PUBLIC :: ln_trcldf_lev !: iso-level direction 37 LOGICAL , PUBLIC :: ln_trcldf_hor !: horizontal direction (rotation to geopotential) 38 LOGICAL , PUBLIC :: ln_trcldf_iso !: iso-neutral direction (standard) 39 LOGICAL , PUBLIC :: ln_trcldf_triad !: iso-neutral direction (triad) 40 REAL(wp), PUBLIC :: rn_ahtrc_0 !: laplacian diffusivity coefficient for passive tracer [m2/s] 41 REAL(wp), PUBLIC :: rn_bhtrc_0 !: bilaplacian - -- - - [m4/s] 42 ! 43 ! !!: ** lateral mixing namelist (nam_trcldf) ** 44 REAL(wp) :: rldf ! ratio between active and passive tracers diffusive coefficient 45 37 46 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 47 38 48 !! * Substitutions 39 # include "domzgr_substitute.h90"40 49 # include "vectopt_loop_substitute.h90" 41 50 !!---------------------------------------------------------------------- 42 !! NEMO/TOP 3. 3 , NEMO Consortium (2010)51 !! NEMO/TOP 3.7 , NEMO Consortium (2014) 43 52 !! $Id$ 44 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 54 !!---------------------------------------------------------------------- 46 47 55 CONTAINS 48 56 … … 55 63 !!---------------------------------------------------------------------- 56 64 INTEGER, INTENT( in ) :: kt ! ocean time-step index 57 ! !65 ! 58 66 INTEGER :: jn 59 67 CHARACTER (len=22) :: charout 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zahu, zahv 60 69 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd 61 70 !!---------------------------------------------------------------------- … … 63 72 IF( nn_timing == 1 ) CALL timing_start('trc_ldf') 64 73 ! 65 IF( kt == nittrc000 ) CALL ldf_ctl ! initialisation & control of options66 67 rldf = rldf_rat68 69 74 IF( l_trdtrc ) THEN 70 CALL wrk_alloc( jpi, jpj, jpk, jptra,ztrtrd )75 CALL wrk_alloc( jpi,jpj,jpk,jptra, ztrtrd ) 71 76 ztrtrd(:,:,:,:) = tra(:,:,:,:) 72 77 ENDIF 73 74 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 75 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level laplacian 76 CASE ( 1 ) ! rotated laplacian 77 IF( ln_traldf_grif ) THEN 78 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 79 ELSE 80 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 81 ENDIF 82 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level bilaplacian 83 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 84 ! 85 CASE ( -1 ) ! esopa: test all possibility with control print 86 CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) 87 WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout) 88 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 89 IF( ln_traldf_grif ) THEN 90 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 91 ELSE 92 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 93 ENDIF 94 WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout) 95 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 96 CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) 97 WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout) 98 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 99 CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) 100 WRITE(charout, FMT="('ldf3 ')") ; CALL prt_ctl_trc_info(charout) 101 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 78 ! 79 ! !* set the lateral diffusivity coef. for passive tracer 80 CALL wrk_alloc( jpi,jpj,jpk, zahu, zahv ) 81 zahu(:,:,:) = rldf * ahtu(:,:,:) 82 zahv(:,:,:) = rldf * ahtv(:,:,:) 83 84 SELECT CASE ( nldf ) !* compute lateral mixing trend and add it to the general trend 85 ! 86 CASE ( np_lap ) ! iso-level laplacian 87 CALL tra_ldf_lap ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, 1 ) 88 ! 89 CASE ( np_lap_i ) ! laplacian : standard iso-neutral operator (Madec) 90 CALL tra_ldf_iso ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 ) 91 ! 92 CASE ( np_lap_it ) ! laplacian : triad iso-neutral operator (griffies) 93 CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 ) 94 ! 95 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: all operator (iso-level, -neutral) 96 CALL tra_ldf_blp ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb , tra, jptra, nldf ) 97 ! 102 98 END SELECT 103 99 ! 104 IF( l_trdtrc ) THEN ! save the horizontal diffusive trends for further diagnostics100 IF( l_trdtrc ) THEN ! send the trends for further diagnostics 105 101 DO jn = 1, jptra 106 102 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 107 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_ldf, ztrtrd(:,:,:,jn) )103 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 108 104 END DO 109 105 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 110 106 ENDIF 111 ! ! print mean trends (used for debugging) 112 IF( ln_ctl ) THEN 113 WRITE(charout, FMT="('ldf ')") ; CALL prt_ctl_trc_info(charout) 114 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 115 ENDIF 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 ENDIF 113 ! 114 CALL wrk_dealloc( jpi,jpj,jpk, zahu, zahv ) 116 115 ! 117 116 IF( nn_timing == 1 ) CALL timing_stop('trc_ldf') … … 120 119 121 120 122 SUBROUTINE ldf_ctl121 SUBROUTINE trc_ldf_ini 123 122 !!---------------------------------------------------------------------- 124 123 !! *** ROUTINE ldf_ctl *** 125 124 !! 126 !! ** Purpose : Choice of the operator for the lateral tracerdiffusion125 !! ** Purpose : Define the operator for the lateral diffusion 127 126 !! 128 127 !! ** Method : set nldf from the namtra_ldf logicals 129 !! nldf == -2 No lateral diffusion130 !! nldf == -1 ESOPA test: ALL operators are used131 128 !! nldf == 0 laplacian operator 132 129 !! nldf == 1 Rotated laplacian operator … … 134 131 !! nldf == 3 Rotated bilaplacian 135 132 !!---------------------------------------------------------------------- 136 INTEGER :: ioptio, ierr ! temporary integers 137 !!---------------------------------------------------------------------- 138 139 IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 140 IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 141 rldf_rat = 1.0_wp 142 ELSE 143 CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 144 END IF 145 ELSE 146 rldf_rat = rn_ahtrc_0 / rn_aht_0 147 END IF 148 ! Define the lateral mixing oparator for tracers 149 ! =============================================== 150 151 ! ! control the input 133 INTEGER :: ioptio, ierr ! temporary integers 134 INTEGER :: ios ! Local integer output status for namelist read 135 !! 136 NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp, & 137 & ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad, & 138 & rn_ahtrc_0 , rn_bhtrc_0 139 !!---------------------------------------------------------------------- 140 ! 141 REWIND( numnat_ref ) ! namtrc_ldf in reference namelist 142 READ ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 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 146 READ ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 147 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 148 IF(lwm) WRITE ( numont, namtrc_ldf ) 149 ! 150 IF(lwp) THEN ! Namelist print 151 WRITE(numout,*) 152 WRITE(numout,*) 'trc_ldf_ini : lateral tracer diffusive operator' 153 WRITE(numout,*) '~~~~~~~~~~~' 154 WRITE(numout,*) ' Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)' 155 WRITE(numout,*) ' operator' 156 WRITE(numout,*) ' laplacian ln_trcldf_lap = ', ln_trcldf_lap 157 WRITE(numout,*) ' bilaplacian ln_trcldf_blp = ', ln_trcldf_blp 158 WRITE(numout,*) ' direction of action' 159 WRITE(numout,*) ' iso-level ln_trcldf_lev = ', ln_trcldf_lev 160 WRITE(numout,*) ' horizontal (geopotential) ln_trcldf_hor = ', ln_trcldf_hor 161 WRITE(numout,*) ' iso-neutral (standard) ln_trcldf_iso = ', ln_trcldf_iso 162 WRITE(numout,*) ' iso-neutral (triad) ln_trcldf_triad = ', ln_trcldf_triad 163 WRITE(numout,*) ' diffusivity coefficient' 164 WRITE(numout,*) ' laplacian rn_ahtrc_0 = ', rn_ahtrc_0 165 WRITE(numout,*) ' bilaplacian rn_bhtrc_0 = ', rn_bhtrc_0 166 ENDIF 167 ! 168 ! ! control the namelist parameters 152 169 ioptio = 0 153 IF( ln_trcldf_lap ) ioptio = ioptio + 1 154 IF( ln_trcldf_bilap ) ioptio = ioptio + 1 155 IF( ioptio > 1 ) CALL ctl_stop( ' use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 156 IF( ioptio == 0 ) nldf = -2 ! No lateral diffusion 170 IF( ln_trcldf_lap ) ioptio = ioptio + 1 171 IF( ln_trcldf_blp ) ioptio = ioptio + 1 172 IF( ioptio > 1 ) CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 173 IF( ioptio == 0 ) nldf = np_no_ldf ! No lateral diffusion 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' ) 176 IF( ln_trcldf_blp .AND. ln_trcldf_lap ) CALL ctl_stop( 'trc_ldf_ctl: laplacian should be used on both TRC and TRA' ) 177 ! 157 178 ioptio = 0 158 IF( ln_trcldf_lev el) ioptio = ioptio + 1159 IF( ln_trcldf_hor 160 IF( ln_trcldf_iso 161 IF( ioptio /= 1 ) CALL ctl_stop( 'use only ONE direction (level/hor/iso)' )162 179 IF( ln_trcldf_lev ) ioptio = ioptio + 1 180 IF( ln_trcldf_hor ) ioptio = ioptio + 1 181 IF( ln_trcldf_iso ) ioptio = ioptio + 1 182 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 183 ! 163 184 ! defined the type of lateral diffusion from ln_trcldf_... logicals 164 185 ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 165 186 ierr = 0 166 IF( ln_trcldf_lap ) THEN ! laplacian operator187 IF( ln_trcldf_lap ) THEN !== laplacian operator ==! 167 188 IF ( ln_zco ) THEN ! z-coordinate 168 IF ( ln_trcldf_level ) nldf = 0 ! iso-level (no rotation) 169 IF ( ln_trcldf_hor ) nldf = 0 ! horizontal (no rotation) 170 IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation) 171 ENDIF 172 IF ( ln_zps ) THEN ! z-coordinate 173 IF ( ln_trcldf_level ) ierr = 1 ! iso-level not allowed 174 IF ( ln_trcldf_hor ) nldf = 0 ! horizontal (no rotation) 175 IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation) 176 ENDIF 177 IF ( ln_sco ) THEN ! z-coordinate 178 IF ( ln_trcldf_level ) nldf = 0 ! iso-level (no rotation) 179 IF ( ln_trcldf_hor ) nldf = 1 ! horizontal ( rotation) 180 IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation) 181 ENDIF 182 ENDIF 183 184 IF( ln_trcldf_bilap ) THEN ! bilaplacian operator 189 IF ( ln_trcldf_lev ) nldf = np_lap ! iso-level = horizontal (no rotation) 190 IF ( ln_trcldf_hor ) nldf = np_lap ! iso-level = horizontal (no rotation) 191 IF ( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard ( rotation) 192 IF ( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad ( rotation) 193 ENDIF 194 IF ( ln_zps ) THEN ! z-coordinate with partial step 195 IF ( ln_trcldf_lev ) ierr = 1 ! iso-level not allowed 196 IF ( ln_trcldf_hor ) nldf = np_lap ! horizontal (no rotation) 197 IF ( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard (rotation) 198 IF ( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad (rotation) 199 ENDIF 200 IF ( ln_sco ) THEN ! s-coordinate 201 IF ( ln_trcldf_lev ) nldf = np_lap ! iso-level (no rotation) 202 IF ( ln_trcldf_hor ) nldf = np_lap_it ! horizontal ( rotation) !!gm a checker.... 203 IF ( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard (rotation) 204 IF ( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad (rotation) 205 ENDIF 206 ! ! diffusivity ratio: passive / active tracers 207 IF( ABS(rn_aht_0) < 2._wp*TINY(1._wp) ) THEN 208 IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1._wp) ) THEN 209 rldf = 1.0_wp 210 ELSE 211 CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 212 ENDIF 213 ELSE 214 rldf = rn_ahtrc_0 / rn_aht_0 215 ENDIF 216 ENDIF 217 ! 218 IF( ln_trcldf_blp ) THEN !== bilaplacian operator ==! 185 219 IF ( ln_zco ) THEN ! z-coordinate 186 IF ( ln_trcldf_level ) nldf = 2 ! iso-level (no rotation) 187 IF ( ln_trcldf_hor ) nldf = 2 ! horizontal (no rotation) 188 IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation) 189 ENDIF 190 IF ( ln_zps ) THEN ! z-coordinate 191 IF ( ln_trcldf_level ) ierr = 1 ! iso-level not allowed 192 IF ( ln_trcldf_hor ) nldf = 2 ! horizontal (no rotation) 193 IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation) 194 ENDIF 195 IF ( ln_sco ) THEN ! z-coordinate 196 IF ( ln_trcldf_level ) nldf = 2 ! iso-level (no rotation) 197 IF ( ln_trcldf_hor ) nldf = 3 ! horizontal ( rotation) 198 IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation) 199 ENDIF 200 ENDIF 201 202 IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 203 IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 204 IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso ) & 205 CALL ctl_stop( ' eddy induced velocity on tracers', & 206 & ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 207 IF( nldf == 1 .OR. nldf == 3 ) THEN ! rotation 208 IF( .NOT.lk_ldfslp ) CALL ctl_stop( ' the rotation of the diffusive tensor require key_ldfslp' ) 209 #if defined key_offline 210 l_traldf_rot = .TRUE. ! needed for trazdf_imp 211 #endif 212 ENDIF 213 214 IF( lk_esopa ) THEN 215 IF(lwp) WRITE(numout,*) ' esopa control: use all lateral physics options' 216 nldf = -1 217 ENDIF 218 219 IF( .NOT. ln_trcldf_diff ) THEN 220 IF(lwp) WRITE(numout,*) ' No lateral diffusion on passive tracers' 221 nldf = -2 222 ENDIF 223 220 IF ( ln_trcldf_lev ) nldf = np_blp ! iso-level = horizontal (no rotation) 221 IF ( ln_trcldf_hor ) nldf = np_blp ! iso-level = horizontal (no rotation) 222 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 223 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 224 ENDIF 225 IF ( ln_zps ) THEN ! z-coordinate with partial step 226 IF ( ln_trcldf_lev ) ierr = 1 ! iso-level not allowed 227 IF ( ln_trcldf_hor ) nldf = np_blp ! horizontal (no rotation) 228 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 229 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 230 ENDIF 231 IF ( ln_sco ) THEN ! s-coordinate 232 IF ( ln_trcldf_lev ) nldf = np_blp ! iso-level (no rotation) 233 IF ( ln_trcldf_hor ) nldf = np_blp_it ! horizontal ( rotation) !!gm a checker.... 234 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 235 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 236 ENDIF 237 ! ! diffusivity ratio: passive / active tracers 238 IF( ABS(rn_bht_0) < 2._wp*TINY(1._wp) ) THEN 239 IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1._wp) ) THEN 240 rldf = 1.0_wp 241 ELSE 242 CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 243 ENDIF 244 ELSE 245 rldf = SQRT( ABS( rn_bhtrc_0 / rn_bht_0 ) ) 246 ENDIF 247 ENDIF 248 ! 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 252 ! 224 253 IF(lwp) THEN 225 254 WRITE(numout,*) 226 IF( nldf == -2 ) WRITE(numout,*) ' NO lateral diffusion' 227 IF( nldf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used' 228 IF( nldf == 0 ) WRITE(numout,*) ' laplacian operator' 229 IF( nldf == 1 ) WRITE(numout,*) ' Rotated laplacian operator' 230 IF( nldf == 2 ) WRITE(numout,*) ' bilaplacian operator' 231 IF( nldf == 3 ) WRITE(numout,*) ' Rotated bilaplacian' 232 ENDIF 233 234 IF( ln_trcldf_bilap ) THEN 235 IF(lwp) WRITE(numout,*) ' biharmonic tracer diffusion' 236 IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' ) 237 ELSE 238 IF(lwp) WRITE(numout,*) ' harmonic tracer diffusion (default)' 239 IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa ) CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' ) 240 ENDIF 241 242 ! ratio between active and passive tracers diffusive coef. 243 IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 244 IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 245 rldf_rat = 1.0_wp 246 ELSE 247 CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 248 END IF 249 ELSE 250 rldf_rat = rn_ahtrc_0 / rn_aht_0 251 END IF 252 IF( rldf_rat < 0 ) THEN 253 IF( .NOT.lk_offline ) THEN 254 CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' ) 255 ELSE 256 CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' ) 257 ENDIF 258 ENDIF 259 ! 260 END SUBROUTINE ldf_ctl 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 264 ENDIF 265 ! 266 END SUBROUTINE trc_ldf_ini 261 267 #else 262 268 !!---------------------------------------------------------------------- -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r4611 r6225 30 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 31 USE prtctl_trc ! Print control for debbuging 32 USE trd mod_oce32 USE trd_oce 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 104 ! Update after tracer on domain lateral boundaries 105 DO jn = 1, jptra 93 ! 94 #if defined key_agrif 95 CALL Agrif_trc ! AGRIF zoom boundaries 96 #endif 97 DO jn = 1, jptra ! Update after tracer on domain lateral boundaries 106 98 CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. ) 107 99 END DO 108 100 101 IF( lk_bdy ) CALL trc_bdy( kt ) 109 102 110 #if defined key_bdy 111 !! CALL bdy_trc( kt ) ! BDY open boundaries 112 #endif 113 #if defined key_agrif 114 CALL Agrif_trc ! AGRIF zoom 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 + 1 ) 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, 'TRC', trb, trn, tra, jptra ) ! variable volume level (vvl) 140 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 141 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 142 130 ENDIF 143 144 ! trends computation 145 IF( l_trdtrc ) THEN ! trends 131 ! 132 IF( l_trdtrc ) THEN ! trends: send Asselin filter trends to trdtra manager for further diagnostics 146 133 DO jn = 1, jptra 147 134 DO jk = 1, jpkm1 148 zfact = 1. e0 / r2dt(jk)135 zfact = 1._wp / r2dttrc 149 136 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 150 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_atf, ztrdt )137 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 151 138 END DO 152 139 END DO -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r3680 r6225 15 15 USE oce_trc ! ocean dynamics and tracers variables 16 16 USE trc ! ocean passive tracers variables 17 USE trd mod_oce17 USE trd_oce 18 18 USE trdtra 19 19 USE prtctl_trc ! Print control for debbuging … … 22 22 PRIVATE 23 23 24 PUBLIC trc_rad ! routine called by trcstp.F90 25 26 !! * Substitutions 27 # include "top_substitute.h90" 24 PUBLIC trc_rad 25 PUBLIC trc_rad_ini 26 27 LOGICAL , PUBLIC :: ln_trcrad !: flag to artificially correct negative concentrations 28 28 29 !!---------------------------------------------------------------------- 29 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 76 77 ! 77 78 END SUBROUTINE trc_rad 79 80 SUBROUTINE trc_rad_ini 81 !!--------------------------------------------------------------------- 82 !! *** ROUTINE trc _rad_ini *** 83 !! 84 !! ** Purpose : read namelist options 85 !!---------------------------------------------------------------------- 86 INTEGER :: ios ! Local integer output status for namelist read 87 NAMELIST/namtrc_rad/ ln_trcrad 88 !!---------------------------------------------------------------------- 89 90 ! 91 REWIND( numnat_ref ) ! namtrc_rad in reference namelist 92 READ ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907) 93 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 94 95 REWIND( numnat_cfg ) ! namtrc_rad in configuration namelist 96 READ ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 97 908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp ) 98 IF(lwm) WRITE ( numont, namtrc_rad ) 99 100 IF(lwp) THEN ! ! Control print 101 WRITE(numout,*) 102 WRITE(numout,*) ' Namelist namtrc_rad : treatment of negative concentrations' 103 WRITE(numout,*) ' correct artificially negative concen. or not ln_trcrad = ', ln_trcrad 104 ENDIF 105 ! 106 END SUBROUTINE trc_rad_ini 78 107 79 108 SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) … … 156 185 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 157 186 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 158 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radb, ztrtrdb ) ! Asselin-like trend handling159 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radn, ztrtrdn ) ! standard trend handling187 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 188 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 160 189 ! 161 190 ENDIF … … 187 216 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 188 217 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 189 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radb, ztrtrdb ) ! Asselin-like trend handling190 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radn, ztrtrdn ) ! standard trend handling218 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 219 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 191 220 ! 192 221 ENDIF -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r3719 r6225 19 19 USE trc ! ocean passive tracers variables 20 20 USE prtctl_trc ! Print control for debbuging 21 USE trdmod_oce 21 USE iom 22 USE trd_oce 22 23 USE trdtra 23 24 … … 28 29 29 30 !! * Substitutions 30 # include " top_substitute.h90"31 # include "vectopt_loop_substitute.h90" 31 32 !!---------------------------------------------------------------------- 32 33 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 60 61 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 62 ! 62 INTEGER :: ji, jj, jn ! dummy loop indices 63 REAL(wp) :: zsrau, zse3t ! temporary scalars 63 INTEGER :: ji, jj, jn ! dummy loop indices 64 REAL(wp) :: zse3t, zrtrn, zratio, zfact ! temporary scalars 65 REAL(wp) :: zswitch, zftra, zcd, zdtra, ztfx, ztra ! temporary scalars 64 66 CHARACTER (len=22) :: charout 65 67 REAL(wp), POINTER, DIMENSION(:,: ) :: zsfx 66 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 69 67 70 !!--------------------------------------------------------------------- 68 71 ! … … 70 73 ! 71 74 ! Allocate temporary workspace 72 CALL wrk_alloc( jpi, jpj, zsfx ) 73 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 ) 77 ! 78 zrtrn = 1.e-15_wp 79 80 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option 81 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only 82 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 83 ! ! (2) embedded sea-ice : salt and volume fluxes and pressure 84 END SELECT 85 86 IF( ln_top_euler) THEN 87 r2dt = rdttrc ! = rdttrc (use Euler time stepping) 88 ELSE 89 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 90 r2dt = rdttrc ! = rdttrc (restarting with Euler time stepping) 91 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 92 r2dt = 2. * rdttrc ! = 2 rdttrc (leapfrog) 93 ENDIF 94 ENDIF 95 74 96 75 97 IF( kt == nittrc000 ) THEN … … 77 99 IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 78 100 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 101 102 IF( ln_rsttr .AND. & ! Restart: read in restart file 103 iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 104 IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 105 zfact = 0.5_wp 106 DO jn = 1, jptra 107 CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc 108 END DO 109 ELSE ! No restart or restart not found: Euler forward time stepping 110 zfact = 1._wp 111 sbc_trc_b(:,:,:) = 0._wp 112 ENDIF 113 ELSE ! Swap of forcing fields 114 IF( ln_top_euler ) THEN 115 zfact = 1._wp 116 sbc_trc_b(:,:,:) = 0._wp 117 ELSE 118 zfact = 0.5_wp 119 sbc_trc_b(:,:,:) = sbc_trc(:,:,:) 120 ENDIF 121 ! 79 122 ENDIF 80 123 … … 83 126 ! Coupling offline : runoff are in emp which contains E-P-R 84 127 ! 85 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 86 129 zsfx(:,:) = 0._wp 87 130 ELSE ! online coupling free surface or offline with free surface … … 90 133 91 134 ! 0. initialization 92 zsrau = 1. / rau093 135 DO jn = 1, jptra 94 136 ! 95 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 96 ! ! add the trend to the general tracer trend 137 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 138 139 IF ( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) 140 141 DO jj = 2, jpj 142 DO ji = fs_2, fs_jpim1 ! vector opt. 143 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn) 144 END DO 145 END DO 146 147 ELSE 148 149 DO jj = 2, jpj 150 DO ji = fs_2, fs_jpim1 ! vector opt. 151 zse3t = 1. / e3t_n(ji,jj,1) 152 ! tracer flux at the ice/ocean interface (tracer/m2/s) 153 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 154 zcd = trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting, 155 ! only used in the levitating sea ice case 156 ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux 157 ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 158 ztfx = zftra + zswitch * zcd ! net tracer flux (+C/D if no ice/ocean mass exchange) 159 160 zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 161 IF ( zdtra < 0. ) THEN 162 zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn ) 163 zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 164 ENDIF 165 sbc_trc(ji,jj,jn) = zdtra 166 END DO 167 END DO 168 ENDIF 169 ! Concentration dilution effect on tracers due to evaporation & precipitation 97 170 DO jj = 2, jpj 98 171 DO ji = fs_2, fs_jpim1 ! vector opt. 99 zse3t = 1. / fse3t(ji,jj,1)100 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t172 zse3t = zfact / e3t_n(ji,jj,1) 173 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 101 174 END DO 102 175 END DO 103 176 ! 104 177 IF( l_trdtrc ) THEN 105 178 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 106 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_nsr, ztrtrd )179 CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 107 180 END IF 108 181 ! ! =========== 109 182 END DO ! tracer loop 110 183 ! ! =========== 184 185 ! Write in the tracer restar file 186 ! ******************************* 187 IF( lrst_trc ) THEN 188 IF(lwp) WRITE(numout,*) 189 IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ', & 190 & 'at it= ', kt,' date= ', ndastp 191 IF(lwp) WRITE(numout,*) '~~~~' 192 DO jn = 1, jptra 193 CALL iom_rstput( kt, nitrst, numrtw, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc(:,:,jn) ) 194 END DO 195 ENDIF 196 ! 111 197 IF( ln_ctl ) THEN 112 198 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_trc_info(charout) 113 199 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 114 200 ENDIF 115 CALL wrk_dealloc( jpi, jpj,zsfx )116 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 ) 117 203 ! 118 204 IF( nn_timing == 1 ) CALL timing_stop('trc_sbc') -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r4148 r6225 15 15 USE oce_trc ! ocean dynamics and active tracers variables 16 16 USE trc ! ocean passive tracers variables 17 USE trcnam_trp ! passive tracers transport namelist variables18 17 USE trabbl ! bottom boundary layer (trc_bbl routine) 19 18 USE trcbbl ! bottom boundary layer (trc_bbl routine) 20 USE zdfkpp ! KPP non-local tracer fluxes (trc_kpp routine)21 19 USE trcdmp ! internal damping (trc_dmp routine) 22 20 USE trcldf ! lateral mixing (trc_ldf routine) … … 27 25 USE trcsbc ! surface boundary condition (trc_sbc routine) 28 26 USE zpshde ! partial step: hor. derivative (zps_hde routine) 27 USE trcbdy ! BDY open boundaries 28 USE bdy_par, only: lk_bdy 29 29 30 30 #if defined key_agrif … … 38 38 PUBLIC trc_trp ! called by trc_stp 39 39 40 !! * Substitutions41 # include "top_substitute.h90"42 40 !!---------------------------------------------------------------------- 43 41 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 48 46 CONTAINS 49 47 50 SUBROUTINE trc_trp( k stp)48 SUBROUTINE trc_trp( kt ) 51 49 !!---------------------------------------------------------------------- 52 50 !! *** ROUTINE trc_trp *** … … 57 55 !! - Update the passive tracers 58 56 !!---------------------------------------------------------------------- 59 INTEGER, INTENT( in ) :: k stp! ocean time-step index57 INTEGER, INTENT( in ) :: kt ! ocean time-step index 60 58 !! --------------------------------------------------------------------- 61 59 ! … … 64 62 IF( .NOT. lk_c1d ) THEN 65 63 ! 66 CALL trc_sbc( kstp ) ! surface boundary condition 67 IF( lk_trabbl ) CALL trc_bbl( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 68 IF( ln_trcdmp ) CALL trc_dmp( kstp ) ! internal damping trends 69 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kstp ) ! internal damping trends on closed seas only 70 CALL trc_adv( kstp ) ! horizontal & vertical advection 71 CALL trc_ldf( kstp ) ! lateral mixing 72 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & 73 & CALL trc_kpp( kstp ) ! KPP non-local tracer fluxes 64 CALL trc_sbc ( kt ) ! surface boundary condition 65 IF( lk_trabbl ) CALL trc_bbl ( kt ) ! advective (and/or diffusive) bottom boundary layer scheme 66 IF( ln_trcdmp ) CALL trc_dmp ( kt ) ! internal damping trends 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 69 CALL trc_adv ( kt ) ! horizontal & vertical advection 70 ! ! Partial top/bottom cell: GRADh( trb ) 71 IF( ln_zps ) THEN 72 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom 73 ELSE ; CALL zps_hde ( kt, jptra, trb, gtru, gtrv ) ! only bottom 74 ENDIF 75 ENDIF 76 ! 77 CALL trc_ldf ( kt ) ! lateral mixing 74 78 #if defined key_agrif 75 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc 79 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc ! tracers sponge 76 80 #endif 77 CALL trc_zdf ( kstp )! vertical mixing and after tracer fields78 CALL trc_nxt ( kstp )! tracer fields at next time step79 IF( ln_trcrad ) CALL trc_rad ( kstp )! Correct artificial negative concentrations81 CALL trc_zdf ( kt ) ! vertical mixing and after tracer fields 82 CALL trc_nxt ( kt ) ! tracer fields at next time step 83 IF( ln_trcrad ) CALL trc_rad ( kt ) ! Correct artificial negative concentrations 80 84 81 85 #if defined key_agrif 82 IF( .NOT. Agrif_Root()) CALL Agrif_Update_Trc( kstp )! Update tracer at AGRIF zoom boundaries : children only86 IF( .NOT.Agrif_Root()) CALL Agrif_Update_Trc( kt ) ! Update tracer at AGRIF zoom boundaries : children only 83 87 #endif 84 IF( ln_zps ) CALL zps_hde( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive85 ! tracers at the bottom ocean level86 88 ! 87 89 ELSE ! 1D vertical configuration 88 CALL trc_sbc( kstp ) ! surface boundary condition 89 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & 90 & CALL trc_kpp( kstp ) ! KPP non-local tracer fluxes 91 CALL trc_zdf( kstp ) ! vertical mixing and after tracer fields 92 CALL trc_nxt( kstp ) ! tracer fields at next time step 93 IF( ln_trcrad ) CALL trc_rad( kstp ) ! Correct artificial negative concentrations 90 CALL trc_sbc( kt ) ! surface boundary condition 91 IF( ln_trcdmp ) CALL trc_dmp( kt ) ! internal damping trends 92 CALL trc_zdf( kt ) ! vertical mixing and after tracer fields 93 CALL trc_nxt( kt ) ! tracer fields at next time step 94 IF( ln_trcrad ) CALL trc_rad( kt ) ! Correct artificial negative concentrations 94 95 ! 95 96 END IF … … 104 105 !!---------------------------------------------------------------------- 105 106 CONTAINS 106 SUBROUTINE trc_trp( k stp) ! Empty routine107 INTEGER, INTENT(in) :: k stp108 WRITE(*,*) 'trc_trp: You should not have seen this print! error?', k stp107 SUBROUTINE trc_trp( kt ) ! Empty routine 108 INTEGER, INTENT(in) :: kt 109 WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt 109 110 END SUBROUTINE trc_trp 110 111 #endif -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r3680 r6225 11 11 !! 'key_top' TOP models 12 12 !!---------------------------------------------------------------------- 13 !! trc_ ldf: update the tracer trend with the lateral diffusion14 !! ldf_ctl: initialization, namelist read, and parameters control13 !! trc_zdf : update the tracer trend with the lateral diffusion 14 !! trc_zdf_ini : initialization, namelist read, and parameters control 15 15 !!---------------------------------------------------------------------- 16 USE oce_trc ! ocean dynamics and active tracers17 USE trc ! ocean passive tracers variables18 USE tr cnam_trp ! passive tracers transport namelistvariables19 USE trazdf_exp 20 USE trazdf_imp 21 USE tr dmod_oce22 USE trdtra 23 USE prtctl_trc 16 USE trc ! ocean passive tracers variables 17 USE oce_trc ! ocean dynamics and active tracers 18 USE trd_oce ! trends: ocean variables 19 USE trazdf_exp ! vertical diffusion: explicit (tra_zdf_exp routine) 20 USE trazdf_imp ! vertical diffusion: implicit (tra_zdf_imp routine) 21 USE trcldf ! passive tracers: lateral diffusion 22 USE trdtra ! trends manager: tracers 23 USE prtctl_trc ! Print control 24 24 25 25 IMPLICIT NONE 26 26 PRIVATE 27 27 28 PUBLIC trc_zdf ! called by step.F90 29 PUBLIC trc_zdf_alloc ! called by nemogcm.F90 28 PUBLIC trc_zdf ! called by step.F90 29 PUBLIC trc_zdf_ini ! called by nemogcm.F90 30 31 ! !!** Vertical diffusion (nam_trczdf) ** 32 LOGICAL , PUBLIC :: ln_trczdf_exp !: explicit vertical diffusion scheme flag 33 INTEGER , PUBLIC :: nn_trczdf_exp !: number of sub-time step (explicit time stepping) 30 34 31 35 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used 32 36 ! ! defined from ln_zdf... namlist logicals) 33 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra34 ! ! except at nittrc000 (=rdttra) if neuler=037 REAL(wp) :: r2dttrc ! vertical profile time-step, = 2 rdt 38 ! ! except at nittrc000 (=rdt) if neuler=0 35 39 36 40 !! * Substitutions 37 # include "domzgr_substitute.h90"38 41 # include "zdfddm_substitute.h90" 39 42 # include "vectopt_loop_substitute.h90" 40 43 !!---------------------------------------------------------------------- 41 !! NEMO/TOP 3. 3 , NEMO Consortium (2010)44 !! NEMO/TOP 3.7 , NEMO Consortium (2015) 42 45 !! $Id$ 43 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 44 47 !!---------------------------------------------------------------------- 45 48 CONTAINS 46 47 INTEGER FUNCTION trc_zdf_alloc()48 !!----------------------------------------------------------------------49 !! *** ROUTINE trc_zdf_alloc ***50 !!----------------------------------------------------------------------51 ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc )52 !53 IF( trc_zdf_alloc /= 0 ) CALL ctl_warn('trc_zdf_alloc : failed to allocate array.')54 !55 END FUNCTION trc_zdf_alloc56 57 49 58 50 SUBROUTINE trc_zdf( kt ) … … 71 63 IF( nn_timing == 1 ) CALL timing_start('trc_zdf') 72 64 ! 73 IF( kt == nittrc000 ) CALL zdf_ctl ! initialisation & control of options 74 75 IF( ln_top_euler) THEN 76 r2dt(:) = rdttrc(:) ! = rdttrc (use Euler time stepping) 77 ELSE 78 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 79 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 80 ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1 81 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 82 ENDIF 65 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 66 r2dttrc = rdttrc ! = rdttrc (use or restarting with Euler time stepping) 67 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 68 r2dttrc = 2. * rdttrc ! = 2 rdttrc (leapfrog) 83 69 ENDIF 84 70 … … 89 75 90 76 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 91 CASE ( -1 ) ! esopa: test all possibility with control print 92 CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) 93 WRITE(charout, FMT="('zdf1 ')") ; CALL prt_ctl_trc_info(charout) 94 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 95 CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt, trb, tra, jptra ) 96 WRITE(charout, FMT="('zdf2 ')") ; CALL prt_ctl_trc_info(charout) 97 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 98 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme 99 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt, trb, tra, jptra ) ! implicit scheme 100 77 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 101 79 END SELECT 102 80 … … 104 82 DO jn = 1, jptra 105 83 DO jk = 1, jpkm1 106 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) 107 85 END DO 108 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_zdf, ztrtrd(:,:,:,jn) )86 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 109 87 END DO 110 88 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) … … 121 99 122 100 123 SUBROUTINE zdf_ctl101 SUBROUTINE trc_zdf_ini 124 102 !!---------------------------------------------------------------------- 125 !! *** ROUTINE zdf_ctl***103 !! *** ROUTINE trc_zdf_ini *** 126 104 !! 127 105 !! ** Purpose : Choose the vertical mixing scheme … … 132 110 !! NB: The implicit scheme is required when using : 133 111 !! - rotated lateral mixing operator 134 !! - TKE, GLS or KPPvertical mixing scheme112 !! - TKE, GLS vertical mixing scheme 135 113 !!---------------------------------------------------------------------- 136 137 ! Define the vertical tracer physics scheme 138 ! ========================================== 139 140 ! Choice from ln_zdfexp already read in namelist in zdfini module 141 IF( ln_trczdf_exp ) THEN ! use explicit scheme 142 nzdf = 0 143 ELSE ! use implicit scheme 144 nzdf = 1 114 INTEGER :: ios ! Local integer output status for namelist read 115 !! 116 NAMELIST/namtrc_zdf/ ln_trczdf_exp , nn_trczdf_exp 117 !!---------------------------------------------------------------------- 118 ! 119 REWIND( numnat_ref ) ! namtrc_zdf in reference namelist 120 READ ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905) 121 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp ) 122 ! 123 REWIND( numnat_cfg ) ! namtrc_zdf in configuration namelist 124 READ ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 ) 125 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp ) 126 IF(lwm) WRITE ( numont, namtrc_zdf ) 127 ! 128 IF(lwp) THEN ! Control print 129 WRITE(numout,*) 130 WRITE(numout,*) ' Namelist namtrc_zdf : set vertical diffusion parameters' 131 WRITE(numout,*) ' time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp 132 WRITE(numout,*) ' number of time step nn_trczdf_exp = ', nn_trczdf_exp 145 133 ENDIF 146 134 147 ! Force implicit schemes 148 IF( ln_trcldf_iso ) nzdf = 1 ! iso-neutral lateral physics 149 IF( ln_trcldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 150 #if defined key_zdftke || defined key_zdfgls || defined key_zdfkpp 151 nzdf = 1 ! TKE, GLS or KPP physics 152 #endif 153 IF( ln_trczdf_exp .AND. nzdf == 1 ) THEN 154 CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS or KPP vertical scheme ', & 155 & ' the implicit scheme is required, set ln_trczdf_exp = .false.' ) 135 ! ! Define the vertical tracer physics scheme 136 IF( ln_trczdf_exp ) THEN ; nzdf = 0 ! explicit scheme 137 ELSE ; nzdf = 1 ! implicit scheme 156 138 ENDIF 157 139 158 ! Test: esopa 159 IF( lk_esopa ) nzdf = -1 ! All schemes used 140 ! ! Force implicit schemes 141 IF( ln_trcldf_iso ) nzdf = 1 ! iso-neutral lateral physics 142 IF( ln_trcldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 143 #if defined key_zdftke || defined key_zdfgls 144 nzdf = 1 ! TKE or GLS physics 145 #endif 146 IF( ln_trczdf_exp .AND. nzdf == 1 ) & 147 CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS vertical scheme ', & 148 & ' the implicit scheme is required, set ln_trczdf_exp = .false.' ) 160 149 161 150 IF(lwp) THEN … … 163 152 WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme' 164 153 WRITE(numout,*) '~~~~~~~~~~~' 165 IF( nzdf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used'166 154 IF( nzdf == 0 ) WRITE(numout,*) ' Explicit time-splitting scheme' 167 155 IF( nzdf == 1 ) WRITE(numout,*) ' Implicit (euler backward) scheme' 168 156 ENDIF 169 170 END SUBROUTINE zdf_ctl 157 ! 158 END SUBROUTINE trc_zdf_ini 159 171 160 #else 172 161 !!---------------------------------------------------------------------- -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r4610 r6225 11 11 !! 'key_top' TOP models 12 12 !!---------------------------------------------------------------------- 13 14 ! * Domain size *13 ! 14 ! !* Domain size * 15 15 USE par_oce , ONLY : jpi => jpi !: first dimension of grid --> i 16 16 USE par_oce , ONLY : jpj => jpj !: second dimension of grid --> j … … 20 20 USE par_oce , ONLY : jpkm1 => jpkm1 !: jpk - 1 21 21 USE par_oce , ONLY : jpij => jpij !: jpi x jpj 22 USE par_oce , ONLY : lk_esopa => lk_esopa !: flag to activate the all option23 22 USE par_oce , ONLY : jp_tem => jp_tem !: indice for temperature 24 23 USE par_oce , ONLY : jp_sal => jp_sal !: indice for salinity 25 24 26 !* IO manager * 27 USE in_out_manager 28 29 !* Memory Allocation * 30 USE wrk_nemo 31 32 !* Timing * 33 USE timing 34 35 !* MPP library 36 USE lib_mpp 37 38 !* Fortran utilities 39 USE lib_fortran 40 41 !* Lateral boundary conditions 42 USE lbclnk 43 44 !* physical constants * 45 USE phycst 46 47 !* 1D configuration 48 USE c1d 49 50 !* model domain * 51 USE dom_oce 25 USE in_out_manager !* IO manager * 26 USE wrk_nemo !* Memory Allocation * 27 USE timing !* Timing * 28 USE lib_mpp !* MPP library 29 USE lib_fortran !* Fortran utilities 30 USE lbclnk !* Lateral boundary conditions 31 USE phycst !* physical constants * 32 USE c1d !* 1D configuration 33 USE dom_oce !* model domain * 52 34 53 35 USE domvvl, ONLY : un_td, vn_td !: thickness diffusion transport … … 56 38 57 39 !* ocean fields: here now and after fields * 58 USE oce , ONLY : ua => ua !: i-horizontal velocity (m s-1)59 USE oce , ONLY : va => va !: j-horizontal velocity (m s-1)60 40 USE oce , ONLY : un => un !: i-horizontal velocity (m s-1) 61 41 USE oce , ONLY : vn => vn !: j-horizontal velocity (m s-1) … … 67 47 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 68 48 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 69 USE oce , ONLY : rotn => rotn !: relative vorticity [s-1]70 USE oce , ONLY : hdivb => hdivb !: horizontal divergence (1/s)71 USE oce , ONLY : rotb => rotb !: relative vorticity [s-1]72 49 USE oce , ONLY : sshn => sshn !: sea surface height at t-point [m] 73 50 USE oce , ONLY : sshb => sshb !: sea surface height at t-point [m] 74 51 USE oce , ONLY : ssha => ssha !: sea surface height at t-point [m] 75 USE oce , ONLY : l_traldf_rot => l_traldf_rot !: rotated laplacian operator for lateral diffusion 52 #if defined key_offline 53 USE oce , ONLY : rab_n => rab_n !: local thermal/haline expension ratio at T-points 54 #endif 76 55 77 56 !* surface fluxes * … … 84 63 USE sbc_oce , ONLY : fmmflx => fmmflx !: freshwater budget: volume flux [Kg/m2/s] 85 64 USE sbc_oce , ONLY : rnf => rnf !: river runoff [Kg/m2/s] 86 USE sbc_oce , ONLY : ln_dm2dc => ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr) 65 USE sbc_oce , ONLY : ln_dm2dc => ln_dm2dc !: Diurnal Cycle 66 USE sbc_oce , ONLY : ncpl_qsr_freq => ncpl_qsr_freq !: qsr coupling frequency per days from atmospher 87 67 USE sbc_oce , ONLY : ln_rnf => ln_rnf !: runoffs / runoff mouths 88 68 USE sbc_oce , ONLY : fr_i => fr_i !: ice fraction (between 0 to 1) 69 USE sbc_oce , ONLY : nn_ice_embd => nn_ice_embd !: flag for levitating/embedding sea-ice in the ocean 89 70 USE traqsr , ONLY : rn_abs => rn_abs !: fraction absorbed in the very near surface 90 71 USE traqsr , ONLY : rn_si0 => rn_si0 !: very near surface depth of extinction … … 93 74 USE sbcrnf , ONLY : rnfmsk_z => rnfmsk_z !: mixed adv scheme in runoffs vicinity (vert.) 94 75 USE sbcrnf , ONLY : h_rnf => h_rnf !: river runoff [Kg/m2/s] 76 USE sbcrnf , ONLY : nk_rnf => nk_rnf !: depth of runoff in model level 95 77 96 78 USE trc_oce 97 79 80 !!gm : I don't understand this as ldftra (where everything is defined) is used by TRC in all cases (ON/OFF-line) 81 !!gm so the following lines should be removed.... logical should be the one of TRC namelist 82 !!gm In case off coarsening.... the ( ahtu, ahtv, aeiu, aeiv) arrays are needed that's all. 98 83 !* lateral diffusivity (tracers) * 99 USE ldftra_oce , ONLY : rldf => rldf !: multiplicative coef. for lateral diffusivity 100 USE ldftra_oce , ONLY : rn_aht_0 => rn_aht_0 !: horizontal eddy diffusivity for tracers (m2/s) 101 USE ldftra_oce , ONLY : aht0 => aht0 !: horizontal eddy diffusivity for tracers (m2/s) 102 USE ldftra_oce , ONLY : ahtb0 => ahtb0 !: background eddy diffusivity for isopycnal diff. (m2/s) 103 USE ldftra_oce , ONLY : ahtu => ahtu !: lateral diffusivity coef. at u-points 104 USE ldftra_oce , ONLY : ahtv => ahtv !: lateral diffusivity coef. at v-points 105 USE ldftra_oce , ONLY : ahtw => ahtw !: lateral diffusivity coef. at w-points 106 USE ldftra_oce , ONLY : ahtt => ahtt !: lateral diffusivity coef. at t-points 107 USE ldftra_oce , ONLY : aeiv0 => aeiv0 !: eddy induced velocity coefficient (m2/s) 108 USE ldftra_oce , ONLY : aeiu => aeiu !: eddy induced velocity coef. at u-points (m2/s) 109 USE ldftra_oce , ONLY : aeiv => aeiv !: eddy induced velocity coef. at v-points (m2/s) 110 USE ldftra_oce , ONLY : aeiw => aeiw !: eddy induced velocity coef. at w-points (m2/s) 111 USE ldftra_oce , ONLY : lk_traldf_eiv => lk_traldf_eiv !: eddy induced velocity flag 84 USE ldftra , ONLY : rn_aht_0 => rn_aht_0 !: laplacian lateral eddy diffusivity [m2/s] 85 USE ldftra , ONLY : rn_bht_0 => rn_bht_0 !: bilaplacian lateral eddy diffusivity [m4/s] 86 USE ldftra , ONLY : ahtu => ahtu !: lateral diffusivity coef. at u-points 87 USE ldftra , ONLY : ahtv => ahtv !: lateral diffusivity coef. at v-points 88 USE ldftra , ONLY : rn_aeiv_0 => rn_aeiv_0 !: eddy induced velocity coefficient (m2/s) 89 USE ldftra , ONLY : aeiu => aeiu !: eddy induced velocity coef. at u-points (m2/s) 90 USE ldftra , ONLY : aeiv => aeiv !: eddy induced velocity coef. at v-points (m2/s) 91 USE ldftra , ONLY : ln_ldfeiv => ln_ldfeiv !: eddy induced velocity flag 92 93 !!gm this should be : ln_trcldf_triad (TRC namelist) 94 USE ldfslp , ONLY : ln_traldf_triad => ln_traldf_triad !: triad scheme (Griffies et al.) 95 96 !* direction of lateral diffusion * 97 USE ldfslp , ONLY : l_ldfslp => l_ldfslp !: slopes flag 98 USE ldfslp , ONLY : uslp => uslp !: i-slope at u-point 99 USE ldfslp , ONLY : vslp => vslp !: j-slope at v-point 100 USE ldfslp , ONLY : wslpi => wslpi !: i-slope at w-point 101 USE ldfslp , ONLY : wslpj => wslpj !: j-slope at w-point 102 !!gm end 112 103 113 104 !* vertical diffusion * … … 123 114 USE zdfmxl , ONLY : hmlpt => hmlpt !: mixed layer depth at t-points (m) 124 115 125 !* direction of lateral diffusion * 126 USE ldfslp , ONLY : lk_ldfslp => lk_ldfslp !: slopes flag 127 # if defined key_ldfslp 128 USE ldfslp , ONLY : uslp => uslp !: i-direction slope at u-, w-points 129 USE ldfslp , ONLY : vslp => vslp !: j-direction slope at v-, w-points 130 USE ldfslp , ONLY : wslpi => wslpi !: i-direction slope at u-, w-points 131 USE ldfslp , ONLY : wslpj => wslpj !: j-direction slope at v-, w-points 132 # endif 133 116 USE diaar5 , ONLY : lk_diaar5 => lk_diaar5 134 117 #else 135 118 !!---------------------------------------------------------------------- -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trc.F90
r4611 r6225 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 … … 34 37 REAL(wp), PUBLIC :: areatot !: total volume 35 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: cvol !: volume correction -degrad option- 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trn !: traceur concentration for now time step 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tra !: traceur concentration for next time step 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trb !: traceur concentration for before time step 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trn !: tracer concentration for now time step 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tra !: tracer concentration for next time step 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trb !: tracer concentration for before time step 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: sbc_trc_b !: Before sbc fluxes for tracers 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: sbc_trc !: Now sbc fluxes for tracers 44 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: trc_i !: prescribed tracer concentration in sea ice for SBC 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: trc_o !: prescribed tracer concentration in ocean for SBC 47 INTEGER , PUBLIC :: nn_ice_tr !: handling of sea ice tracers 39 48 40 49 !! interpolated gradient … … 42 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtru !: hor. gradient at u-points at bottom ocean level 43 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrv !: hor. gradient at v-points at bottom ocean level 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrui !: hor. gradient at u-points at top ocean level 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrvi !: hor. gradient at v-points at top ocean level 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_mean !: daily mean qsr 44 56 45 57 !! passive tracers (input and output) … … 52 64 INTEGER , PUBLIC :: nn_rsttr !: control of the time step ( 0 or 1 ) for pass. tr. 53 65 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_in !: suffix of pass. tracer restart name (input) 66 CHARACTER(len = 256), PUBLIC :: cn_trcrst_indir !: restart input directory 54 67 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 55 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttrc !: vertical profile of passive tracer time step 68 CHARACTER(len = 256), PUBLIC :: cn_trcrst_outdir !: restart output directory 69 REAL(wp) , PUBLIC :: rdttrc !: passive tracer time step 56 70 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration 57 71 LOGICAL , PUBLIC :: ln_trcdta !: Read inputs data from files … … 59 73 LOGICAL , PUBLIC :: ln_trcdmp_clo !: internal damping flag on closed seas 60 74 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 75 LOGICAL , PUBLIC :: l_trcdm2dc !: Diurnal cycle for TOP 76 77 !! Information for the ice module for tracers 78 !! ------------------------------------------ 79 TYPE TRC_I_NML !--- Ice tracer namelist structure 80 REAL(wp) :: trc_ratio ! ice-ocean trc ratio 81 REAL(wp) :: trc_prescr ! prescribed ice trc cc 82 CHARACTER(len=2) :: ctrc_o ! choice of ocean trc cc 83 END TYPE 84 85 REAL(wp), DIMENSION(jptra), PUBLIC :: trc_ice_ratio, & ! ice-ocean tracer ratio 86 trc_ice_prescr ! prescribed ice trc cc 87 CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 61 88 62 89 !! information for outputs … … 67 94 CHARACTER(len = 20) :: clunit !: unit 68 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 69 101 LOGICAL :: llsave !: save the tracer or not 70 102 END TYPE PTRACER … … 119 151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_tm !: vertical double diffusivity coeff. at w-point [m/s] 120 152 # endif 121 #if defined key_ldfslp122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpi_tm !: i-direction slope at u-, w-points123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpj_tm !: j-direction slope at u-, w-points124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm !: j-direction slope at u-, w-points125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslp_tm !: j-direction slope at u-, w-points126 #endif127 153 #if defined key_trabbl 128 154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_tm !: u-, w-points … … 159 185 #endif 160 186 ! 161 #if defined key_ldfslp162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpi_temp, wslpj_temp, uslp_temp, vslp_temp !: hold current values163 #endif164 !165 187 # if defined key_zdfddm 166 188 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_temp !: salinity vertical diffusivity coeff. at w-point [m/s] 167 189 # endif 168 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 ! 169 199 170 200 !!---------------------------------------------------------------------- 171 201 !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 172 !! $Id$ 202 !! $Id$ 173 203 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 174 204 !!---------------------------------------------------------------------- … … 183 213 ! 184 214 ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra), & 185 & gtru(jpi,jpj,jpk) , gtrv(jpi,jpj,jpk) , & 186 & cvol(jpi,jpj,jpk) , rdttrc(jpk) , trai(jptra) , & 215 & trc_i(jpi,jpj,jptra) , trc_o(jpi,jpj,jptra) , & 216 & gtru (jpi,jpj,jptra) , gtrv (jpi,jpj,jptra) , & 217 & gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , & 218 & sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra) , & 219 & cvol(jpi,jpj,jpk) , trai(jptra) , & 187 220 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & 188 & ln_trc_ini(jptra) , ln_trc_wri(jptra) , 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 ) 189 230 190 231 IF( trc_alloc /= 0 ) CALL ctl_warn('trc_alloc: failed to allocate arrays') -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
- Property svn:keywords set to Id
r4624 r6225 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: trcdta.F90 2977 2011-10-22 13:46:41Z cetlod $ 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 -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
r4292 r6225 51 51 INTEGER :: nhoritb !: id for horizontal mesh 52 52 53 !! * Substitutions54 # include "top_substitute.h90"55 53 !!---------------------------------------------------------------------- 56 54 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 108 106 CHARACTER (len=20) :: cltra, cltrau 109 107 CHARACTER (len=80) :: cltral 110 REAL(wp) :: zsto, zout , zdt108 REAL(wp) :: zsto, zout 111 109 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 112 110 !!---------------------------------------------------------------------- … … 120 118 121 119 ! Define frequency of output and means 122 zdt = rdt123 120 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 124 121 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) … … 128 125 clop = "inst("//TRIM(clop)//")" 129 126 # else 130 zsto = zdt127 zsto = rdt 131 128 clop = "ave("//TRIM(clop)//")" 132 129 # endif 133 zout = nn_writetrc * zdt130 zout = nn_writetrc * rdt 134 131 135 132 ! Define indices of the horizontal output zoom and vertical limit storage … … 184 181 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 185 182 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 186 & iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set)183 & iiter, zjulian, rdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set) 187 184 188 185 ! Vertical grid for tracer : gdept … … 252 249 INTEGER :: jl 253 250 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 254 REAL(wp) :: zsto, zout , zdt251 REAL(wp) :: zsto, zout 255 252 !!---------------------------------------------------------------------- 256 253 … … 263 260 ! 264 261 ! Define frequency of output and means 265 zdt = rdt266 262 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 267 263 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) 268 264 ENDIF 269 265 # if defined key_diainstant 270 zsto = nn_writedia * zdt266 zsto = nn_writedia * rdt 271 267 clop = "inst("//TRIM(clop)//")" 272 268 # else 273 zsto = zdt269 zsto = rdt 274 270 clop = "ave("//TRIM(clop)//")" 275 271 # endif 276 zout = nn_writedia * zdt272 zout = nn_writedia * rdt 277 273 278 274 ! Define indices of the horizontal output zoom and vertical limit storage … … 304 300 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 305 301 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 306 & iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set )302 & iiter, zjulian, rdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set ) 307 303 308 304 ! Vertical grid for 2d and 3d arrays … … 389 385 INTEGER :: ji, jj, jk, jl 390 386 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 391 REAL(wp) :: zsto, zout , zdt387 REAL(wp) :: zsto, zout 392 388 !!---------------------------------------------------------------------- 393 389 … … 400 396 401 397 ! Define frequency of output and means 402 zdt = rdt403 398 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 404 399 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) 405 400 ENDIF 406 401 # if defined key_diainstant 407 zsto = nn_writebio * zdt402 zsto = nn_writebio * rdt 408 403 clop = "inst("//TRIM(clop)//")" 409 404 # else 410 zsto = zdt405 zsto = rdt 411 406 clop = "ave("//TRIM(clop)//")" 412 407 # endif 413 zout = nn_writebio * zdt408 zout = nn_writebio * rdt 414 409 415 410 ! Define indices of the horizontal output zoom and vertical limit storage … … 437 432 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 438 433 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 439 & iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set )434 & iiter, zjulian, rdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set ) 440 435 ! Vertical grid for biological trends 441 436 CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_1d, ndepitb) -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r4624 r6225 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 232 ENDIF … … 231 239 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac ! multiplicative factor 232 240 ! 233 IF( lwp .AND. kt == nit000 ) THEN234 clndta = TRIM( sf_dta(1)%clvar )235 WRITE(numout,*) ''//clndta//' data '236 WRITE(numout,*)237 WRITE(numout,*)' level = 1'238 CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )239 WRITE(numout,*)' level = ', jpk/2240 CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )241 WRITE(numout,*)' level = ', jpkm1242 CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )243 WRITE(numout,*)244 ENDIF245 241 ENDIF 246 242 ! … … 248 244 ! 249 245 END SUBROUTINE trc_dta 246 250 247 #else 251 248 !!---------------------------------------------------------------------- … … 257 254 END SUBROUTINE trc_dta 258 255 #endif 256 259 257 !!====================================================================== 260 258 END MODULE trcdta -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r4607 r6225 18 18 USE oce_trc ! shared variables between ocean and passive tracers 19 19 USE trc ! passive tracers common variables 20 USE trcrst ! passive tracers restart21 20 USE trcnam ! Namelist read 22 USE trcini_cfc ! CFC initialisation23 USE trcini_pisces ! PISCES initialisation24 USE trcini_c14b ! C14 bomb initialisation25 USE trcini_my_trc ! MY_TRC initialisation26 USE trcdta ! initialisation from files27 21 USE daymod ! calendar manager 28 USE zpshde ! partial step: hor. derivative (zps_hde routine)29 22 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) 30 23 USE trcsub ! variables to substep passive tracers 24 USE trcrst 31 25 USE lib_mpp ! distribued memory computing library 32 26 USE sbc_oce 27 USE trcice ! tracers in sea ice 28 USE trcbc, only : trc_bc_init ! generalized Boundary Conditions 33 29 34 30 IMPLICIT NONE … … 37 33 PUBLIC trc_init ! called by opa 38 34 39 !! * Substitutions40 # include "domzgr_substitute.h90"41 35 !!---------------------------------------------------------------------- 42 36 !! NEMO/TOP 4.0 , NEMO Consortium (2011) … … 58 52 !! or read data or analytical formulation 59 53 !!--------------------------------------------------------------------- 60 INTEGER :: jk, jn, jl ! dummy loop indices61 CHARACTER (len=25) :: charout62 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 4D workspace63 !!---------------------------------------------------------------------64 54 ! 65 55 IF( nn_timing == 1 ) CALL timing_start('trc_init') … … 69 59 IF(lwp) WRITE(numout,*) '~~~~~~~' 70 60 71 CALL top_alloc() ! allocate TOP arrays 72 73 #if defined key_offline 74 ltrcdm2dc = .FALSE. 75 #endif 76 77 IF( ltrcdm2dc )CALL ctl_warn( ' Diurnal cycle on physics but not in PISCES or LOBSTER ' ) 78 79 IF( nn_cla == 1 ) & 80 & CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 81 82 CALL trc_nam ! read passive tracers namelists 61 ! 62 CALL top_alloc() ! allocate TOP arrays 63 ! 64 CALL trc_ini_ctl ! control 65 ! 66 CALL trc_nam ! read passive tracers namelists 83 67 ! 84 68 IF(lwp) WRITE(numout,*) … … 87 71 ! 88 72 IF(lwp) WRITE(numout,*) 89 ! masked grid volume 73 ! 74 CALL trc_ini_sms ! SMS 75 ! 76 CALL trc_ini_trp ! passive tracers transport 77 ! 78 CALL trc_ice_ini ! Tracers in sea ice 79 ! 80 IF( lwp ) & 81 & CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 82 ! 83 CALL trc_ini_state ! passive tracers initialisation : from a restart or from clim 84 ! 85 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 86 ! 87 CALL trc_ini_inv ! Inventories 88 ! 89 IF( nn_timing == 1 ) CALL timing_stop('trc_init') 90 ! 91 END SUBROUTINE trc_init 92 93 94 SUBROUTINE trc_ini_ctl 95 !!---------------------------------------------------------------------- 96 !! *** ROUTINE trc_ini_ctl *** 97 !! ** Purpose : Control + ocean volume 98 !!---------------------------------------------------------------------- 99 INTEGER :: jk ! dummy loop indices 100 ! 101 ! Define logical parameter ton control dirunal cycle in TOP 102 l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 103 l_trcdm2dc = l_trcdm2dc .AND. .NOT. lk_offline 104 IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', & 105 & 'Computation of a daily mean shortwave for some biogeochemical models ' ) 106 ! 107 END SUBROUTINE trc_ini_ctl 108 109 110 SUBROUTINE trc_ini_inv 111 !!---------------------------------------------------------------------- 112 !! *** ROUTINE trc_ini_stat *** 113 !! ** Purpose : passive tracers inventories at initialsation phase 114 !!---------------------------------------------------------------------- 115 INTEGER :: jk, jn ! dummy loop indices 116 CHARACTER (len=25) :: charout 117 !!---------------------------------------------------------------------- 90 118 ! ! masked grid volume 91 119 DO jk = 1, jpk 92 cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)120 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 93 121 END DO 94 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)! degrad option: reduction by facvol122 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:) ! degrad option: reduction by facvol 95 123 ! ! total volume of the ocean 96 124 areatot = glob_sum( cvol(:,:,:) ) 97 125 ! 126 trai(:) = 0._wp ! initial content of all tracers 127 DO jn = 1, jptra 128 trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 129 END DO 130 131 IF(lwp) THEN ! control print 132 WRITE(numout,*) 133 WRITE(numout,*) 134 WRITE(numout,*) ' *** Total number of passive tracer jptra = ', jptra 135 WRITE(numout,*) ' *** Total volume of ocean = ', areatot 136 WRITE(numout,*) ' *** Total inital content of all tracers ' 137 WRITE(numout,*) 138 DO jn = 1, jptra 139 WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 140 ENDDO 141 WRITE(numout,*) 142 ENDIF 143 IF(lwp) WRITE(numout,*) 144 IF(ln_ctl) THEN ! print mean trends (used for debugging) 145 CALL prt_ctl_trc_init 146 WRITE(charout, FMT="('ini ')") 147 CALL prt_ctl_trc_info( charout ) 148 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 149 ENDIF 150 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 151 ! 152 END SUBROUTINE trc_ini_inv 153 154 155 SUBROUTINE trc_ini_sms 156 !!---------------------------------------------------------------------- 157 !! *** ROUTINE trc_ini_sms *** 158 !! ** Purpose : SMS initialisation 159 !!---------------------------------------------------------------------- 160 USE trcini_cfc ! CFC initialisation 161 USE trcini_pisces ! PISCES initialisation 162 USE trcini_c14b ! C14 bomb initialisation 163 USE trcini_my_trc ! MY_TRC initialisation 164 !!---------------------------------------------------------------------- 98 165 IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model 99 166 IF( lk_cfc ) CALL trc_ini_cfc ! CFC tracers 100 167 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 101 168 IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers 102 103 IF( lwp ) THEN 104 ! 105 CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 106 ! 107 ENDIF 108 169 ! 170 END SUBROUTINE trc_ini_sms 171 172 SUBROUTINE trc_ini_trp 173 !!---------------------------------------------------------------------- 174 !! *** ROUTINE trc_ini_trp *** 175 !! 176 !! ** Purpose : Allocate all the dynamic arrays of the OPA modules 177 !!---------------------------------------------------------------------- 178 USE trcdmp , ONLY: trc_dmp_ini 179 USE trcadv , ONLY: trc_adv_ini 180 USE trcldf , ONLY: trc_ldf_ini 181 USE trczdf , ONLY: trc_zdf_ini 182 USE trcrad , ONLY: trc_rad_ini 183 ! 184 INTEGER :: ierr 185 !!---------------------------------------------------------------------- 186 ! 187 IF( ln_trcdmp ) CALL trc_dmp_ini ! damping 188 CALL trc_adv_ini ! advection 189 CALL trc_ldf_ini ! lateral diffusion 190 CALL trc_zdf_ini ! vertical diffusion 191 CALL trc_rad_ini ! positivity of passive tracers 192 ! 193 END SUBROUTINE trc_ini_trp 194 195 196 SUBROUTINE trc_ini_state 197 !!---------------------------------------------------------------------- 198 !! *** ROUTINE trc_ini_state *** 199 !! ** Purpose : Initialisation of passive tracer concentration 200 !!---------------------------------------------------------------------- 201 USE zpshde ! partial step: hor. derivative (zps_hde routine) 202 USE trcrst ! passive tracers restart 203 USE trcdta ! initialisation from files 204 ! 205 INTEGER :: jk, jn, jl ! dummy loop indices 206 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 4D workspace 207 !!---------------------------------------------------------------------- 208 ! 209 ! Initialisation of tracers Initial Conditions 109 210 IF( ln_trcdta ) CALL trc_dta_init(jptra) 110 211 212 ! Initialisation of tracers Boundary Conditions 213 IF( lk_my_trc ) CALL trc_bc_init(jptra) 111 214 112 215 IF( ln_rsttr ) THEN … … 143 246 144 247 tra(:,:,:,:) = 0._wp 145 146 IF( ln_zps .AND. .NOT. lk_c1d ) & ! Partial steps: before horizontal gradient of passive 147 & CALL zps_hde( nit000, jptra, trn, gtru, gtrv ) ! tracers at the bottom ocean level 148 149 ! 150 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 151 ! 152 153 trai(:) = 0._wp ! initial content of all tracers 154 DO jn = 1, jptra 155 trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 156 END DO 157 158 IF(lwp) THEN ! control print 159 WRITE(numout,*) 160 WRITE(numout,*) 161 WRITE(numout,*) ' *** Total number of passive tracer jptra = ', jptra 162 WRITE(numout,*) ' *** Total volume of ocean = ', areatot 163 WRITE(numout,*) ' *** Total inital content of all tracers ' 164 WRITE(numout,*) 165 DO jn = 1, jptra 166 WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 167 ENDDO 168 WRITE(numout,*) 169 ENDIF 170 IF(lwp) WRITE(numout,*) 171 IF(ln_ctl) THEN ! print mean trends (used for debugging) 172 CALL prt_ctl_trc_init 173 WRITE(charout, FMT="('ini ')") 174 CALL prt_ctl_trc_info( charout ) 175 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 176 ENDIF 177 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 178 ! 179 IF( nn_timing == 1 ) CALL timing_stop('trc_init') 180 ! 181 END SUBROUTINE trc_init 182 248 ! ! Partial top/bottom cell: GRADh(trn) 249 END SUBROUTINE trc_ini_state 183 250 184 251 SUBROUTINE top_alloc … … 188 255 !! ** Purpose : Allocate all the dynamic arrays of the OPA modules 189 256 !!---------------------------------------------------------------------- 190 USE trcadv , ONLY: trc_adv_alloc ! TOP-related alloc routines...191 257 USE trc , ONLY: trc_alloc 192 USE trcnxt , ONLY: trc_nxt_alloc 193 USE trczdf , ONLY: trc_zdf_alloc 194 USE trdmod_trc_oce, ONLY: trd_mod_trc_oce_alloc 195 #if defined key_trdmld_trc 196 USE trdmld_trc , ONLY: trd_mld_trc_alloc 258 USE trdtrc_oce , ONLY: trd_trc_oce_alloc 259 #if defined key_trdmxl_trc 260 USE trdmxl_trc , ONLY: trd_mxl_trc_alloc 197 261 #endif 198 262 ! … … 200 264 !!---------------------------------------------------------------------- 201 265 ! 202 ierr = trc_adv_alloc() ! Start of TOP-related alloc routines... 203 ierr = ierr + trc_alloc () 204 ierr = ierr + trc_nxt_alloc() 205 ierr = ierr + trc_zdf_alloc() 206 ierr = ierr + trd_mod_trc_oce_alloc() 207 #if defined key_trdmld_trc 208 ierr = ierr + trd_mld_trc_alloc() 266 ierr = trc_alloc() 267 ierr = ierr + trd_trc_oce_alloc() 268 #if defined key_trdmxl_trc 269 ierr = ierr + trd_mxl_trc_alloc() 209 270 #endif 210 271 ! -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r4624 r6225 20 20 USE oce_trc ! shared variables between ocean and passive tracers 21 21 USE trc ! passive tracers common variables 22 USE trcnam_trp ! Transport namelist23 22 USE trcnam_pisces ! PISCES namelist 24 23 USE trcnam_cfc ! CFC SMS namelist 25 24 USE trcnam_c14b ! C14 SMS namelist 26 25 USE trcnam_my_trc ! MY_TRC SMS namelist 27 USE trd mod_oce28 USE trd mod_trc_oce26 USE trd_oce 27 USE trdtrc_oce 29 28 USE iom ! I/O manager 30 29 … … 35 34 PUBLIC trc_nam ! called in trcini 36 35 37 !! * Substitutions38 # include "top_substitute.h90"39 36 !!---------------------------------------------------------------------- 40 37 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 41 !! $Id$ 38 !! $Id$ 42 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 40 !!---------------------------------------------------------------------- 44 45 41 CONTAINS 46 47 42 48 43 SUBROUTINE trc_nam … … 57 52 !!--------------------------------------------------------------------- 58 53 INTEGER :: jn ! dummy loop indice 59 ! ! Parameters of the run 60 IF( .NOT. lk_offline ) CALL trc_nam_run 61 62 ! ! passive tracer informations 63 CALL trc_nam_trc 64 65 ! ! Parameters of additional diagnostics 66 CALL trc_nam_dia 67 68 ! ! namelist of transport 69 CALL trc_nam_trp 70 71 72 IF( ln_rsttr ) ln_trcdta = .FALSE. ! restart : no need of clim data 73 ! 74 IF( ln_trcdmp .OR. ln_trcdmp_clo ) ln_trcdta = .TRUE. ! damping : need to have clim data 75 ! 76 IF( .NOT.ln_trcdta ) THEN 77 ln_trc_ini(:) = .FALSE. 78 ENDIF 79 80 IF(lwp) THEN ! control print 54 ! 55 IF( .NOT.lk_offline ) CALL trc_nam_run ! Parameters of the run 56 ! 57 CALL trc_nam_trc ! passive tracer informations 58 ! 59 CALL trc_nam_dia ! Parameters of additional diagnostics 60 ! 61 ! 62 IF( ln_rsttr ) ln_trcdta = .FALSE. ! restart : no need of clim data 63 ! 64 IF( ln_trcdmp .OR. ln_trcdmp_clo ) ln_trcdta = .TRUE. ! damping : need to have clim data 65 ! 66 IF( .NOT.ln_trcdta ) ln_trc_ini(:) = .FALSE. 67 68 IF(lwp) THEN ! control print 81 69 WRITE(numout,*) 82 70 WRITE(numout,*) ' Namelist : namtrc' … … 110 98 111 99 112 rdttrc (:) = rdttra(:) * FLOAT( nn_dttrc ) ! vertical profile ofpassive tracer time-step100 rdttrc = rdt * FLOAT( nn_dttrc ) ! passive tracer time-step 113 101 114 102 IF(lwp) THEN ! control print 115 103 WRITE(numout,*) 116 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc (1)104 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc 117 105 WRITE(numout,*) 118 106 ENDIF 119 107 120 108 121 #if defined key_trdm ld_trc || defined key_trdtrc109 #if defined key_trdmxl_trc || defined key_trdtrc 122 110 123 111 REWIND( numnat_ref ) ! Namelist namtrc_trd in reference namelist : Passive tracer trends … … 132 120 IF(lwp) THEN 133 121 WRITE(numout,*) 134 WRITE(numout,*) ' trd_m ld_trc_init : read namelist namtrc_trd '122 WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd ' 135 123 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 136 124 WRITE(numout,*) ' * frequency of trends diagnostics nn_trd_trc = ', nn_trd_trc 137 125 WRITE(numout,*) ' * control surface type nn_ctls_trc = ', nn_ctls_trc 138 WRITE(numout,*) ' * restart for ML diagnostics ln_trdm ld_trc_restart = ', ln_trdmld_trc_restart126 WRITE(numout,*) ' * restart for ML diagnostics ln_trdmxl_trc_restart = ', ln_trdmxl_trc_restart 139 127 WRITE(numout,*) ' * flag to diagnose trends of ' 140 WRITE(numout,*) ' instantantaneous or mean ML T/S ln_trdm ld_trc_instant = ', ln_trdmld_trc_instant128 WRITE(numout,*) ' instantantaneous or mean ML T/S ln_trdmxl_trc_instant = ', ln_trdmxl_trc_instant 141 129 WRITE(numout,*) ' * unit conversion factor rn_ucf_trc = ', rn_ucf_trc 142 130 DO jn = 1, jptra … … 147 135 148 136 137 ! Call the ice module for tracers 138 ! ------------------------------- 139 CALL trc_nam_ice 140 149 141 ! namelist of SMS 150 142 ! --------------- … … 167 159 END SUBROUTINE trc_nam 168 160 161 169 162 SUBROUTINE trc_nam_run 170 163 !!--------------------------------------------------------------------- … … 175 168 !!--------------------------------------------------------------------- 176 169 NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 177 & cn_trcrst_in , cn_trcrst_out178 170 & cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 171 ! 179 172 INTEGER :: ios ! Local integer output status for namelist read 180 181 !!--------------------------------------------------------------------- 182 183 184 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 173 !!--------------------------------------------------------------------- 174 ! 175 IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 185 176 IF(lwp) WRITE(numout,*) '~~~~~~~' 186 177 … … 216 207 217 208 209 SUBROUTINE trc_nam_ice 210 !!--------------------------------------------------------------------- 211 !! *** ROUTINE trc_nam_ice *** 212 !! 213 !! ** Purpose : Read the namelist for the ice effect on tracers 214 !! 215 !! ** Method : - 216 !! 217 !!--------------------------------------------------------------------- 218 INTEGER :: jn ! dummy loop indices 219 INTEGER :: ios ! Local integer output status for namelist read 220 ! 221 TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 222 !! 223 NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 224 !!--------------------------------------------------------------------- 225 ! 226 IF(lwp) THEN 227 WRITE(numout,*) 228 WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice' 229 WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 230 ENDIF 231 232 IF( nn_timing == 1 ) CALL timing_start('trc_nam_ice') 233 234 ! 235 REWIND( numnat_ref ) ! Namelist namtrc_ice in reference namelist : Passive tracer input data 236 READ ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901) 237 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 238 239 REWIND( numnat_cfg ) ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients 240 READ ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 ) 241 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp ) 242 243 IF( lwp ) THEN 244 WRITE(numout,*) ' ' 245 WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr 246 WRITE(numout,*) ' ' 247 ENDIF 248 249 ! Assign namelist stuff 250 DO jn = 1, jptra 251 trc_ice_ratio(jn) = sn_tri_tracer(jn)%trc_ratio 252 trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr 253 cn_trc_o (jn) = sn_tri_tracer(jn)%ctrc_o 254 END DO 255 256 IF( nn_timing == 1 ) CALL timing_stop('trc_nam_ice') 257 ! 258 END SUBROUTINE trc_nam_ice 259 260 218 261 SUBROUTINE trc_nam_trc 219 262 !!--------------------------------------------------------------------- … … 223 266 !! 224 267 !!--------------------------------------------------------------------- 225 TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput226 !!227 NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo228 229 268 INTEGER :: ios ! Local integer output status for namelist read 230 269 INTEGER :: jn ! dummy loop indice 270 ! 271 TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput 272 !! 273 NAMELIST/namtrc/ sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo 231 274 !!--------------------------------------------------------------------- 232 275 IF(lwp) WRITE(numout,*) 233 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'276 IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 234 277 IF(lwp) WRITE(numout,*) '~~~~~~~' 235 236 278 237 279 REWIND( numnat_ref ) ! Namelist namtrc in reference namelist : Passive tracer variables … … 249 291 ctrcun (jn) = TRIM( sn_tracer(jn)%clunit ) 250 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 251 298 ln_trc_wri(jn) = sn_tracer(jn)%llsave 252 299 END DO 253 254 300 ! 301 END SUBROUTINE trc_nam_trc 255 302 256 303 … … 265 312 !! ( (PISCES, CFC, MY_TRC ) 266 313 !!--------------------------------------------------------------------- 314 INTEGER :: ios ! Local integer output status for namelist read 267 315 INTEGER :: ierr 268 #if defined key_trdmld_trc || defined key_trdtrc 316 !! 317 #if defined key_trdmxl_trc || defined key_trdtrc 269 318 NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 270 & ln_trdm ld_trc_restart, ln_trdmld_trc_instant, &319 & ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 271 320 & cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 272 321 #endif 273 322 NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 274 275 INTEGER :: ios ! Local integer output status for namelist read 276 !!--------------------------------------------------------------------- 277 278 IF(lwp) WRITE(numout,*) 279 IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options' 280 IF(lwp) WRITE(numout,*) '~~~~~~~' 323 !!--------------------------------------------------------------------- 281 324 282 325 IF(lwp) WRITE(numout,*) … … 339 382 !!---------------------------------------------------------------------- 340 383 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 341 !! $Id$ 384 !! $Id$ 342 385 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 343 386 !!====================================================================== 344 END MODULE 387 END MODULE trcnam -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r4152 r6225 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 … … 25 21 USE oce_trc 26 22 USE trc 27 USE trcnam_trp28 23 USE iom 29 24 USE daymod 25 30 26 IMPLICIT NONE 31 27 PRIVATE … … 36 32 PUBLIC trc_rst_cal 37 33 38 !! * Substitutions 39 # include "top_substitute.h90" 40 34 !!---------------------------------------------------------------------- 35 !! NEMO/TOP 3.7 , NEMO Consortium (2010) 36 !! $Id$ 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 !!---------------------------------------------------------------------- 41 39 CONTAINS 42 40 … … 51 49 CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character 52 50 CHARACTER(LEN=50) :: clname ! trc output restart file name 51 CHARACTER(LEN=256) :: clpath ! full path to ocean output restart file 53 52 !!---------------------------------------------------------------------- 54 53 ! … … 56 55 IF( kt == nittrc000 ) THEN 57 56 lrst_trc = .FALSE. 58 nitrst = nitend 59 ENDIF 60 61 IF( MOD( kt - 1, nstock ) == 0 ) THEN 57 IF( ln_rst_list ) THEN 58 nrst_lst = 1 59 nitrst = nstocklist( nrst_lst ) 60 ELSE 61 nitrst = nitend 62 ENDIF 63 ENDIF 64 65 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 62 66 ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 63 67 nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing … … 79 83 IF(lwp) WRITE(numout,*) 80 84 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out) 81 IF(lwp) WRITE(numout,*) ' open trc restart.output NetCDF file: '//clname 82 CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib ) 85 clpath = TRIM(cn_trcrst_outdir) 86 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 87 IF(lwp) WRITE(numout,*) & 88 ' open trc restart.output NetCDF file: ',TRIM(clpath)//clname 89 CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib ) 83 90 lrst_trc = .TRUE. 84 91 ENDIF … … 123 130 !!---------------------------------------------------------------------- 124 131 ! 125 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 126 133 ! prognostic variables 127 134 ! -------------------- … … 137 144 CALL trc_rst_stat ! statistics 138 145 CALL iom_close( numrtw ) ! close the restart file (only at last time step) 139 #if ! defined key_trdm ld_trc146 #if ! defined key_trdmxl_trc 140 147 lrst_trc = .FALSE. 141 148 #endif 149 IF( lk_offline .AND. ln_rst_list ) THEN 150 nrst_lst = nrst_lst + 1 151 nitrst = nstocklist( nrst_lst ) 152 ENDIF 142 153 ENDIF 143 154 ! … … 187 198 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 188 199 189 IF ( jprstlib == jprstdimg ) THEN 190 ! eventually read netcdf file (monobloc) for restarting on different number of processors 191 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 192 INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 193 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 194 ENDIF 195 196 CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 197 198 CALL iom_get ( numrtr, 'kt', zkt ) ! last time-step of previous run 199 200 IF(lwp) THEN 201 WRITE(numout,*) ' *** Info read in restart : ' 202 WRITE(numout,*) ' previous time-step : ', NINT( zkt ) 203 WRITE(numout,*) ' *** restart option' 204 SELECT CASE ( nn_rsttr ) 205 CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 206 CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 207 CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 208 END SELECT 209 WRITE(numout,*) 210 ENDIF 211 ! Control of date 212 IF( nittrc000 - NINT( zkt ) /= nn_dttrc .AND. nn_rsttr /= 0 ) & 213 & CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', & 214 & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 215 IF( lk_offline ) THEN ! set the date in offline mode 216 ! Check dynamics and tracer time-step consistency and force Euler restart if changed 217 IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 ) THEN 218 CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 ) 219 IF( zrdttrc1 /= rdt * nn_dttrc ) neuler = 0 220 ENDIF 221 ! ! define ndastp and adatrj 222 IF( nn_rsttr == 2 ) THEN 200 IF( ln_rsttr ) THEN 201 CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt ) 202 CALL iom_get ( numrtr, 'kt', zkt ) ! last time-step of previous run 203 204 IF(lwp) THEN 205 WRITE(numout,*) ' *** Info read in restart : ' 206 WRITE(numout,*) ' previous time-step : ', NINT( zkt ) 207 WRITE(numout,*) ' *** restart option' 208 SELECT CASE ( nn_rsttr ) 209 CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 210 CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 211 CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 212 END SELECT 213 WRITE(numout,*) 214 ENDIF 215 ! Control of date 216 IF( nittrc000 - NINT( zkt ) /= nn_dttrc .AND. nn_rsttr /= 0 ) & 217 & CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', & 218 & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 219 ENDIF 220 ! 221 IF( lk_offline ) THEN 222 ! ! set the date in offline mode 223 IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN 223 224 CALL iom_get( numrtr, 'ndastp', zndastp ) 224 225 ndastp = NINT( zndastp ) 225 226 CALL iom_get( numrtr, 'adatrj', adatrj ) 226 ELSE227 ELSE 227 228 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam 228 adatrj = ( REAL( nittrc000-1, wp ) * rdt tra(1)) / rday229 adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday 229 230 ! note this is wrong if time step has changed during run 230 231 ENDIF … … 235 236 WRITE(numout,*) ' number of elapsed days since the begining of run : ', adatrj 236 237 WRITE(numout,*) 238 ENDIF 239 ! 240 IF( ln_rsttr ) THEN ; neuler = 1 241 ELSE ; neuler = 0 237 242 ENDIF 238 243 ! … … 265 270 INTEGER :: jk, jn 266 271 REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 272 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol 267 273 !!---------------------------------------------------------------------- 268 274 … … 273 279 ENDIF 274 280 ! 275 DO jn = 1, jptra 276 ztraf = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 281 DO jk = 1, jpk 282 zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 283 END DO 284 ! 285 DO jn = 1, jptra 286 ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) ) 277 287 zmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 278 288 zmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) … … 306 316 !!---------------------------------------------------------------------- 307 317 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 308 !! $Id$ 318 !! $Id$ 309 319 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 310 320 !!====================================================================== -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r3680 r6225 75 75 76 76 !!====================================================================== 77 END MODULE 77 END MODULE trcsms -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r4624 r6225 19 19 USE trcwri 20 20 USE trcrst 21 USE trd mod_trc_oce22 USE trdm ld_trc21 USE trdtrc_oce 22 USE trdmxl_trc 23 23 USE iom 24 24 USE in_out_manager … … 30 30 PUBLIC trc_stp ! called by step 31 31 32 !! * Substitutions 33 # include "domzgr_substitute.h90" 32 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step 33 REAL(wp) :: rdt_sampl 34 INTEGER :: nb_rec_per_days 35 INTEGER :: isecfst, iseclast 36 LOGICAL :: llnew 37 34 38 !!---------------------------------------------------------------------- 35 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 54 58 CHARACTER (len=25) :: charout 55 59 56 REAL(wp), DIMENSION(:,:), POINTER :: zqsr_tmp ! save qsr during TOP time-step57 60 !!------------------------------------------------------------------- 58 61 ! 59 62 IF( nn_timing == 1 ) CALL timing_start('trc_stp') 60 63 ! 61 IF( kt == nittrc000 .AND. lk_trdm ld_trc ) CALL trd_mld_trc_init ! trends: Mixed-layer64 IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer 62 65 ! 63 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 64 67 DO jk = 1, jpk 65 cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)68 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 66 69 END DO 67 70 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:) ! degrad option: reduction by facvol 68 71 areatot = glob_sum( cvol(:,:,:) ) 69 72 ENDIF 70 ! 71 IF( ltrcdm2dc ) THEN 72 ! When Diurnal cycle, core bulk and LIM2 are activated, put daily mean qsr in qsr for TOP/biogeochemistery time-step 73 ! and save qsr with diurnal cycle in qsr_tmp 74 CALL wrk_alloc( jpi,jpj, zqsr_tmp ) 75 zqsr_tmp(:,:) = qsr (:,:) 76 qsr (:,:) = qsr_mean(:,:) 77 ENDIF 73 ! 74 IF( l_trcdm2dc ) CALL trc_mean_qsr( kt ) 78 75 ! 79 76 IF( nn_dttrc /= 1 ) CALL trc_sub_stp( kt ) ! averaging physical variables for sub-stepping … … 100 97 ENDIF 101 98 IF( lrst_trc ) CALL trc_rst_wri ( kt ) ! write tracer restart file 102 IF( lk_trdm ld_trc ) CALL trd_mld_trc ( kt ) ! trends: Mixed-layer99 IF( lk_trdmxl_trc ) CALL trd_mxl_trc ( kt ) ! trends: Mixed-layer 103 100 ! 104 101 IF( nn_dttrc /= 1 ) CALL trc_sub_reset( kt ) ! resetting physical variables when sub-stepping 105 102 ! 106 ENDIF107 !108 IF( ltrcdm2dc ) THEN109 ! put back qsr with diurnal cycle in qsr110 qsr(:,:) = zqsr_tmp(:,:)111 CALL wrk_dealloc( jpi,jpj, zqsr_tmp )112 103 ENDIF 113 104 ! … … 123 114 END SUBROUTINE trc_stp 124 115 116 117 SUBROUTINE trc_mean_qsr( kt ) 118 !!---------------------------------------------------------------------- 119 !! *** ROUTINE trc_mean_qsr *** 120 !! 121 !! ** Purpose : Compute daily mean qsr for biogeochemical model in case 122 !! of diurnal cycle 123 !! 124 !! ** Method : store in TOP the qsr every hour ( or every time-step the latter 125 !! is greater than 1 hour ) and then, compute the mean with 126 !! a moving average over 24 hours. 127 !! In coupled mode, the sampling is done at every coupling frequency 128 !!---------------------------------------------------------------------- 129 INTEGER, INTENT(in) :: kt 130 INTEGER :: jn 131 !!---------------------------------------------------------------------- 132 ! 133 IF( kt == nittrc000 ) THEN 134 IF( ln_cpl ) THEN 135 rdt_sampl = 86400. / ncpl_qsr_freq 136 nb_rec_per_days = ncpl_qsr_freq 137 ELSE 138 rdt_sampl = MAX( 3600., rdt * nn_dttrc ) 139 nb_rec_per_days = INT( 86400 / rdt_sampl ) 140 ENDIF 141 ! 142 IF( lwp ) THEN 143 WRITE(numout,*) 144 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_days 145 WRITE(numout,*) 146 ENDIF 147 ! 148 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) ) 149 DO jn = 1, nb_rec_per_days 150 qsr_arr(:,:,jn) = qsr(:,:) 151 ENDDO 152 qsr_mean(:,:) = qsr(:,:) 153 ! 154 isecfst = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 155 iseclast = isecfst 156 ! 157 ENDIF 158 ! 159 iseclast = nsec_year + nsec1jan000 160 llnew = ( iseclast - isecfst ) > INT( rdt_sampl ) ! new shortwave to store 161 IF( kt /= nittrc000 .AND. llnew ) THEN 162 IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, & 163 & ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours ' 164 isecfst = iseclast 165 DO jn = 1, nb_rec_per_days - 1 166 qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 167 END DO 168 qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 169 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days 170 ENDIF 171 ! 172 END SUBROUTINE trc_mean_qsr 173 125 174 #else 126 175 !!---------------------------------------------------------------------- -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
- Property svn:keywords set to Id
r4611 r6225 25 25 USE zdf_oce 26 26 USE domvvl 27 USE div cur ! hor. divergence and curl (div & cur routines)27 USE divhor ! horizontal divergence (div_hor routine) 28 28 USE sbcrnf, ONLY: h_rnf, nk_rnf ! River runoff 29 29 USE bdy_oce … … 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) 45 44 46 !!* Substitution 47 # include "top_substitute.h90" 45 ! !* iso-neutral slopes (if l_ldfslp=T) 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_temp, vslp_temp, wslpi_temp, wslpj_temp !: hold current values 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm , vslp_tm , wslpi_tm , wslpj_tm !: time mean 48 48 49 !!---------------------------------------------------------------------- 49 50 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 50 !! $Id : trcstp.F90 2528 2010-12-27 17:33:53Z rblod$51 !! $Id$ 51 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 52 53 !!---------------------------------------------------------------------- … … 84 85 IF( MOD( kt , nn_dttrc ) /= 0 ) THEN 85 86 ! 86 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)87 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)88 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)89 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)90 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)91 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)92 # if defined key_zdfddm 93 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)94 # endif 95 #if defined key_ldfslp 96 wslpi_tm(:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:)97 wslpj_tm(:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:)98 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp(:,:,:)99 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp(:,:,:)100 #endif 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(:,:,:) 95 # endif 96 IF( l_ldfslp ) THEN 97 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:) 98 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:) 99 wslpi_tm(:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:) 100 wslpj_tm(:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:) 101 ENDIF 101 102 # if defined key_trabbl 102 103 IF( nn_bbl_ldf == 1 ) THEN … … 131 132 avs_temp (:,:,:) = avs (:,:,:) 132 133 # endif 133 #if defined key_ldfslp 134 wslpi_temp (:,:,:) = wslpi (:,:,:) 135 wslpj_temp (:,:,:) = wslpj (:,:,:) 136 uslp_temp (:,:,:) = uslp (:,:,:) 137 vslp_temp (:,:,:) = vslp (:,:,:) 138 #endif 134 IF( l_ldfslp ) THEN 135 uslp_temp (:,:,:) = uslp (:,:,:) ; wslpi_temp (:,:,:) = wslpi (:,:,:) 136 vslp_temp (:,:,:) = vslp (:,:,:) ; wslpj_temp (:,:,:) = wslpj (:,:,:) 137 ENDIF 139 138 # if defined key_trabbl 140 139 IF( nn_bbl_ldf == 1 ) THEN … … 160 159 wndm_temp (:,:) = wndm (:,:) 161 160 ! ! Variables reset in trc_sub_ssh 162 rotn_temp (:,:,:) = rotn (:,:,:)163 161 hdivn_temp (:,:,:) = hdivn (:,:,:) 164 rotb_temp (:,:,:) = rotb (:,:,:)165 hdivb_temp (:,:,:) = hdivb (:,:,:)166 162 ! 167 163 ! 2. Create averages and reassign variables 168 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)169 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)170 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)171 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)172 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)173 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)174 # if defined key_zdfddm 175 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)176 # endif 177 #if defined key_ldfslp 178 wslpi_tm (:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:)179 wslpj_tm (:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:)180 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp(:,:,:)181 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:)182 #endif 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(:,:,:) 172 # endif 173 IF( l_ldfslp ) THEN 174 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:) 175 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:) 176 wslpi_tm (:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:) 177 wslpj_tm (:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:) 178 ENDIF 183 179 # if defined key_trabbl 184 180 IF( nn_bbl_ldf == 1 ) THEN … … 245 241 DO jj = 1, jpj 246 242 DO ji = 1, jpi 247 z1_ne3t = r1_ndttrcp1 / fse3t(ji,jj,jk)248 z1_ne3u = r1_ndttrcp1 / fse3u(ji,jj,jk)249 z1_ne3v = r1_ndttrcp1 / fse3v(ji,jj,jk)250 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) 251 247 ! 252 248 un (ji,jj,jk) = un_tm (ji,jj,jk) * z1_ne3u … … 255 251 tsn (ji,jj,jk,jp_sal) = tsn_tm (ji,jj,jk,jp_sal) * z1_ne3t 256 252 rhop (ji,jj,jk) = rhop_tm (ji,jj,jk) * z1_ne3t 253 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 257 254 avt (ji,jj,jk) = avt_tm (ji,jj,jk) * z1_ne3w 258 255 # if defined key_zdfddm 259 256 avs (ji,jj,jk) = avs_tm (ji,jj,jk) * z1_ne3w 260 257 # endif 261 #if defined key_ldfslp 262 wslpi(ji,jj,jk) = wslpi_tm(ji,jj,jk)263 wslpj(ji,jj,jk) = wslpj_tm(ji,jj,jk)264 uslp (ji,jj,jk) = uslp_tm (ji,jj,jk)265 vslp (ji,jj,jk) = vslp_tm (ji,jj,jk)266 #endif 267 ENDDO268 ENDDO269 END DO258 END DO 259 END DO 260 END DO 261 IF( l_ldfslp ) THEN 262 wslpi(:,:,:) = wslpi_tm(:,:,:) 263 wslpj(:,:,:) = wslpj_tm(:,:,:) 264 uslp (:,:,:) = uslp_tm (:,:,:) 265 vslp (:,:,:) = vslp_tm (:,:,:) 266 ENDIF 270 267 ! 271 268 CALL trc_sub_ssh( kt ) ! after ssh & vertical velocity … … 276 273 ! 277 274 END SUBROUTINE trc_sub_stp 275 278 276 279 277 SUBROUTINE trc_sub_ini … … 299 297 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' ) 300 298 301 un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:) 302 vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:) 303 tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:) 304 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:) 305 rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:) 306 avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:) 307 # if defined key_zdfddm 308 avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:) 309 # endif 310 #if defined key_ldfslp 311 wslpi_tm(:,:,:) = wslpi(:,:,:) 312 wslpj_tm(:,:,:) = wslpj(:,:,:) 313 uslp_tm (:,:,:) = uslp (:,:,:) 314 vslp_tm (:,:,:) = vslp (:,:,:) 315 #endif 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(:,:,:) 304 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 305 avt_tm (:,:,:) = avt (:,:,:) * e3w_n(:,:,:) 306 # if defined key_zdfddm 307 avs_tm (:,:,:) = avs (:,:,:) * e3w_n(:,:,:) 308 # endif 309 IF( l_ldfslp ) THEN 310 wslpi_tm(:,:,:) = wslpi(:,:,:) 311 wslpj_tm(:,:,:) = wslpj(:,:,:) 312 uslp_tm (:,:,:) = uslp (:,:,:) 313 vslp_tm (:,:,:) = vslp (:,:,:) 314 ENDIF 316 315 sshn_tm (:,:) = sshn (:,:) 317 316 rnf_tm (:,:) = rnf (:,:) … … 365 364 avs (:,:,:) = avs_temp (:,:,:) 366 365 # endif 367 #if defined key_ldfslp 368 wslpi (:,:,:)= wslpi_temp (:,:,:)369 wslpj (:,:,:)= wslpj_temp (:,:,:)370 uslp (:,:,:)= uslp_temp (:,:,:)371 vslp (:,:,:)= vslp_temp (:,:,:)372 #endif 366 IF( l_ldfslp ) THEN 367 wslpi (:,:,:)= wslpi_temp (:,:,:) 368 wslpj (:,:,:)= wslpj_temp (:,:,:) 369 uslp (:,:,:)= uslp_temp (:,:,:) 370 vslp (:,:,:)= vslp_temp (:,:,:) 371 ENDIF 373 372 sshn (:,:) = sshn_temp (:,:) 374 373 sshb (:,:) = sshb_temp (:,:) … … 396 395 ! 397 396 hdivn (:,:,:) = hdivn_temp (:,:,:) 398 rotn (:,:,:) = rotn_temp (:,:,:)399 hdivb (:,:,:) = hdivb_temp (:,:,:)400 rotb (:,:,:) = rotb_temp (:,:,:)401 397 ! 402 403 398 ! Start new averages 404 un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:) 405 vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:) 406 tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:) 407 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:) 408 rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:) 409 avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:) 410 # if defined key_zdfddm 411 avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:) 412 # endif 413 #if defined key_ldfslp 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(:,:,:) 407 # endif 408 IF( l_ldfslp ) THEN 409 uslp_tm (:,:,:) = uslp (:,:,:) 410 vslp_tm (:,:,:) = vslp (:,:,:) 414 411 wslpi_tm(:,:,:) = wslpi(:,:,:) 415 412 wslpj_tm(:,:,:) = wslpj(:,:,:) 416 uslp_tm (:,:,:) = uslp (:,:,:) 417 vslp_tm (:,:,:) = vslp (:,:,:) 418 #endif 413 ENDIF 419 414 ! 420 415 sshb_hold (:,:) = sshn (:,:) … … 451 446 !! 452 447 !! ** Purpose : compute the after ssh (ssha), the now vertical velocity 453 !! and update the now vertical coordinate (l k_vvl=T).448 !! and update the now vertical coordinate (ln_linssh=F). 454 449 !! 455 450 !! ** Method : - Using the incompressibility hypothesis, the vertical … … 460 455 !! ** action : ssha : after sea surface height 461 456 !! wn : now vertical velocity 462 !! 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) 463 458 !! 464 459 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. 465 460 !!---------------------------------------------------------------------- 466 !467 461 INTEGER, INTENT(in) :: kt ! time step 468 462 ! … … 475 469 ! 476 470 ! Allocate temporary workspace 477 CALL wrk_alloc( jpi, jpj,zhdiv )471 CALL wrk_alloc( jpi,jpj, zhdiv ) 478 472 479 473 IF( kt == nittrc000 ) THEN … … 487 481 ENDIF 488 482 ! 489 CALL div_cur( kt ) ! Horizontal divergence & Relative vorticity 483 !!gm BUG here ! hdivn will include the runoff divergence at the wrong timestep !!!! 484 CALL div_hor( kt ) ! Horizontal divergence & Relative vorticity 490 485 ! 491 486 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) … … 497 492 zhdiv(:,:) = 0._wp 498 493 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 499 zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)494 zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 500 495 END DO 501 496 ! ! Sea surface elevation time stepping … … 515 510 #endif 516 511 #endif 517 518 512 ! 519 513 ! !------------------------------! 520 514 ! ! Now Vertical Velocity ! … … 522 516 z1_2dt = 1.e0 / z2dt 523 517 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 524 ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise525 wn(:,:,jk) = wn(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) &526 & - ( 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) ) & 527 521 & * tmask(:,:,jk) * z1_2dt 528 522 #if defined key_bdy … … 530 524 #endif 531 525 END DO 532 533 ! 534 CALL wrk_dealloc( jpi, jpj, zhdiv ) 526 ! 527 CALL wrk_dealloc( jpi,jpj, zhdiv ) 535 528 ! 536 529 IF( nn_timing == 1 ) CALL timing_stop('trc_sub_ssh') 537 530 ! 538 531 END SUBROUTINE trc_sub_ssh 532 539 533 540 534 INTEGER FUNCTION trc_sub_alloc() … … 551 545 & sshn_temp(jpi,jpj) , sshb_temp(jpi,jpj) , & 552 546 & ssha_temp(jpi,jpj) , & 553 #if defined key_ldfslp554 & wslpi_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), &555 & uslp_temp(jpi,jpj,jpk) , vslp_temp(jpi,jpj,jpk), &556 #endif557 547 #if defined key_trabbl 558 548 & ahu_bbl_temp(jpi,jpj) , ahv_bbl_temp(jpi,jpj), & … … 569 559 # endif 570 560 & hdivn_temp(jpi,jpj,jpk) , hdivb_temp(jpi,jpj,jpk), & 571 & rotn_temp(jpi,jpj,jpk) , rotb_temp(jpi,jpj,jpk), &572 561 & un_tm(jpi,jpj,jpk) , vn_tm(jpi,jpj,jpk) , & 573 562 & avt_tm(jpi,jpj,jpk) , & … … 577 566 & emp_b_hold(jpi,jpj) , & 578 567 & hmld_tm(jpi,jpj) , qsr_tm(jpi,jpj) , & 579 #if defined key_ldfslp580 & wslpi_tm(jpi,jpj,jpk) , wslpj_tm(jpi,jpj,jpk), &581 & uslp_tm(jpi,jpj,jpk) , vslp_tm(jpi,jpj,jpk), &582 #endif583 568 #if defined key_trabbl 584 569 & ahu_bbl_tm(jpi,jpj) , ahv_bbl_tm(jpi,jpj), & 585 570 & utr_bbl_tm(jpi,jpj) , vtr_bbl_tm(jpi,jpj), & 586 571 #endif 587 & rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , &588 & STAT=trc_sub_alloc )572 & rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc ) 573 ! 589 574 IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate arrays') 590 575 ! 576 IF( l_ldfslp ) THEN 577 ALLOCATE( uslp_temp(jpi,jpj,jpk) , wslpi_temp(jpi,jpj,jpk), & 578 & vslp_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), & 579 & uslp_tm (jpi,jpj,jpk) , wslpi_tm (jpi,jpj,jpk), & 580 & vslp_tm (jpi,jpj,jpk) , wslpj_tm (jpi,jpj,jpk), STAT=trc_sub_alloc ) 581 ENDIF 582 ! 583 IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays') 591 584 ! 592 585 END FUNCTION trc_sub_alloc … … 603 596 WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt 604 597 END SUBROUTINE trc_sub_ini 605 606 598 #endif 607 599 -
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r3750 r6225 26 26 27 27 PUBLIC trc_wri 28 29 !! * Substitutions30 # include "top_substitute.h90"31 28 32 29 CONTAINS
Note: See TracChangeset
for help on using the changeset viewer.
