Changeset 12377 for NEMO/trunk/src/TOP/TRP
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 1 deleted
- 13 edited
- 1 copied
-
. (modified) (1 prop)
-
src/TOP/TRP/trcadv.F90 (modified) (6 diffs)
-
src/TOP/TRP/trcatf.F90 (copied) (copied from NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcatf.F90)
-
src/TOP/TRP/trcbbl.F90 (modified) (7 diffs)
-
src/TOP/TRP/trcdmp.F90 (modified) (10 diffs)
-
src/TOP/TRP/trcldf.F90 (modified) (7 diffs)
-
src/TOP/TRP/trcnxt.F90 (deleted)
-
src/TOP/TRP/trcrad.F90 (modified) (8 diffs)
-
src/TOP/TRP/trcsbc.F90 (modified) (11 diffs)
-
src/TOP/TRP/trcsink.F90 (modified) (10 diffs)
-
src/TOP/TRP/trctrp.F90 (modified) (4 diffs)
-
src/TOP/TRP/trczdf.F90 (modified) (3 diffs)
-
src/TOP/TRP/trdmxl_trc.F90 (modified) (14 diffs)
-
src/TOP/TRP/trdmxl_trc_rst.F90 (modified) (2 diffs)
-
src/TOP/TRP/trdtrc.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEAD ext/AGRIF5 ^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL
-
- Property svn:externals
-
NEMO/trunk/src/TOP/TRP/trcadv.F90
r11536 r12377 59 59 INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme 60 60 61 !! * Substitutions62 # include "vectopt_loop_substitute.h90"63 61 !!---------------------------------------------------------------------- 64 62 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 68 66 CONTAINS 69 67 70 SUBROUTINE trc_adv( kt )68 SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs ) 71 69 !!---------------------------------------------------------------------- 72 70 !! *** ROUTINE trc_adv *** … … 74 72 !! ** Purpose : compute the ocean tracer advection trend. 75 73 !! 76 !! ** Method : - Update after tracers (tra) with the advection term following nadv 77 !!---------------------------------------------------------------------- 78 INTEGER, INTENT(in) :: kt ! ocean time-step index 74 !! ** Method : - Update after tracers (tr(Krhs)) with the advection term following nadv 75 !!---------------------------------------------------------------------- 76 INTEGER , INTENT(in) :: kt ! ocean time-step index 77 INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 78 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 79 79 ! 80 80 INTEGER :: jk ! dummy loop index 81 81 CHARACTER (len=22) :: charout 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zu n, zvn, zwn! effective velocity82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuu, zvv, zww ! effective velocity 83 83 !!---------------------------------------------------------------------- 84 84 ! … … 87 87 ! !== effective transport ==! 88 88 IF( l_offline ) THEN 89 zu n(:,:,:) = un(:,:,:) ! already in (un,vn,wn)90 zv n(:,:,:) = vn(:,:,:)91 zw n(:,:,:) = wn(:,:,:)89 zuu(:,:,:) = uu(:,:,:,Kmm) ! already in (uu(Kmm),vv(Kmm),ww) 90 zvv(:,:,:) = vv(:,:,:,Kmm) 91 zww(:,:,:) = ww(:,:,:) 92 92 ELSE ! build the effective transport 93 zu n(:,:,jpk) = 0._wp94 zv n(:,:,jpk) = 0._wp95 zw n(:,:,jpk) = 0._wp93 zuu(:,:,jpk) = 0._wp 94 zvv(:,:,jpk) = 0._wp 95 zww(:,:,jpk) = 0._wp 96 96 IF( ln_wave .AND. ln_sdw ) THEN 97 97 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift 98 zu n(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) )99 zv n(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) )100 zw n(:,:,jk) = e1e2t(:,:) * ( wn(:,:,jk) + wsd(:,:,jk) )98 zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 99 zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 100 zww(:,:,jk) = e1e2t(:,:) * ( ww(:,:,jk) + wsd(:,:,jk) ) 101 101 END DO 102 102 ELSE 103 103 DO jk = 1, jpkm1 104 zu n(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport105 zv n(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)106 zw n(:,:,jk) = e1e2t(:,:) * wn(:,:,jk)104 zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm) ! eulerian transport 105 zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm) 106 zww(:,:,jk) = e1e2t(:,:) * ww(:,:,jk) 107 107 END DO 108 108 ENDIF 109 109 ! 110 110 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 111 zu n(:,:,:) = zun(:,:,:) + un_td(:,:,:)112 zv n(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)111 zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:) 112 zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:) 113 113 ENDIF 114 114 ! 115 115 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 116 & CALL ldf_eiv_trp( kt, nittrc000, zu n, zvn, zwn, 'TRC') ! add the eiv transport117 ! 118 IF( ln_mle ) CALL tra_mle_trp( kt, nittrc000, zu n, zvn, zwn, 'TRC') ! add the mle transport116 & CALL ldf_eiv_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm, Krhs ) ! add the eiv transport 117 ! 118 IF( ln_mle ) CALL tra_mle_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm ) ! add the mle transport 119 119 ! 120 120 ENDIF … … 123 123 ! 124 124 CASE ( np_CEN ) ! Centered : 2nd / 4th order 125 CALL tra_adv_cen( kt, nittrc000,'TRC', zu n, zvn, zwn , trn, tra, jptra, nn_cen_h, nn_cen_v )125 CALL tra_adv_cen( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 126 126 CASE ( np_FCT ) ! FCT : 2nd / 4th order 127 CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zu n, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )127 CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 128 128 CASE ( np_MUS ) ! MUSCL 129 CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zu n, zvn, zwn, trb, tra, jptra , ln_mus_ups)129 CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) 130 130 CASE ( np_UBS ) ! UBS 131 CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zu n, zvn, zwn, trb, trn, tra, jptra , nn_ubs_v)131 CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v ) 132 132 CASE ( np_QCK ) ! QUICKEST 133 CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zu n, zvn, zwn, trb, trn, tra, jptra)133 CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs ) 134 134 ! 135 135 END SELECT 136 136 ! 137 IF( ln_ctl ) THEN!== print mean trends (used for debugging)137 IF( sn_cfctl%l_prttrc ) THEN !== print mean trends (used for debugging) 138 138 WRITE(charout, FMT="('adv ')") 139 139 CALL prt_ctl_trc_info(charout) 140 CALL prt_ctl_trc( tab4d=tr a, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )140 CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 141 141 END IF 142 142 ! … … 164 164 ! 165 165 ! !== Namelist ==! 166 REWIND( numnat_ref ) ! namtrc_adv in reference namelist167 166 READ ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 168 167 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist' ) 169 REWIND( numnat_cfg ) ! namtrc_adv in configuration namelist170 168 READ ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 171 169 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist' ) -
NEMO/trunk/src/TOP/TRP/trcbbl.F90
r10068 r12377 20 20 !! trc_bbl : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 21 21 !!---------------------------------------------------------------------- 22 USE oce_trc ! ocean dynamics and active tracers variables22 USE oce_trc ! ocean dynamics and passive tracers variables 23 23 USE trc ! ocean passive tracers variables 24 24 USE trd_oce ! trends: ocean variables … … 36 36 CONTAINS 37 37 38 SUBROUTINE trc_bbl( kt )38 SUBROUTINE trc_bbl( kt, Kbb, Kmm, ptr, Krhs ) 39 39 !!---------------------------------------------------------------------- 40 40 !! *** ROUTINE bbl *** … … 45 45 !! 46 46 !!---------------------------------------------------------------------- 47 INTEGER, INTENT( in ) :: kt ! ocean time-step 47 INTEGER, INTENT( in ) :: kt ! ocean time-step 48 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level indices 49 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 48 50 INTEGER :: jn ! loop index 49 51 CHARACTER (len=22) :: charout … … 53 55 IF( ln_timing ) CALL timing_start('trc_bbl') 54 56 ! 55 IF( .NOT. l_offline .AND. nn_dttrc == 1) THEN56 CALL bbl( kt, nittrc000, 'TRC' )! Online coupling with dynamics : Computation of bbl coef and bbl transport57 l_bbl = .FALSE. ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files57 IF( .NOT. l_offline ) THEN 58 CALL bbl( kt, nittrc000, 'TRC', Kbb, Kmm ) ! Online coupling with dynamics : Computation of bbl coef and bbl transport 59 l_bbl = .FALSE. ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 58 60 ENDIF 59 61 60 62 IF( l_trdtrc ) THEN 61 63 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends 62 ztrtrd(:,:,:,:) = tra(:,:,:,:)64 ztrtrd(:,:,:,:) = ptr(:,:,:,:,Krhs) 63 65 ENDIF 64 66 … … 66 68 IF( nn_bbl_ldf == 1 ) THEN 67 69 ! 68 CALL tra_bbl_dif( trb, tra, jptra)69 IF( ln_ctl) THEN70 CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 71 IF( sn_cfctl%l_prttrc ) THEN 70 72 WRITE(charout, FMT="(' bbl_dif')") ; CALL prt_ctl_trc_info(charout) 71 CALL prt_ctl_trc( tab4d= tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )73 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 72 74 ENDIF 73 75 ! … … 77 79 IF( nn_bbl_adv /= 0 ) THEN 78 80 ! 79 CALL tra_bbl_adv( trb, tra, jptra)80 IF( ln_ctl) THEN81 CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 82 IF( sn_cfctl%l_prttrc ) THEN 81 83 WRITE(charout, FMT="(' bbl_adv')") ; CALL prt_ctl_trc_info(charout) 82 CALL prt_ctl_trc( tab4d= tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )84 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 83 85 ENDIF 84 86 ! … … 87 89 IF( l_trdtrc ) THEN ! save the horizontal diffusive trends for further diagnostics 88 90 DO jn = 1, jptra 89 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)90 CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) )91 ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 92 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 91 93 END DO 92 94 DEALLOCATE( ztrtrd ) ! temporary save of trends -
NEMO/trunk/src/TOP/TRP/trcdmp.F90
r11536 r12377 44 44 45 45 !! * Substitutions 46 # include " vectopt_loop_substitute.h90"46 # include "do_loop_substitute.h90" 47 47 !!---------------------------------------------------------------------- 48 48 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 63 63 64 64 65 SUBROUTINE trc_dmp( kt )65 SUBROUTINE trc_dmp( kt, Kbb, Kmm, ptr, Krhs ) 66 66 !!---------------------------------------------------------------------- 67 67 !! *** ROUTINE trc_dmp *** … … 73 73 !! ** Method : Newtonian damping towards trdta computed 74 74 !! and add to the general tracer trends: 75 !! tr n = tra + restotr * (trdta - trb)75 !! tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb)) 76 76 !! The trend is computed either throughout the water column 77 77 !! (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or 78 78 !! below the well mixed layer (nlmdmptr=2) 79 79 !! 80 !! ** Action : - update the tracer trends tr awith the newtonian80 !! ** Action : - update the tracer trends tr(:,:,:,:,Krhs) with the newtonian 81 81 !! damping trends. 82 82 !! - save the trends ('key_trdmxl_trc') 83 83 !!---------------------------------------------------------------------- 84 INTEGER, INTENT(in) :: kt ! ocean time-step index 84 INTEGER, INTENT(in ) :: kt ! ocean time-step index 85 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices 86 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 85 87 ! 86 88 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices … … 100 102 DO jn = 1, jptra ! tracer loop 101 103 ! ! =========== 102 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends104 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends 103 105 ! 104 106 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 105 107 ! 106 108 jl = n_trc_index(jn) 107 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000109 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 108 110 ! 109 111 SELECT CASE ( nn_zdmp_tr ) 110 112 ! 111 113 CASE( 0 ) !== newtonian damping throughout the water column ==! 112 DO jk = 1, jpkm1 113 DO jj = 2, jpjm1 114 DO ji = fs_2, fs_jpim1 ! vector opt. 115 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 116 END DO 117 END DO 118 END DO 114 DO_3D_00_00( 1, jpkm1 ) 115 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 116 END_3D 119 117 ! 120 118 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==! 121 DO jk = 1, jpkm1 122 DO jj = 2, jpjm1 123 DO ji = fs_2, fs_jpim1 ! vector opt. 124 IF( avt(ji,jj,jk) <= avt_c ) 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) ) 126 ENDIF 127 END DO 128 END DO 129 END DO 119 DO_3D_00_00( 1, jpkm1 ) 120 IF( avt(ji,jj,jk) <= avt_c ) THEN 121 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 122 ENDIF 123 END_3D 130 124 ! 131 125 CASE ( 2 ) !== no damping in the mixed layer ==! 132 DO jk = 1, jpkm1 133 DO jj = 2, jpjm1 134 DO ji = fs_2, fs_jpim1 ! vector opt. 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) ) 137 END IF 138 END DO 139 END DO 140 END DO 126 DO_3D_00_00( 1, jpkm1 ) 127 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 128 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 129 END IF 130 END_3D 141 131 ! 142 132 END SELECT … … 145 135 ! 146 136 IF( l_trdtrc ) THEN 147 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)148 CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd )137 ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:) 138 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_dmp, ztrtrd ) 149 139 END IF 150 140 ! ! =========== … … 156 146 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 157 147 ! ! print mean trends (used for debugging) 158 IF( ln_ctl) THEN148 IF( sn_cfctl%l_prttrc ) THEN 159 149 WRITE(charout, FMT="('dmp ')") 160 150 CALL prt_ctl_trc_info(charout) 161 CALL prt_ctl_trc( tab4d= tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )151 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 162 152 ENDIF 163 153 ! … … 181 171 !!---------------------------------------------------------------------- 182 172 ! 183 REWIND( numnat_ref ) ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping184 173 READ ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 185 174 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist' ) 186 REWIND( numnat_cfg ) ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping187 175 READ ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 188 176 910 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist' ) … … 224 212 225 213 226 SUBROUTINE trc_dmp_clo( kt )214 SUBROUTINE trc_dmp_clo( kt, Kbb, Kmm ) 227 215 !!--------------------------------------------------------------------- 228 216 !! *** ROUTINE trc_dmp_clo *** … … 236 224 !! nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 237 225 !!---------------------------------------------------------------------- 238 INTEGER, INTENT( in ) :: kt ! ocean time-step index 226 INTEGER, INTENT( in ) :: kt ! ocean time-step index 227 INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices 239 228 ! 240 229 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa … … 354 343 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 355 344 jl = n_trc_index(jn) 356 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000345 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 357 346 DO jc = 1, npncts 358 347 DO jk = 1, jpkm1 359 348 DO jj = nctsj1(jc), nctsj2(jc) 360 349 DO ji = nctsi1(jc), nctsi2(jc) 361 tr n(ji,jj,jk,jn) = ztrcdta(ji,jj,jk)362 tr b(ji,jj,jk,jn) = trn(ji,jj,jk,jn)350 tr(ji,jj,jk,jn,Kmm) = ztrcdta(ji,jj,jk) 351 tr(ji,jj,jk,jn,Kbb) = tr(ji,jj,jk,jn,Kmm) 363 352 END DO 364 353 END DO -
NEMO/trunk/src/TOP/TRP/trcldf.F90
r11536 r12377 43 43 44 44 !! * Substitutions 45 # include " vectopt_loop_substitute.h90"45 # include "do_loop_substitute.h90" 46 46 !!---------------------------------------------------------------------- 47 47 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 51 51 CONTAINS 52 52 53 SUBROUTINE trc_ldf( kt )53 SUBROUTINE trc_ldf( kt, Kbb, Kmm, ptr, Krhs ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE tra_ldf *** … … 58 58 !! 59 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 60 INTEGER, INTENT(in ) :: kt ! ocean time-step index 61 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time-level index 62 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 61 63 ! 62 64 INTEGER :: ji, jj, jk, jn 63 65 REAL(wp) :: zdep 64 66 CHARACTER (len=22) :: charout 65 REAL(wp), DIMENSION(jpi,jpj,jpk):: zahu, zahv66 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd67 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zahu, zahv 68 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd 67 69 !!---------------------------------------------------------------------- 68 70 ! … … 73 75 IF( l_trdtrc ) THEN 74 76 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) 75 ztrtrd(:,:,:,:) = tra(:,:,:,:)77 ztrtrd(:,:,:,:) = ptr(:,:,:,:,Krhs) 76 78 ENDIF 77 79 ! !* set the lateral diffusivity coef. for passive tracer … … 79 81 zahv(:,:,:) = rldf * ahtv(:,:,:) 80 82 ! !* Enhanced zonal diffusivity coefficent in the equatorial domain 81 DO jk= 1, jpk 82 DO jj = 1, jpj 83 DO ji = 1, jpi 84 IF( gdept_n(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 85 zdep = MAX( gdept_n(ji,jj,jk) - 1000., 0. ) / 1000. 86 zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) ) 87 ENDIF 88 END DO 89 END DO 90 END DO 83 DO_3D_11_11( 1, jpk ) 84 IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 85 zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000. 86 zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) ) 87 ENDIF 88 END_3D 91 89 ! 92 90 SELECT CASE ( nldf_trc ) !* compute lateral mixing trend and add it to the general trend 93 91 ! 94 CASE ( np_lap ) ! iso-level laplacian 95 CALL tra_ldf_lap ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, 1 ) 96 CASE ( np_lap_i ) ! laplacian : standard iso-neutral operator (Madec) 97 CALL tra_ldf_iso ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 ) 98 CASE ( np_lap_it ) ! laplacian : triad iso-neutral operator (griffies) 99 CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 ) 100 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: all operator (iso-level, -neutral) 101 CALL tra_ldf_blp ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb , tra, jptra, nldf_trc ) 92 CASE ( np_lap ) ! iso-level laplacian 93 CALL tra_ldf_lap ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 94 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 95 CASE ( np_lap_i ) ! laplacian : standard iso-neutral operator (Madec) 96 CALL tra_ldf_iso ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 97 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 98 CASE ( np_lap_it ) ! laplacian : triad iso-neutral operator (griffies) 99 CALL tra_ldf_triad( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 100 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 101 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: all operator (iso-level, -neutral) 102 CALL tra_ldf_blp ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 103 & ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs), jptra, nldf_trc ) 102 104 END SELECT 103 105 ! 104 106 IF( l_trdtrc ) THEN ! send the trends for further diagnostics 105 107 DO jn = 1, jptra 106 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)107 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) )108 ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 109 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 108 110 END DO 109 111 DEALLOCATE( ztrtrd ) 110 112 ENDIF 111 113 ! 112 IF( ln_ctl ) THEN! print mean trends (used for debugging)114 IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging) 113 115 WRITE(charout, FMT="('ldf ')") 114 116 CALL prt_ctl_trc_info(charout) 115 CALL prt_ctl_trc( tab4d= tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )117 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 116 118 ENDIF 117 119 ! … … 143 145 ENDIF 144 146 ! 145 REWIND( numnat_ref ) ! namtrc_ldf in reference namelist146 147 READ ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 147 148 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist' ) 148 149 ! 149 REWIND( numnat_cfg ) ! namtrc_ldf in configuration namelist150 150 READ ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 151 151 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist' ) … … 167 167 IF( ln_trcldf_OFF ) THEN ; nldf_trc = np_no_ldf ; ioptio = ioptio + 1 ; ENDIF 168 168 IF( ln_trcldf_tra ) THEN ; nldf_trc = nldf_tra ; ioptio = ioptio + 1 ; ENDIF 169 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_ldf_ini: use ONE of the 2 operator options ( NONE/tra)' )169 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_ldf_ini: use ONE of the 2 operator options (OFF/tra)' ) 170 170 171 171 ! ! multiplier : passive/active tracers ration -
NEMO/trunk/src/TOP/TRP/trcrad.F90
r11536 r12377 6 6 !! History : - ! 01-01 (O. Aumont & E. Kestenare) Original code 7 7 !! 1.0 ! 04-03 (C. Ethe) free form F90 8 !! 4.1 ! 08-19 (A. Coward, D. Storkey) tidy up using new time-level indices 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_top … … 30 31 REAL(wp), DIMENSION(:,:), ALLOCATABLE:: gainmass 31 32 33 !! * Substitutions 34 # include "do_loop_substitute.h90" 32 35 !!---------------------------------------------------------------------- 33 36 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 37 40 CONTAINS 38 41 39 SUBROUTINE trc_rad( kt )42 SUBROUTINE trc_rad( kt, Kbb, Kmm, ptr ) 40 43 !!---------------------------------------------------------------------- 41 44 !! *** ROUTINE trc_rad *** … … 52 55 !! (the total CFC content is not strictly preserved) 53 56 !!---------------------------------------------------------------------- 54 INTEGER, INTENT(in) :: kt ! ocean time-step index 57 INTEGER, INTENT(in ) :: kt ! ocean time-step index 58 INTEGER, INTENT(in ) :: Kbb, Kmm ! time level indices 59 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 55 60 ! 56 61 CHARACTER (len=22) :: charout … … 59 64 IF( ln_timing ) CALL timing_start('trc_rad') 60 65 ! 61 IF( ln_age ) CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age ) ! AGE62 IF( ll_cfc ) CALL trc_rad_sms( kt, trb, trn, jp_cfc0, jp_cfc1 ) ! CFC model63 IF( ln_c14 ) CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14 ) ! C1464 IF( ln_pisces ) CALL trc_rad_sms( kt, trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' ) ! PISCES model65 IF( ln_my_trc ) CALL trc_rad_sms( kt, trb, trn, jp_myt0, jp_myt1 ) ! MY_TRC model66 ! 67 IF( ln_ctl) THEN ! print mean trends (used for debugging)66 IF( ln_age ) CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_age , jp_age ) ! AGE 67 IF( ll_cfc ) CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_cfc0, jp_cfc1 ) ! CFC model 68 IF( ln_c14 ) CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_c14 , jp_c14 ) ! C14 69 IF( ln_pisces ) CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_pcs0, jp_pcs1, cpreserv='Y' ) ! PISCES model 70 IF( ln_my_trc ) CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_myt0, jp_myt1 ) ! MY_TRC model 71 ! 72 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 68 73 WRITE(charout, FMT="('rad')") 69 74 CALL prt_ctl_trc_info( charout ) 70 CALL prt_ctl_trc( tab4d= trn, mask=tmask, clinfo=ctrcnm )75 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Kbb), mask=tmask, clinfo=ctrcnm ) 71 76 ENDIF 72 77 ! … … 87 92 !!---------------------------------------------------------------------- 88 93 ! 89 REWIND( numnat_ref ) ! namtrc_rad in reference namelist90 94 READ ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907) 91 95 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist' ) 92 REWIND( numnat_cfg ) ! namtrc_rad in configuration namelist93 96 READ ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 94 97 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist' ) … … 113 116 114 117 115 SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) 116 !!----------------------------------------------------------------------------- 117 !! *** ROUTINE trc_rad_sms *** 118 !! 119 !! ** Purpose : "crappy" routine to correct artificial negative 120 !! concentrations due to isopycnal scheme 121 !! 122 !! ** Method : 2 cases : 123 !! - Set negative concentrations to zero while computing 124 !! the corresponding tracer content that is added to the 125 !! tracers. Then, adjust the tracer concentration using 126 !! a multiplicative factor so that the total tracer 127 !! concentration is preserved. 128 !! - simply set to zero the negative CFC concentration 129 !! (the total content of concentration is not strictly preserved) 130 !!-------------------------------------------------------------------------------- 131 INTEGER , INTENT(in ) :: kt ! ocean time-step index 132 INTEGER , INTENT(in ) :: jp_sms0, jp_sms1 ! First & last index of the passive tracer model 133 REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT(inout) :: ptrb , ptrn ! before and now traceur concentration 134 CHARACTER( len = 1), OPTIONAL , INTENT(in ) :: cpreserv ! flag to preserve content or not 135 ! 136 INTEGER :: ji, ji2, jj, jj2, jk, jn ! dummy loop indices 137 INTEGER :: icnt 138 LOGICAL :: lldebug = .FALSE. ! local logical 139 REAL(wp):: zcoef, zs2rdt, ztotmass 140 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrneg, ztrpos 141 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrd ! workspace arrays 142 !!---------------------------------------------------------------------- 143 ! 144 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 145 zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 146 ! 147 IF( PRESENT( cpreserv ) ) THEN !== total tracer concentration is preserved ==! 148 ! 149 ALLOCATE( ztrneg(1:jpi,1:jpj,jp_sms0:jp_sms1), ztrpos(1:jpi,1:jpj,jp_sms0:jp_sms1) ) 150 151 DO jn = jp_sms0, jp_sms1 152 ztrneg(:,:,jn) = SUM( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:), dim = 3 ) ! sum of the negative values 153 ztrpos(:,:,jn) = SUM( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:), dim = 3 ) ! sum of the positive values 154 END DO 155 CALL sum3x3( ztrneg ) 156 CALL sum3x3( ztrpos ) 157 158 DO jn = jp_sms0, jp_sms1 159 ! 160 IF( l_trdtrc ) ztrtrd(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 161 ! 162 DO jk = 1, jpkm1 163 DO jj = 1, jpj 164 DO ji = 1, jpi 165 IF( ztrneg(ji,jj,jn) /= 0. ) THEN ! if negative values over the 3x3 box 166 ! 167 ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * tmask(ji,jj,jk) ! really needed? 168 IF( ptrb(ji,jj,jk,jn) < 0. ) ptrb(ji,jj,jk,jn) = 0. ! supress negative values 169 IF( ptrb(ji,jj,jk,jn) > 0. ) THEN ! use positive values to compensate mass gain 170 zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn) ! ztrpos > 0 as ptrb > 0 171 ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * zcoef 172 IF( zcoef < 0. ) THEN ! if the compensation exceed the positive value 173 gainmass(jn,1) = gainmass(jn,1) - ptrb(ji,jj,jk,jn) * cvol(ji,jj,jk) ! we are adding mass... 174 ptrb(ji,jj,jk,jn) = 0. ! limit the compensation to keep positive value 175 ENDIF 176 ENDIF 177 ! 178 ENDIF 179 END DO 180 END DO 181 END DO 182 ! 183 IF( l_trdtrc ) THEN 184 ztrtrd(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 185 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrd ) ! Asselin-like trend handling 186 ENDIF 187 ! 188 END DO 189 190 IF( kt == nitend ) THEN 191 CALL mpp_sum( 'trcrad', gainmass(:,1) ) 192 DO jn = jp_sms0, jp_sms1 193 IF( gainmass(jn,1) > 0. ) THEN 194 ztotmass = glob_sum( 'trcrad', ptrb(:,:,:,jn) * cvol(:,:,:) ) 195 IF(lwp) WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrb, traceur ', jn & 196 & , ' total mass : ', ztotmass, ', mass gain : ', gainmass(jn,1) 197 END IF 198 END DO 199 ENDIF 200 201 DO jn = jp_sms0, jp_sms1 202 ztrneg(:,:,jn) = SUM( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:), dim = 3 ) ! sum of the negative values 203 ztrpos(:,:,jn) = SUM( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:), dim = 3 ) ! sum of the positive values 204 END DO 205 CALL sum3x3( ztrneg ) 206 CALL sum3x3( ztrpos ) 207 208 DO jn = jp_sms0, jp_sms1 209 ! 210 IF( l_trdtrc ) ztrtrd(:,:,:) = ptrn(:,:,:,jn) ! save input trb for trend computation 211 ! 212 DO jk = 1, jpkm1 213 DO jj = 1, jpj 214 DO ji = 1, jpi 215 IF( ztrneg(ji,jj,jn) /= 0. ) THEN ! if negative values over the 3x3 box 216 ! 217 ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * tmask(ji,jj,jk) ! really needed? 218 IF( ptrn(ji,jj,jk,jn) < 0. ) ptrn(ji,jj,jk,jn) = 0. ! supress negative values 219 IF( ptrn(ji,jj,jk,jn) > 0. ) THEN ! use positive values to compensate mass gain 220 zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn) ! ztrpos > 0 as ptrb > 0 221 ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * zcoef 222 IF( zcoef < 0. ) THEN ! if the compensation exceed the positive value 223 gainmass(jn,2) = gainmass(jn,2) - ptrn(ji,jj,jk,jn) * cvol(ji,jj,jk) ! we are adding mass... 224 ptrn(ji,jj,jk,jn) = 0. ! limit the compensation to keep positive value 225 ENDIF 226 ENDIF 227 ! 228 ENDIF 229 END DO 230 END DO 231 END DO 232 ! 233 IF( l_trdtrc ) THEN 234 ztrtrd(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 235 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrd ) ! standard trend handling 236 ENDIF 237 ! 238 END DO 239 240 IF( kt == nitend ) THEN 241 CALL mpp_sum( 'trcrad', gainmass(:,2) ) 242 DO jn = jp_sms0, jp_sms1 243 IF( gainmass(jn,2) > 0. ) THEN 244 ztotmass = glob_sum( 'trcrad', ptrn(:,:,:,jn) * cvol(:,:,:) ) 245 WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrn, traceur ', jn & 246 & , ' total mass : ', ztotmass, ', mass gain : ', gainmass(jn,1) 247 END IF 248 END DO 249 ENDIF 250 251 DEALLOCATE( ztrneg, ztrpos ) 252 ! 253 ELSE !== total CFC content is NOT strictly preserved ==! 254 ! 255 DO jn = jp_sms0, jp_sms1 256 ! 257 IF( l_trdtrc ) ztrtrd(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 258 ! 259 WHERE( ptrb(:,:,:,jn) < 0. ) ptrb(:,:,:,jn) = 0. 260 ! 261 IF( l_trdtrc ) THEN 262 ztrtrd(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 263 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrd ) ! Asselin-like trend handling 264 ENDIF 265 ! 266 IF( l_trdtrc ) ztrtrd(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 267 ! 268 WHERE( ptrn(:,:,:,jn) < 0. ) ptrn(:,:,:,jn) = 0. 269 ! 270 IF( l_trdtrc ) THEN 271 ztrtrd(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 272 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrd ) ! standard trend handling 273 ENDIF 274 ! 275 END DO 276 ! 277 ENDIF 118 SUBROUTINE trc_rad_sms( kt, Kbb, Kmm, ptr, jp_sms0, jp_sms1, cpreserv ) 119 !!----------------------------------------------------------------------------- 120 !! *** ROUTINE trc_rad_sms *** 121 !! 122 !! ** Purpose : "crappy" routine to correct artificial negative 123 !! concentrations due to isopycnal scheme 124 !! 125 !! ** Method : 2 cases : 126 !! - Set negative concentrations to zero while computing 127 !! the corresponding tracer content that is added to the 128 !! tracers. Then, adjust the tracer concentration using 129 !! a multiplicative factor so that the total tracer 130 !! concentration is preserved. 131 !! - simply set to zero the negative CFC concentration 132 !! (the total content of concentration is not strictly preserved) 133 !!-------------------------------------------------------------------------------- 134 INTEGER , INTENT(in ) :: kt ! ocean time-step index 135 INTEGER , INTENT(in ) :: Kbb, Kmm ! time level indices 136 INTEGER , INTENT(in ) :: jp_sms0, jp_sms1 ! First & last index of the passive tracer model 137 REAL(wp), DIMENSION (jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! before and now traceur concentration 138 CHARACTER( len = 1), OPTIONAL , INTENT(in ) :: cpreserv ! flag to preserve content or not 139 ! 140 INTEGER :: ji, ji2, jj, jj2, jk, jn, jt ! dummy loop indices 141 INTEGER :: icnt, itime 142 LOGICAL :: lldebug = .FALSE. ! local logical 143 REAL(wp):: zcoef, zs2rdt, ztotmass 144 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrneg, ztrpos 145 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrd ! workspace arrays 146 !!---------------------------------------------------------------------- 147 ! 148 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 149 zs2rdt = 1. / ( 2. * rdt ) 150 ! 151 DO jt = 1,2 ! Loop over time indices since exactly the same fix is applied to "now" and "after" fields 152 IF( jt == 1 ) itime = Kbb 153 IF( jt == 2 ) itime = Kmm 154 155 IF( PRESENT( cpreserv ) ) THEN !== total tracer concentration is preserved ==! 156 ! 157 ALLOCATE( ztrneg(1:jpi,1:jpj,jp_sms0:jp_sms1), ztrpos(1:jpi,1:jpj,jp_sms0:jp_sms1) ) 158 159 DO jn = jp_sms0, jp_sms1 160 ztrneg(:,:,jn) = SUM( MIN( 0., ptr(:,:,:,jn,itime) ) * cvol(:,:,:), dim = 3 ) ! sum of the negative values 161 ztrpos(:,:,jn) = SUM( MAX( 0., ptr(:,:,:,jn,itime) ) * cvol(:,:,:), dim = 3 ) ! sum of the positive values 162 END DO 163 CALL sum3x3( ztrneg ) 164 CALL sum3x3( ztrpos ) 165 166 DO jn = jp_sms0, jp_sms1 167 ! 168 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,itime) ! save input tr(:,:,:,:,Kbb) for trend computation 169 ! 170 DO_3D_11_11( 1, jpkm1 ) 171 IF( ztrneg(ji,jj,jn) /= 0. ) THEN ! if negative values over the 3x3 box 172 ! 173 ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * tmask(ji,jj,jk) ! really needed? 174 IF( ptr(ji,jj,jk,jn,itime) < 0. ) ptr(ji,jj,jk,jn,itime) = 0. ! suppress negative values 175 IF( ptr(ji,jj,jk,jn,itime) > 0. ) THEN ! use positive values to compensate mass gain 176 zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn) ! ztrpos > 0 as ptr > 0 177 ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * zcoef 178 IF( zcoef < 0. ) THEN ! if the compensation exceed the positive value 179 gainmass(jn,1) = gainmass(jn,1) - ptr(ji,jj,jk,jn,itime) * cvol(ji,jj,jk) ! we are adding mass... 180 ptr(ji,jj,jk,jn,itime) = 0. ! limit the compensation to keep positive value 181 ENDIF 182 ENDIF 183 ! 184 ENDIF 185 END_3D 186 ! 187 IF( l_trdtrc ) THEN 188 ztrtrd(:,:,:) = ( ptr(:,:,:,jn,itime) - ztrtrd(:,:,:) ) * zs2rdt 189 CALL trd_tra( kt, Kbb, Kmm, 'TRC', jn, jptra_radb, ztrtrd ) ! Asselin-like trend handling 190 ENDIF 191 ! 192 END DO 193 194 IF( kt == nitend ) THEN 195 CALL mpp_sum( 'trcrad', gainmass(:,1) ) 196 DO jn = jp_sms0, jp_sms1 197 IF( gainmass(jn,1) > 0. ) THEN 198 ztotmass = glob_sum( 'trcrad', ptr(:,:,:,jn,itime) * cvol(:,:,:) ) 199 IF(lwp) WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrb, traceur ', jn & 200 & , ' total mass : ', ztotmass, ', mass gain : ', gainmass(jn,1) 201 END IF 202 END DO 203 ENDIF 204 205 DEALLOCATE( ztrneg, ztrpos ) 206 ! 207 ELSE !== total CFC content is NOT strictly preserved ==! 208 ! 209 DO jn = jp_sms0, jp_sms1 210 ! 211 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,itime) ! save input tr for trend computation 212 ! 213 WHERE( ptr(:,:,:,jn,itime) < 0. ) ptr(:,:,:,jn,itime) = 0. 214 ! 215 IF( l_trdtrc ) THEN 216 ztrtrd(:,:,:) = ( ptr(:,:,:,jn,itime) - ztrtrd(:,:,:) ) * zs2rdt 217 CALL trd_tra( kt, Kbb, Kmm, 'TRC', jn, jptra_radb, ztrtrd ) ! Asselin-like trend handling 218 ENDIF 219 ! 220 END DO 221 ! 222 ENDIF 223 ! 224 END DO 278 225 ! 279 226 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) … … 286 233 !!---------------------------------------------------------------------- 287 234 CONTAINS 288 SUBROUTINE trc_rad( kt ) ! Empty routine235 SUBROUTINE trc_rad( kt, Kbb, Kmm ) ! Empty routine 289 236 INTEGER, INTENT(in) :: kt 237 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 290 238 WRITE(*,*) 'trc_rad: You should not have seen this print! error?', kt 291 239 END SUBROUTINE trc_rad -
NEMO/trunk/src/TOP/TRP/trcsbc.F90
r10788 r12377 29 29 30 30 !! * Substitutions 31 # include " vectopt_loop_substitute.h90"31 # include "do_loop_substitute.h90" 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 37 37 CONTAINS 38 38 39 SUBROUTINE trc_sbc ( kt )39 SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs ) 40 40 !!---------------------------------------------------------------------- 41 41 !! *** ROUTINE trc_sbc *** … … 49 49 !! The surface freshwater flux modify the ocean volume 50 50 !! and thus the concentration of a tracer as : 51 !! tr a = tra + emp * trn/ e3t for k=151 !! tr(Krhs) = tr(Krhs) + emp * tr(Kmm) / e3t for k=1 52 52 !! where emp, the surface freshwater budget (evaporation minus 53 53 !! precipitation ) given in kg/m2/s is divided 54 54 !! by 1035 kg/m3 (density of ocean water) to obtain m/s. 55 55 !! 56 !! ** Action : - Update the 1st level of tr awith the trend associated56 !! ** Action : - Update the 1st level of tr(:,:,:,:,Krhs) with the trend associated 57 57 !! with the tracer surface boundary condition 58 58 !! 59 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT(in) :: kt ! ocean time-step index 60 INTEGER, INTENT(in ) :: kt ! ocean time-step index 61 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 62 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 61 63 ! 62 64 INTEGER :: ji, jj, jn ! dummy loop indices … … 82 84 IF( ln_rsttr .AND. .NOT.ln_top_euler .AND. & ! Restart: read in restart file 83 85 iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 84 IF(lwp) WRITE(numout,*) ' nittrc000- nn_dttrc surface tracer content forcing fields red in the restart file'86 IF(lwp) WRITE(numout,*) ' nittrc000-1 surface tracer content forcing fields read in the restart file' 85 87 zfact = 0.5_wp 86 88 DO jn = 1, jptra … … 102 104 ENDIF 103 105 104 ! Coupling online : river runoff is added to the horizontal divergence (hdiv n) in the subroutine sbc_rnf_div106 ! Coupling online : river runoff is added to the horizontal divergence (hdiv) in the subroutine sbc_rnf_div 105 107 ! one only consider the concentration/dilution effect due to evaporation minus precipitation + freezing/melting of sea-ice 106 108 ! Coupling offline : runoff are in emp which contains E-P-R … … 118 120 ! 119 121 DO jn = 1, jptra 120 DO jj = 2, jpj 121 DO ji = fs_2, fs_jpim1 ! vector opt. 122 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn) 123 END DO 124 END DO 122 DO_2D_01_00 123 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 124 END_2D 125 125 END DO 126 126 ! … … 128 128 ! 129 129 DO jn = 1, jptra 130 DO jj = 2, jpj 131 DO ji = fs_2, fs_jpim1 ! vector opt. 132 sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rau0 * trn(ji,jj,1,jn) 133 END DO 134 END DO 130 DO_2D_01_00 131 sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 132 END_2D 135 133 END DO 136 134 ! … … 138 136 ! 139 137 DO jn = 1, jptra 140 DO jj = 2, jpj 141 DO ji = fs_2, fs_jpim1 ! vector opt. 142 zse3t = 1. / e3t_n(ji,jj,1) 143 ! tracer flux at the ice/ocean interface (tracer/m2/s) 144 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 145 ! ! only used in the levitating sea ice case 146 ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux 147 ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 148 ztfx = zftra ! net tracer flux 149 ! 150 zdtra = r1_rau0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * trn(ji,jj,1,jn) ) 151 IF ( zdtra < 0. ) THEN 152 zdtra = MAX(zdtra, -trn(ji,jj,1,jn) * e3t_n(ji,jj,1) / r2dttrc ) ! avoid negative concentrations to arise 153 ENDIF 154 sbc_trc(ji,jj,jn) = zdtra 155 END DO 156 END DO 138 DO_2D_01_00 139 zse3t = 1. / e3t(ji,jj,1,Kmm) 140 ! tracer flux at the ice/ocean interface (tracer/m2/s) 141 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 142 ! ! only used in the levitating sea ice case 143 ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux 144 ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 145 ztfx = zftra ! net tracer flux 146 ! 147 zdtra = r1_rau0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * ptr(ji,jj,1,jn,Kmm) ) 148 IF ( zdtra < 0. ) THEN 149 zdtra = MAX(zdtra, -ptr(ji,jj,1,jn,Kmm) * e3t(ji,jj,1,Kmm) / r2dttrc ) ! avoid negative concentrations to arise 150 ENDIF 151 sbc_trc(ji,jj,jn) = zdtra 152 END_2D 157 153 END DO 158 154 END SELECT … … 162 158 DO jn = 1, jptra 163 159 ! 164 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 165 ! 166 DO jj = 2, jpj 167 DO ji = fs_2, fs_jpim1 ! vector opt. 168 zse3t = zfact / e3t_n(ji,jj,1) 169 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 170 END DO 171 END DO 160 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends 161 ! 162 DO_2D_01_00 163 zse3t = zfact / e3t(ji,jj,1,Kmm) 164 ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 165 END_2D 172 166 ! 173 167 IF( l_trdtrc ) THEN 174 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)175 CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd )168 ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:) 169 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_nsr, ztrtrd ) 176 170 END IF 177 171 ! ! =========== … … 191 185 ENDIF 192 186 ! 193 IF( ln_ctl) THEN187 IF( sn_cfctl%l_prttrc ) THEN 194 188 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_trc_info(charout) 195 CALL prt_ctl_trc( tab4d= tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )189 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 196 190 ENDIF 197 191 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) … … 205 199 !! Dummy module : NO passive tracer 206 200 !!---------------------------------------------------------------------- 201 USE par_oce 202 USE par_trc 207 203 CONTAINS 208 SUBROUTINE trc_sbc (kt) ! Empty routine 209 INTEGER, INTENT(in) :: kt 204 SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs ) ! Empty routine 205 INTEGER, INTENT(in ) :: kt ! ocean time-step index 206 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 207 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 210 208 WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt 211 209 END SUBROUTINE trc_sbc -
NEMO/trunk/src/TOP/TRP/trcsink.F90
r11536 r12377 24 24 INTEGER, PUBLIC :: nitermax !: Maximum number of iterations for sinking 25 25 26 !! * Substitutions 27 # include "do_loop_substitute.h90" 26 28 !!---------------------------------------------------------------------- 27 29 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 35 37 !!---------------------------------------------------------------------- 36 38 37 SUBROUTINE trc_sink ( kt, pwsink, psinkflx, jp_tra, rsfact )39 SUBROUTINE trc_sink ( kt, Kbb, Kmm, pwsink, psinkflx, jp_tra, rsfact ) 38 40 !!--------------------------------------------------------------------- 39 41 !! *** ROUTINE trc_sink *** … … 45 47 !!--------------------------------------------------------------------- 46 48 INTEGER , INTENT(in) :: kt 49 INTEGER , INTENT(in) :: Kbb, Kmm 47 50 INTEGER , INTENT(in) :: jp_tra ! tracer index index 48 51 REAL(wp), INTENT(in) :: rsfact ! time step duration … … 70 73 iiter(:,:) = 1 71 74 ELSE 72 DO jj = 1, jpj 73 DO ji = 1, jpi 74 iiter(ji,jj) = 1 75 DO jk = 1, jpkm1 76 IF( tmask(ji,jj,jk) == 1.0 ) THEN 77 zwsmax = 0.5 * e3t_n(ji,jj,jk) * rday / rsfact 78 iiter(ji,jj) = MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) ) 79 ENDIF 80 END DO 81 END DO 82 END DO 75 DO_2D_11_11 76 iiter(ji,jj) = 1 77 DO jk = 1, jpkm1 78 IF( tmask(ji,jj,jk) == 1.0 ) THEN 79 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 80 iiter(ji,jj) = MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) ) 81 ENDIF 82 END DO 83 END_2D 83 84 iiter(:,:) = MIN( iiter(:,:), nitermax ) 84 85 ENDIF 85 86 86 DO jk = 1,jpkm1 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 IF( tmask(ji,jj,jk) == 1.0 ) THEN 90 zwsmax = 0.5 * e3t_n(ji,jj,jk) * rday / rsfact 91 zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) ) 92 ELSE 93 ! provide a default value so there is no use of undefinite value in trc_sink2 for zwsink2 initialization 94 zwsink(ji,jj,jk) = 0. 95 ENDIF 96 END DO 97 END DO 98 END DO 87 DO_3D_11_11( 1,jpkm1 ) 88 IF( tmask(ji,jj,jk) == 1.0 ) THEN 89 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 90 zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) ) 91 ELSE 92 ! provide a default value so there is no use of undefinite value in trc_sink2 for zwsink2 initialization 93 zwsink(ji,jj,jk) = 0. 94 ENDIF 95 END_3D 99 96 100 97 ! Initializa to zero all the sinking arrays … … 104 101 ! Compute the sedimentation term using trc_sink2 for the considered sinking particle 105 102 ! ----------------------------------------------------- 106 CALL trc_sink2( zwsink, psinkflx, jp_tra, iiter, rsfact )103 CALL trc_sink2( Kbb, Kmm, zwsink, psinkflx, jp_tra, iiter, rsfact ) 107 104 ! 108 105 IF( ln_timing ) CALL timing_stop('trc_sink') … … 110 107 END SUBROUTINE trc_sink 111 108 112 SUBROUTINE trc_sink2( pwsink, psinkflx, jp_tra, kiter, rsfact )109 SUBROUTINE trc_sink2( Kbb, Kmm, pwsink, psinkflx, jp_tra, kiter, rsfact ) 113 110 !!--------------------------------------------------------------------- 114 111 !! *** ROUTINE trc_sink2 *** … … 121 118 !! transport term, i.e. div(u*tra). 122 119 !!--------------------------------------------------------------------- 120 INTEGER, INTENT(in ) :: Kbb, Kmm ! time level indices 123 121 INTEGER, INTENT(in ) :: jp_tra ! tracer index index 124 122 REAL(wp), INTENT(in ) :: rsfact ! duration of time step … … 136 134 ztraz(:,:,:) = 0.e0 137 135 zakz (:,:,:) = 0.e0 138 ztrb (:,:,:) = tr b(:,:,:,jp_tra)136 ztrb (:,:,:) = tr(:,:,:,jp_tra,Kbb) 139 137 140 138 DO jk = 1, jpkm1 … … 147 145 DO jn = 1, 2 148 146 ! first guess of the slopes interior values 149 DO jj = 1, jpj 150 DO ji = 1, jpi 151 ! 152 zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 153 ! 154 DO jk = 2, jpkm1 155 ztraz(ji,jj,jk) = ( trb(ji,jj,jk-1,jp_tra) - trb(ji,jj,jk,jp_tra) ) * tmask(ji,jj,jk) 156 END DO 157 ztraz(ji,jj,1 ) = 0.0 158 ztraz(ji,jj,jpk) = 0.0 159 160 ! slopes 161 DO jk = 2, jpkm1 162 zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 163 zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 164 END DO 165 166 ! Slopes limitation 167 DO jk = 2, jpkm1 168 zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) * & 169 & MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 170 END DO 171 172 ! vertical advective flux 173 DO jk = 1, jpkm1 174 zigma = zwsink2(ji,jj,jk+1) * zstep / e3w_n(ji,jj,jk+1) 175 zew = zwsink2(ji,jj,jk+1) 176 psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 177 END DO 178 ! 179 ! Boundary conditions 180 psinkflx(ji,jj,1 ) = 0.e0 181 psinkflx(ji,jj,jpk) = 0.e0 182 183 DO jk=1,jpkm1 184 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 185 trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx 186 END DO 187 END DO 188 END DO 147 DO_2D_11_11 148 ! 149 zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 150 ! 151 DO jk = 2, jpkm1 152 ztraz(ji,jj,jk) = ( tr(ji,jj,jk-1,jp_tra,Kbb) - tr(ji,jj,jk,jp_tra,Kbb) ) * tmask(ji,jj,jk) 153 END DO 154 ztraz(ji,jj,1 ) = 0.0 155 ztraz(ji,jj,jpk) = 0.0 156 157 ! slopes 158 DO jk = 2, jpkm1 159 zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 160 zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 161 END DO 162 163 ! Slopes limitation 164 DO jk = 2, jpkm1 165 zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) * & 166 & MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 167 END DO 168 169 ! vertical advective flux 170 DO jk = 1, jpkm1 171 zigma = zwsink2(ji,jj,jk+1) * zstep / e3w(ji,jj,jk+1,Kmm) 172 zew = zwsink2(ji,jj,jk+1) 173 psinkflx(ji,jj,jk+1) = -zew * ( tr(ji,jj,jk,jp_tra,Kbb) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 174 END DO 175 ! 176 ! Boundary conditions 177 psinkflx(ji,jj,1 ) = 0.e0 178 psinkflx(ji,jj,jpk) = 0.e0 179 180 DO jk=1,jpkm1 181 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 182 tr(ji,jj,jk,jp_tra,Kbb) = tr(ji,jj,jk,jp_tra,Kbb) + zflx 183 END DO 184 END_2D 189 185 END DO 190 186 191 DO jk = 1,jpkm1 192 DO jj = 1,jpj 193 DO ji = 1, jpi 194 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 195 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 196 END DO 197 END DO 198 END DO 199 200 trb(:,:,:,jp_tra) = ztrb(:,:,:) 187 DO_3D_11_11( 1,jpkm1 ) 188 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 189 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 190 END_3D 191 192 tr(:,:,:,jp_tra,Kbb) = ztrb(:,:,:) 201 193 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 202 194 ! … … 216 208 !!---------------------------------------------------------------------- 217 209 ! 218 REWIND( numnat_ref ) ! namtrc_rad in reference namelist219 210 READ ( numnat_ref, namtrc_snk, IOSTAT = ios, ERR = 907) 220 211 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_snk in reference namelist' ) 221 REWIND( numnat_cfg ) ! namtrc_rad in configuration namelist222 212 READ ( numnat_cfg, namtrc_snk, IOSTAT = ios, ERR = 908 ) 223 213 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_snk in configuration namelist' ) -
NEMO/trunk/src/TOP/TRP/trctrp.F90
r10068 r12377 20 20 USE trcadv ! advection (trc_adv routine) 21 21 USE trczdf ! vertical diffusion (trc_zdf routine) 22 USE trc nxt ! time-stepping (trc_nxtroutine)22 USE trcatf ! time filtering (trc_atf routine) 23 23 USE trcrad ! positivity (trc_rad routine) 24 24 USE trcsbc ! surface boundary condition (trc_sbc routine) 25 USE trcbc ! Tracers boundary condtions ( trc_bc routine) 25 26 USE zpshde ! partial step: hor. derivative (zps_hde routine) 26 27 USE bdy_oce , ONLY: ln_bdy … … 44 45 CONTAINS 45 46 46 SUBROUTINE trc_trp( kt )47 SUBROUTINE trc_trp( kt, Kbb, Kmm, Krhs, Kaa ) 47 48 !!---------------------------------------------------------------------- 48 49 !! *** ROUTINE trc_trp *** … … 53 54 !! - Update the passive tracers 54 55 !!---------------------------------------------------------------------- 55 INTEGER, INTENT( in ) :: kt ! ocean time-step index 56 INTEGER, INTENT( in ) :: kt ! ocean time-step index 57 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices (not swapped in this routine) 56 58 !! --------------------------------------------------------------------- 57 59 ! … … 60 62 IF( .NOT. lk_c1d ) THEN 61 63 ! 62 CALL trc_sbc ( kt ) ! surface boundary condition 63 IF( ln_trabbl ) CALL trc_bbl ( kt ) ! advective (and/or diffusive) bottom boundary layer scheme 64 IF( ln_trcdmp ) CALL trc_dmp ( kt ) ! internal damping trends 65 IF( ln_bdy ) CALL trc_bdy_dmp( kt ) ! BDY damping trends 66 CALL trc_adv ( kt ) ! horizontal & vertical advection 64 CALL trc_sbc ( kt, Kmm, tr, Krhs ) ! surface boundary condition 65 IF( ln_trcbc .AND. lltrcbc .AND. kt /= nit000 ) & 66 CALL trc_bc ( kt, Kmm, tr, Krhs ) ! tracers: surface and lateral Boundary Conditions 67 IF( ln_trabbl ) CALL trc_bbl ( kt, Kbb, Kmm, tr, Krhs ) ! advective (and/or diffusive) bottom boundary layer scheme 68 IF( ln_trcdmp ) CALL trc_dmp ( kt, Kbb, Kmm, tr, Krhs ) ! internal damping trends 69 IF( ln_bdy ) CALL trc_bdy_dmp( kt, Kbb, Krhs ) ! BDY damping trends 70 CALL trc_adv ( kt, Kbb, Kmm, tr, Krhs ) ! horizontal & vertical advection 67 71 ! ! Partial top/bottom cell: GRADh( trb ) 68 72 IF( ln_zps ) THEN 69 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom70 ELSE ; CALL zps_hde ( kt, jptra, trb, gtru, gtrv ) ! only bottom73 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, Kmm, jptra, tr(:,:,:,:,Kbb), pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom 74 ELSE ; CALL zps_hde ( kt, Kmm, jptra, tr(:,:,:,:,Kbb), gtru, gtrv ) ! only bottom 71 75 ENDIF 72 76 ENDIF 73 77 ! 74 CALL trc_ldf ( kt )! lateral mixing78 CALL trc_ldf ( kt, Kbb, Kmm, tr, Krhs ) ! lateral mixing 75 79 #if defined key_agrif 76 80 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc ! tracers sponge 77 81 #endif 78 CALL trc_zdf ( kt ) ! vertical mixing and after tracer fields 79 CALL trc_nxt ( kt ) ! tracer fields at next time step 80 IF( ln_trcrad ) CALL trc_rad ( kt ) ! Correct artificial negative concentrations 81 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kt ) ! internal damping trends on closed seas only 82 CALL trc_zdf ( kt, Kbb, Kmm, Krhs, tr, Kaa ) ! vert. mixing & after tracer ==> after 83 CALL trc_atf ( kt, Kbb, Kmm, Kaa , tr ) ! time filtering of "now" tracer fields 84 ! 85 ! Subsequent calls use the filtered values: Kmm and Kaa 86 ! These are used explicitly here since time levels will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp 87 ! 88 IF( ln_trcrad ) CALL trc_rad ( kt, Kmm, Kaa, tr ) ! Correct artificial negative concentrations 89 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kt, Kmm, Kaa ) ! internal damping trends on closed seas only 82 90 83 91 ! 84 92 ELSE ! 1D vertical configuration 85 CALL trc_sbc( kt ) ! surface boundary condition 86 IF( ln_trcdmp ) CALL trc_dmp( kt ) ! internal damping trends 87 CALL trc_zdf( kt ) ! vertical mixing and after tracer fields 88 CALL trc_nxt( kt ) ! tracer fields at next time step 89 IF( ln_trcrad ) CALL trc_rad( kt ) ! Correct artificial negative concentrations 93 CALL trc_sbc( kt, Kmm, tr, Krhs ) ! surface boundary condition 94 IF( ln_trcdmp ) CALL trc_dmp( kt, Kbb, Kmm, tr, Krhs ) ! internal damping trends 95 CALL trc_zdf( kt, Kbb, Kmm, Krhs, tr, Kaa ) ! vert. mixing & after tracer ==> after 96 CALL trc_atf( kt, Kbb, Kmm, Kaa , tr ) ! time filtering of "now" tracer fields 97 ! 98 ! Subsequent calls use the filtered values: Kmm and Kaa 99 ! These are used explicitly here since time levels will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp 100 ! 101 IF( ln_trcrad ) CALL trc_rad( kt, Kmm, Kaa, tr ) ! Correct artificial negative concentrations 90 102 ! 91 103 END IF -
NEMO/trunk/src/TOP/TRP/trczdf.F90
r10068 r12377 36 36 CONTAINS 37 37 38 SUBROUTINE trc_zdf( kt )38 SUBROUTINE trc_zdf( kt, Kbb, Kmm, Krhs, ptr, Kaa ) 39 39 !!---------------------------------------------------------------------- 40 40 !! *** ROUTINE trc_zdf *** … … 43 43 !! an implicit time-stepping scheme. 44 44 !!--------------------------------------------------------------------- 45 INTEGER, INTENT( in ) :: kt ! ocean time-step index 45 INTEGER , INTENT(in ) :: kt ! ocean time-step index 46 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs, Kaa ! ocean time level indices 47 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 46 48 ! 47 49 INTEGER :: jk, jn … … 52 54 IF( ln_timing ) CALL timing_start('trc_zdf') 53 55 ! 54 IF( l_trdtrc ) ztrtrd(:,:,:,:) = tra(:,:,:,:)56 IF( l_trdtrc ) ztrtrd(:,:,:,:) = ptr(:,:,:,:,Krhs) 55 57 ! 56 CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra ) ! implicit scheme58 CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, Kbb, Kmm, Krhs, ptr, Kaa, jptra ) ! implicit scheme 57 59 ! 58 60 IF( l_trdtrc ) THEN ! save the vertical diffusive trends for further diagnostics 59 61 DO jn = 1, jptra 60 62 DO jk = 1, jpkm1 61 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn)63 ztrtrd(:,:,jk,jn) = ( ( ptr(:,:,jk,jn,Kaa) - ptr(:,:,jk,jn,Kbb) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 62 64 END DO 63 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) )65 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 64 66 END DO 65 67 ENDIF 66 68 ! ! print mean trends (used for debugging) 67 IF( ln_ctl) THEN69 IF( sn_cfctl%l_prttrc ) THEN 68 70 WRITE(charout, FMT="('zdf ')") 69 71 CALL prt_ctl_trc_info(charout) 70 CALL prt_ctl_trc( tab4d=tr a, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )72 CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kaa), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 71 73 END IF 72 74 ! -
NEMO/trunk/src/TOP/TRP/trdmxl_trc.F90
r11536 r12377 16 16 !! trd_mxl_trc_init : initialization step 17 17 !!---------------------------------------------------------------------- 18 USE trc ! tracer definitions (trn, trb, tra, etc.) 19 USE trc_oce, ONLY : nn_dttrc ! frequency of step on passive tracers 18 USE trc ! tracer definitions (tr etc.) 20 19 USE dom_oce ! domain definition 21 20 USE zdfmxl , ONLY : nmln ! number of level in the mixed layer … … 50 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: ztmltrd2 ! 51 50 51 !! * Substitutions 52 # include "do_loop_substitute.h90" 52 53 !!---------------------------------------------------------------------- 53 54 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 70 71 71 72 72 SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn )73 SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm ) 73 74 !!---------------------------------------------------------------------- 74 75 !! *** ROUTINE trd_mxl_trc_zint *** … … 92 93 !! 93 94 INTEGER, INTENT( in ) :: ktrd, kjn ! ocean trend index and passive tracer rank 95 INTEGER, INTENT( in ) :: Kmm ! time level index 94 96 CHARACTER(len=2), INTENT( in ) :: ctype ! surface/bottom (2D) or interior (3D) physics 95 97 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: ptrc_trdmxl ! passive tracer trend … … 122 124 123 125 IF( jpktrd_trc < jpk ) THEN ! description ??? 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 127 zvlmsk(ji,jj) = tmask(ji,jj,1) 128 ELSE 129 isum = isum + 1 130 zvlmsk(ji,jj) = 0.e0 131 ENDIF 132 END DO 133 END DO 126 DO_2D_11_11 127 IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 128 zvlmsk(ji,jj) = tmask(ji,jj,1) 129 ELSE 130 isum = isum + 1 131 zvlmsk(ji,jj) = 0.e0 132 ENDIF 133 END_2D 134 134 ENDIF 135 135 … … 147 147 ! ... Weights for vertical averaging 148 148 wkx_trc(:,:,:) = 0.e0 149 DO jk = 1, jpktrd_trc ! initialize wkx_trc with vertical scale factor in mixed-layer 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 153 END DO 154 END DO 155 END DO 149 DO_3D_11_11( 1, jpktrd_trc ) 150 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 151 END_3D 156 152 157 153 rmld_trc(:,:) = 0.e0 … … 183 179 184 180 185 SUBROUTINE trd_mxl_trc( kt )181 SUBROUTINE trd_mxl_trc( kt, Kmm ) 186 182 !!---------------------------------------------------------------------- 187 183 !! *** ROUTINE trd_mxl_trc *** … … 232 228 ! 233 229 INTEGER, INTENT(in) :: kt ! ocean time-step index 230 INTEGER, INTENT(in) :: Kmm ! time level index 234 231 ! 235 232 INTEGER :: ji, jj, jk, jl, ik, it, itmod, jn … … 251 248 252 249 253 IF( nn_dttrc /= 1 ) CALL ctl_stop( " Be careful, trends diags never validated " )254 255 250 ! ====================================================================== 256 251 ! I. Diagnose the purely vertical (K_z) diffusion trend … … 263 258 ! 264 259 DO jn = 1, jptra 265 DO jj = 1, jpj 266 DO ji = 1, jpi 267 ik = nmld_trc(ji,jj) 268 IF( ln_trdtrc(jn) ) & 269 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w_n(ji,jj,ik) * tmask(ji,jj,ik) & 270 & * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) ) & 271 & / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 272 END DO 273 END DO 260 DO_2D_11_11 261 ik = nmld_trc(ji,jj) 262 IF( ln_trdtrc(jn) ) & 263 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w(ji,jj,ik,Kmm) * tmask(ji,jj,ik) & 264 & * ( tr(ji,jj,ik-1,jn,Kmm) - tr(ji,jj,ik,jn,Kmm) ) & 265 & / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 266 END_2D 274 267 END DO 275 268 … … 322 315 DO jn = 1, jptra 323 316 IF( ln_trdtrc(jn) ) & 324 tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * tr n(:,:,jk,jn)317 tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * tr(:,:,jk,jn,Kmm) 325 318 END DO 326 319 END DO … … 328 321 ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window 329 322 ! ------------------------------------------------------------------------ 330 IF( kt == nittrc000 + nn_dttrc) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) ???323 IF( kt == nittrc000 + 1 ) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) ??? 331 324 ! 332 325 DO jn = 1, jptra … … 870 863 # endif 871 864 zout = nn_trd_trc * rdt 872 iiter = ( nittrc000 - 1 ) / nn_dttrc865 iiter = nittrc000 - 1 873 866 874 867 IF(lwp) WRITE (numout,*) ' netCDF initialization' … … 970 963 !!---------------------------------------------------------------------- 971 964 CONTAINS 972 SUBROUTINE trd_mxl_trc( kt ) ! Empty routine965 SUBROUTINE trd_mxl_trc( kt, Kmm ) ! Empty routine 973 966 INTEGER, INTENT( in) :: kt 967 INTEGER, INTENT( in) :: Kmm ! time level index 974 968 WRITE(*,*) 'trd_mxl_trc: You should not have seen this print! error?', kt 975 969 END SUBROUTINE trd_mxl_trc 976 SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn )970 SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm ) 977 971 INTEGER , INTENT( in ) :: ktrd, kjn ! ocean trend index and passive tracer rank 972 INTEGER , INTENT( in ) :: Kmm ! time level index 978 973 CHARACTER(len=2) , INTENT( in ) :: ctype ! surface/bottom (2D) or interior (3D) physics 979 974 REAL, DIMENSION(:,:,:), INTENT( in ) :: ptrc_trdmxl ! passive trc trend -
NEMO/trunk/src/TOP/TRP/trdmxl_trc_rst.F90
r10425 r12377 11 11 USE in_out_manager ! I/O manager 12 12 USE iom ! I/O module 13 USE trc ! for nn_dttrcctrcnm13 USE trc ! for ctrcnm 14 14 USE trdmxl_trc_oce ! for lk_trdmxl_trc 15 15 … … 44 44 !!-------------------------------------------------------------------------------- 45 45 46 IF( kt == nitrst - nn_dttrc .OR. nitend - nit000 + 1 < 2 * nn_dttrc) THEN ! idem trcrst.F9046 IF( kt == nitrst - 1 .OR. nitend - nit000 + 1 < 2 ) THEN ! idem trcrst.F90 47 47 IF( nitrst > 1.0e9 ) THEN 48 48 WRITE(clkt,*) nitrst -
NEMO/trunk/src/TOP/TRP/trdtrc.F90
r10096 r12377 13 13 !! trdtrc : passive tracer trends 14 14 !!---------------------------------------------------------------------- 15 USE trc ! tracer definitions (tr n, trb, tra, etc.)15 USE trc ! tracer definitions (tr(:,:,:,:,Kmm), tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), etc.) 16 16 USE trd_oce 17 17 USE trdtrc_oce ! definition of main arrays used for trends computations … … 32 32 CONTAINS 33 33 34 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )34 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 35 35 !!---------------------------------------------------------------------- 36 36 !! *** ROUTINE trd_trc *** 37 37 !!---------------------------------------------------------------------- 38 38 INTEGER, INTENT( in ) :: kt ! time step 39 INTEGER, INTENT( in ) :: Kmm ! time level index 39 40 INTEGER, INTENT( in ) :: kjn ! tracer index 40 41 INTEGER, INTENT( in ) :: ktrd ! tracer trend index … … 56 57 ! 57 58 SELECT CASE ( ktrd ) 58 CASE ( jptra_xad ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn )59 CASE ( jptra_yad ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn )60 CASE ( jptra_zad ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn )61 CASE ( jptra_ldf ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )62 CASE ( jptra_bbl ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn )59 CASE ( jptra_xad ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn, Kmm ) 60 CASE ( jptra_yad ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn, Kmm ) 61 CASE ( jptra_zad ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn, Kmm ) 62 CASE ( jptra_ldf ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn, Kmm ) 63 CASE ( jptra_bbl ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn, Kmm ) 63 64 CASE ( jptra_zdf ) 64 65 IF( ln_trcldf_iso ) THEN 65 CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )66 CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn, Kmm ) 66 67 ELSE 67 CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn )68 CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn, Kmm ) 68 69 ENDIF 69 CASE ( jptra_dmp ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn )70 CASE ( jptra_nsr ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn )71 CASE ( jptra_sms ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn )72 CASE ( jptra_radb ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn )73 CASE ( jptra_radn ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn )74 CASE ( jptra_atf ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn )70 CASE ( jptra_dmp ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn, Kmm ) 71 CASE ( jptra_nsr ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn, Kmm ) 72 CASE ( jptra_sms ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn, Kmm ) 73 CASE ( jptra_radb ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn, Kmm ) 74 CASE ( jptra_radn ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn, Kmm ) 75 CASE ( jptra_atf ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn, Kmm ) 75 76 END SELECT 76 77 ! … … 110 111 CONTAINS 111 112 112 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )113 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 113 114 INTEGER , INTENT( in ) :: kt ! time step 115 INTEGER , INTENT( in ) :: Kmm ! time level index 114 116 INTEGER , INTENT( in ) :: kjn ! tracer index 115 117 INTEGER , INTENT( in ) :: ktrd ! tracer trend index
Note: See TracChangeset
for help on using the changeset viewer.
