- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 1 deleted
- 13 edited
- 1 copied
-
. (modified) (1 prop)
-
src/TOP/TRP/trcadv.F90 (modified) (7 diffs)
-
src/TOP/TRP/trcatf.F90 (copied) (copied from NEMO/trunk/src/TOP/TRP/trcatf.F90)
-
src/TOP/TRP/trcbbl.F90 (modified) (7 diffs)
-
src/TOP/TRP/trcdmp.F90 (modified) (16 diffs)
-
src/TOP/TRP/trcldf.F90 (modified) (8 diffs)
-
src/TOP/TRP/trcnxt.F90 (deleted)
-
src/TOP/TRP/trcrad.F90 (modified) (9 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) (4 diffs)
-
src/TOP/TRP/trdmxl_trc.F90 (modified) (22 diffs)
-
src/TOP/TRP/trdmxl_trc_rst.F90 (modified) (4 diffs)
-
src/TOP/TRP/trdtrc.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcadv.F90
r10068 r13463 29 29 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 30 30 ! 31 USE prtctl _trc! control print31 USE prtctl ! control print 32 32 USE timing ! Timing 33 33 … … 59 59 INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme 60 60 61 !! * Substitutions 62 # include "vectopt_loop_substitute.h90" 61 # include "domzgr_substitute.h90" 63 62 !!---------------------------------------------------------------------- 64 63 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 68 67 CONTAINS 69 68 70 SUBROUTINE trc_adv( kt )69 SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs ) 71 70 !!---------------------------------------------------------------------- 72 71 !! *** ROUTINE trc_adv *** … … 74 73 !! ** Purpose : compute the ocean tracer advection trend. 75 74 !! 76 !! ** Method : - Update after tracers (tra) with the advection term following nadv 77 !!---------------------------------------------------------------------- 78 INTEGER, INTENT(in) :: kt ! ocean time-step index 75 !! ** Method : - Update after tracers (tr(Krhs)) with the advection term following nadv 76 !!---------------------------------------------------------------------- 77 INTEGER , INTENT(in) :: kt ! ocean time-step index 78 INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 79 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 79 80 ! 80 81 INTEGER :: jk ! dummy loop index 81 82 CHARACTER (len=22) :: charout 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zu n, zvn, zwn! effective velocity83 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuu, zvv, zww ! effective velocity 83 84 !!---------------------------------------------------------------------- 84 85 ! … … 87 88 ! !== effective transport ==! 88 89 IF( l_offline ) THEN 89 zu n(:,:,:) = un(:,:,:) ! already in (un,vn,wn)90 zv n(:,:,:) = vn(:,:,:)91 zw n(:,:,:) = wn(:,:,:)90 zuu(:,:,:) = uu(:,:,:,Kmm) ! already in (uu(Kmm),vv(Kmm),ww) 91 zvv(:,:,:) = vv(:,:,:,Kmm) 92 zww(:,:,:) = ww(:,:,:) 92 93 ELSE ! build the effective transport 93 zu n(:,:,jpk) = 0._wp94 zv n(:,:,jpk) = 0._wp95 zw n(:,:,jpk) = 0._wp94 zuu(:,:,jpk) = 0._wp 95 zvv(:,:,jpk) = 0._wp 96 zww(:,:,jpk) = 0._wp 96 97 IF( ln_wave .AND. ln_sdw ) THEN 97 98 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) )99 zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 100 zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 101 zww(:,:,jk) = e1e2t(:,:) * ( ww(:,:,jk) + wsd(:,:,jk) ) 101 102 END DO 102 103 ELSE 103 104 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)105 zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm) ! eulerian transport 106 zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm) 107 zww(:,:,jk) = e1e2t(:,:) * ww(:,:,jk) 107 108 END DO 108 109 ENDIF 109 110 ! 110 111 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(:,:,:)112 zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:) 113 zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:) 113 114 ENDIF 114 115 ! 115 116 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 transport117 & CALL ldf_eiv_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm, Krhs ) ! add the eiv transport 118 ! 119 IF( ln_mle ) CALL tra_mle_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm ) ! add the mle transport 119 120 ! 120 121 ENDIF … … 123 124 ! 124 125 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 )126 CALL tra_adv_cen( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 126 127 CASE ( np_FCT ) ! FCT : 2nd / 4th order 127 CALL tra_adv_fct( kt, nittrc000,'TRC', r 2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )128 CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 128 129 CASE ( np_MUS ) ! MUSCL 129 CALL tra_adv_mus( kt, nittrc000,'TRC', r 2dttrc, zun, zvn, zwn, trb, tra, jptra , ln_mus_ups)130 CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) 130 131 CASE ( np_UBS ) ! UBS 131 CALL tra_adv_ubs( kt, nittrc000,'TRC', r 2dttrc, zun, zvn, zwn, trb, trn, tra, jptra , nn_ubs_v)132 CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v ) 132 133 CASE ( np_QCK ) ! QUICKEST 133 CALL tra_adv_qck( kt, nittrc000,'TRC', r 2dttrc, zun, zvn, zwn, trb, trn, tra, jptra)134 CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs ) 134 135 ! 135 136 END SELECT 136 137 ! 137 IF( ln_ctl ) THEN!== print mean trends (used for debugging)138 IF( sn_cfctl%l_prttrc ) THEN !== print mean trends (used for debugging) 138 139 WRITE(charout, FMT="('adv ')") 139 CALL prt_ctl_ trc_info(charout)140 CALL prt_ctl _trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )140 CALL prt_ctl_info( charout, cdcomp = 'top' ) 141 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 141 142 END IF 142 143 ! … … 164 165 ! 165 166 ! !== Namelist ==! 166 REWIND( numnat_ref ) ! namtrc_adv in reference namelist167 167 READ ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 168 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 169 REWIND( numnat_cfg ) ! namtrc_adv in configuration namelist 168 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist' ) 170 169 READ ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 171 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist' , lwp)170 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist' ) 172 171 IF(lwm) WRITE ( numont, namtrc_adv ) 173 172 ! -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcbbl.F90
r10068 r13463 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 25 25 USE trdtra ! tracer trends 26 26 USE trabbl ! bottom boundary layer 27 USE prtctl _trc! Print control for debbuging27 USE prtctl ! Print control for debbuging 28 28 29 29 PUBLIC trc_bbl ! routine called by trctrp.F90 … … 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 WRITE(charout, FMT="(' bbl_dif')") ; CALL prt_ctl_ trc_info(charout)71 CALL prt_ctl _trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )70 CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 71 IF( sn_cfctl%l_prttrc ) THEN 72 WRITE(charout, FMT="(' bbl_dif')") ; CALL prt_ctl_info( charout, cdcomp = 'top' ) 73 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='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 WRITE(charout, FMT="(' bbl_adv')") ; CALL prt_ctl_ trc_info(charout)82 CALL prt_ctl _trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )81 CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 82 IF( sn_cfctl%l_prttrc ) THEN 83 WRITE(charout, FMT="(' bbl_adv')") ; CALL prt_ctl_info( charout, cdcomp = 'top' ) 84 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcdmp.F90
r10351 r13463 24 24 ! 25 25 USE iom 26 USE prtctl _trc! Print control for debbuging26 USE prtctl ! Print control for debbuging 27 27 28 28 IMPLICIT NONE … … 44 44 45 45 !! * Substitutions 46 # include "vectopt_loop_substitute.h90" 46 # include "do_loop_substitute.h90" 47 # include "domzgr_substitute.h90" 47 48 !!---------------------------------------------------------------------- 48 49 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 63 64 64 65 65 SUBROUTINE trc_dmp( kt )66 SUBROUTINE trc_dmp( kt, Kbb, Kmm, ptr, Krhs ) 66 67 !!---------------------------------------------------------------------- 67 68 !! *** ROUTINE trc_dmp *** … … 73 74 !! ** Method : Newtonian damping towards trdta computed 74 75 !! and add to the general tracer trends: 75 !! tr n = tra + restotr * (trdta - trb)76 !! tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb)) 76 77 !! The trend is computed either throughout the water column 77 78 !! (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or 78 79 !! below the well mixed layer (nlmdmptr=2) 79 80 !! 80 !! ** Action : - update the tracer trends tr awith the newtonian81 !! ** Action : - update the tracer trends tr(:,:,:,:,Krhs) with the newtonian 81 82 !! damping trends. 82 83 !! - save the trends ('key_trdmxl_trc') 83 84 !!---------------------------------------------------------------------- 84 INTEGER, INTENT(in) :: kt ! ocean time-step index 85 INTEGER, INTENT(in ) :: kt ! ocean time-step index 86 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices 87 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 85 88 ! 86 89 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices … … 100 103 DO jn = 1, jptra ! tracer loop 101 104 ! ! =========== 102 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends105 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends 103 106 ! 104 107 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 105 108 ! 106 109 jl = n_trc_index(jn) 107 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000110 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 108 111 ! 109 112 SELECT CASE ( nn_zdmp_tr ) 110 113 ! 111 114 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 115 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 116 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) ) 117 END_3D 119 118 ! 120 119 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 120 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 121 IF( avt(ji,jj,jk) <= avt_c ) THEN 122 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) ) 123 ENDIF 124 END_3D 130 125 ! 131 126 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 127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 128 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 129 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) ) 130 END IF 131 END_3D 141 132 ! 142 133 END SELECT … … 145 136 ! 146 137 IF( l_trdtrc ) THEN 147 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)148 CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd )138 ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:) 139 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_dmp, ztrtrd ) 149 140 END IF 150 141 ! ! =========== … … 156 147 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 157 148 ! ! print mean trends (used for debugging) 158 IF( ln_ctl) THEN149 IF( sn_cfctl%l_prttrc ) THEN 159 150 WRITE(charout, FMT="('dmp ')") 160 CALL prt_ctl_ trc_info(charout)161 CALL prt_ctl _trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )151 CALL prt_ctl_info( charout, cdcomp = 'top' ) 152 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 162 153 ENDIF 163 154 ! … … 181 172 !!---------------------------------------------------------------------- 182 173 ! 183 REWIND( numnat_ref ) ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping184 174 READ ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 185 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 186 REWIND( numnat_cfg ) ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping 175 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist' ) 187 176 READ ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 188 910 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist' , lwp)177 910 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist' ) 189 178 IF(lwm) WRITE ( numont, namtrc_dmp ) 190 179 … … 216 205 !Read in mask from file 217 206 CALL iom_open ( cn_resto_tr, imask) 218 CALL iom_get ( imask, jpdom_auto glo, 'resto', restotr)207 CALL iom_get ( imask, jpdom_auto, 'resto', restotr) 219 208 CALL iom_close( imask ) 220 209 ! … … 224 213 225 214 226 SUBROUTINE trc_dmp_clo( kt )215 SUBROUTINE trc_dmp_clo( kt, Kbb, Kmm ) 227 216 !!--------------------------------------------------------------------- 228 217 !! *** ROUTINE trc_dmp_clo *** … … 236 225 !! nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 237 226 !!---------------------------------------------------------------------- 238 INTEGER, INTENT( in ) :: kt ! ocean time-step index 227 INTEGER, INTENT( in ) :: kt ! ocean time-step index 228 INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices 239 229 ! 240 230 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa … … 256 246 ! ! ======================= 257 247 CASE ( 1 ) ! eORCA_R1 configuration 258 ! ! ======================= 259 isrow = 332 - jpjglo 260 ! 261 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow ! Caspian Sea 262 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 263 ! 264 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow ! Lake Superior 265 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 266 ! 267 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow ! Lake Michigan 268 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 269 ! 270 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow ! Lake Huron 271 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 272 ! 273 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow ! Lake Erie 274 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 275 ! 276 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow ! Lake Ontario 277 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 278 ! 279 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow ! Victoria Lake 280 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 281 ! 282 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow ! Baltic Sea 283 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 284 ! 285 ! ! ======================= 248 ! ! ======================= 249 ! 250 isrow = 332 - (Nj0glo + 1) ! was 332 - jpjglo -> jpjglo_old_version = Nj0glo + 1 251 ! 252 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow ! Caspian Sea 253 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 254 ! 255 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow ! Lake Superior 256 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 257 ! 258 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow ! Lake Michigan 259 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 260 ! 261 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow ! Lake Huron 262 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 263 ! 264 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow ! Lake Erie 265 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 266 ! 267 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow ! Lake Ontario 268 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 269 ! 270 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow ! Victoria Lake 271 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 272 ! 273 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow ! Baltic Sea 274 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 275 ! 276 ! ! ======================= 286 277 CASE ( 2 ) ! ORCA_R2 configuration 287 278 ! ! ======================= … … 296 287 nctsi2(3) = 181 ; nctsj2(3) = 112 297 288 ! 298 nctsi1(4) = 2 ; nctsj1(4) = 107 ! Black Sea 2 : est part of the Black Sea289 nctsi1(4) = 2 ; nctsj1(4) = 107 ! Black Sea 2 : est part of the Black Sea 299 290 nctsi2(4) = 6 ; nctsj2(4) = 112 300 291 ! 301 292 nctsi1(5) = 145 ; nctsj1(5) = 116 ! Baltic Sea 302 293 nctsi2(5) = 150 ; nctsj2(5) = 126 294 ! 303 295 ! ! ======================= 304 296 CASE ( 4 ) ! ORCA_R4 configuration … … 316 308 nctsi1(4) = 75 ; nctsj1(4) = 59 ! Baltic Sea 317 309 nctsi2(4) = 76 ; nctsj2(4) = 61 310 ! 318 311 ! ! ======================= 319 312 CASE ( 025 ) ! ORCA_R025 configuration … … 330 323 ENDIF 331 324 ! 325 nctsi1(:) = nctsi1(:) + nn_hls - 1 ; nctsi2(:) = nctsi2(:) + nn_hls - 1 ! -1 as x-perio included in old input files 326 nctsj1(:) = nctsj1(:) + nn_hls ; nctsj2(:) = nctsj2(:) + nn_hls 327 ! 332 328 ! convert the position in local domain indices 333 329 ! -------------------------------------------- … … 354 350 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 355 351 jl = n_trc_index(jn) 356 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000352 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 357 353 DO jc = 1, npncts 358 354 DO jk = 1, jpkm1 359 355 DO jj = nctsj1(jc), nctsj2(jc) 360 356 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)357 tr(ji,jj,jk,jn,Kmm) = ztrcdta(ji,jj,jk) 358 tr(ji,jj,jk,jn,Kbb) = tr(ji,jj,jk,jn,Kmm) 363 359 END DO 364 360 END DO -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcldf.F90
r10068 r13463 25 25 USE trdtra ! trends manager: tracers 26 26 ! 27 USE prtctl _trc! Print control27 USE prtctl ! Print control 28 28 29 29 IMPLICIT NONE … … 43 43 44 44 !! * Substitutions 45 # include "vectopt_loop_substitute.h90" 45 # include "do_loop_substitute.h90" 46 # include "domzgr_substitute.h90" 46 47 !!---------------------------------------------------------------------- 47 48 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 51 52 CONTAINS 52 53 53 SUBROUTINE trc_ldf( kt )54 SUBROUTINE trc_ldf( kt, Kbb, Kmm, ptr, Krhs ) 54 55 !!---------------------------------------------------------------------- 55 56 !! *** ROUTINE tra_ldf *** … … 58 59 !! 59 60 !!---------------------------------------------------------------------- 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 INTEGER, INTENT(in ) :: kt ! ocean time-step index 62 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time-level index 63 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 61 64 ! 62 65 INTEGER :: ji, jj, jk, jn 63 66 REAL(wp) :: zdep 64 67 CHARACTER (len=22) :: charout 65 REAL(wp), DIMENSION(jpi,jpj,jpk):: zahu, zahv66 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd68 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zahu, zahv 69 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd 67 70 !!---------------------------------------------------------------------- 68 71 ! … … 73 76 IF( l_trdtrc ) THEN 74 77 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) 75 ztrtrd(:,:,:,:) = tra(:,:,:,:)78 ztrtrd(:,:,:,:) = ptr(:,:,:,:,Krhs) 76 79 ENDIF 77 80 ! !* set the lateral diffusivity coef. for passive tracer … … 79 82 zahv(:,:,:) = rldf * ahtv(:,:,:) 80 83 ! !* 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 84 DO_3D( 1, 1, 1, 1, 1, jpk ) 85 IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 86 zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000. 87 zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) ) 88 ENDIF 89 END_3D 91 90 ! 92 91 SELECT CASE ( nldf_trc ) !* compute lateral mixing trend and add it to the general trend 93 92 ! 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 ) 93 CASE ( np_lap ) ! iso-level laplacian 94 CALL tra_ldf_lap ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 95 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 96 CASE ( np_lap_i ) ! laplacian : standard iso-neutral operator (Madec) 97 CALL tra_ldf_iso ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 98 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 99 CASE ( np_lap_it ) ! laplacian : triad iso-neutral operator (griffies) 100 CALL tra_ldf_triad( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 101 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 102 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: all operator (iso-level, -neutral) 103 CALL tra_ldf_blp ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 104 & ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs), jptra, nldf_trc ) 102 105 END SELECT 103 106 ! 104 107 IF( l_trdtrc ) THEN ! send the trends for further diagnostics 105 108 DO jn = 1, jptra 106 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)107 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) )109 ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 110 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 108 111 END DO 109 112 DEALLOCATE( ztrtrd ) 110 113 ENDIF 111 114 ! 112 IF( ln_ctl ) THEN! print mean trends (used for debugging)115 IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging) 113 116 WRITE(charout, FMT="('ldf ')") 114 CALL prt_ctl_ trc_info(charout)115 CALL prt_ctl _trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )117 CALL prt_ctl_info( charout, cdcomp = 'top' ) 118 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 116 119 ENDIF 117 120 ! … … 143 146 ENDIF 144 147 ! 145 REWIND( numnat_ref ) ! namtrc_ldf in reference namelist146 148 READ ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 147 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist' , lwp)149 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist' ) 148 150 ! 149 REWIND( numnat_cfg ) ! namtrc_ldf in configuration namelist150 151 READ ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 151 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist' , lwp)152 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist' ) 152 153 IF(lwm) WRITE ( numont, namtrc_ldf ) 153 154 ! … … 167 168 IF( ln_trcldf_OFF ) THEN ; nldf_trc = np_no_ldf ; ioptio = ioptio + 1 ; ENDIF 168 169 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)' )170 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_ldf_ini: use ONE of the 2 operator options (OFF/tra)' ) 170 171 171 172 ! ! multiplier : passive/active tracers ration -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcrad.F90
r10425 r13463 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 … … 18 19 USE trd_oce 19 20 USE trdtra 20 USE prtctl _trc! Print control for debbuging21 USE prtctl ! Print control for debbuging 21 22 USE lib_fortran 22 23 … … 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 CALL prt_ctl_ trc_info( charout)70 CALL prt_ctl _trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )74 CALL prt_ctl_info( charout, cdcomp = 'top' ) 75 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Kbb), mask1=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 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 92 REWIND( numnat_cfg ) ! namtrc_rad in configuration namelist 95 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist' ) 93 96 READ ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 94 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist' , lwp)97 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist' ) 95 98 IF(lwm) WRITE( numont, namtrc_rad ) 96 99 … … 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. * rn_Dt ) 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( nn_hls, nn_hls, nn_hls, nn_hls, 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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcsbc.F90
r10788 r13463 18 18 USE oce_trc ! ocean dynamics and active tracers variables 19 19 USE trc ! ocean passive tracers variables 20 USE prtctl _trc! Print control for debbuging20 USE prtctl ! Print control for debbuging 21 21 USE iom 22 22 USE trd_oce … … 29 29 30 30 !! * Substitutions 31 # include "vectopt_loop_substitute.h90" 31 # include "do_loop_substitute.h90" 32 # include "domzgr_substitute.h90" 32 33 !!---------------------------------------------------------------------- 33 34 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 37 38 CONTAINS 38 39 39 SUBROUTINE trc_sbc ( kt )40 SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs ) 40 41 !!---------------------------------------------------------------------- 41 42 !! *** ROUTINE trc_sbc *** … … 49 50 !! The surface freshwater flux modify the ocean volume 50 51 !! and thus the concentration of a tracer as : 51 !! tr a = tra + emp * trn / e3tfor k=152 !! tr(Krhs) = tr(Krhs) + emp * tr(Kmm) / e3t_ for k=1 52 53 !! where emp, the surface freshwater budget (evaporation minus 53 54 !! precipitation ) given in kg/m2/s is divided 54 55 !! by 1035 kg/m3 (density of ocean water) to obtain m/s. 55 56 !! 56 !! ** Action : - Update the 1st level of tr awith the trend associated57 !! ** Action : - Update the 1st level of tr(:,:,:,:,Krhs) with the trend associated 57 58 !! with the tracer surface boundary condition 58 59 !! 59 60 !!---------------------------------------------------------------------- 60 INTEGER, INTENT(in) :: kt ! ocean time-step index 61 INTEGER, INTENT(in ) :: kt ! ocean time-step index 62 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 63 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 61 64 ! 62 65 INTEGER :: ji, jj, jn ! dummy loop indices … … 82 85 IF( ln_rsttr .AND. .NOT.ln_top_euler .AND. & ! Restart: read in restart file 83 86 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'87 IF(lwp) WRITE(numout,*) ' nittrc000-1 surface tracer content forcing fields read in the restart file' 85 88 zfact = 0.5_wp 86 89 DO jn = 1, jptra 87 CALL iom_get( numrtr, jpdom_auto glo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc90 CALL iom_get( numrtr, jpdom_auto, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc 88 91 END DO 89 92 ELSE ! No restart or restart not found: Euler forward time stepping … … 102 105 ENDIF 103 106 104 ! Coupling online : river runoff is added to the horizontal divergence (hdiv n) in the subroutine sbc_rnf_div107 ! Coupling online : river runoff is added to the horizontal divergence (hdiv) in the subroutine sbc_rnf_div 105 108 ! one only consider the concentration/dilution effect due to evaporation minus precipitation + freezing/melting of sea-ice 106 109 ! Coupling offline : runoff are in emp which contains E-P-R … … 118 121 ! 119 122 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 123 DO_2D( 0, 1, 0, 0 ) 124 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) 125 END_2D 125 126 END DO 126 127 ! … … 128 129 ! 129 130 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 131 DO_2D( 0, 1, 0, 0 ) 132 sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) 133 END_2D 135 134 END DO 136 135 ! … … 138 137 ! 139 138 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 139 DO_2D( 0, 1, 0, 0 ) 140 zse3t = 1. / e3t(ji,jj,1,Kmm) 141 ! tracer flux at the ice/ocean interface (tracer/m2/s) 142 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 143 ! ! only used in the levitating sea ice case 144 ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux 145 ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 146 ztfx = zftra ! net tracer flux 147 ! 148 zdtra = r1_rho0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * ptr(ji,jj,1,jn,Kmm) ) 149 IF ( zdtra < 0. ) THEN 150 zdtra = MAX(zdtra, -ptr(ji,jj,1,jn,Kmm) * e3t(ji,jj,1,Kmm) / rDt_trc ) ! avoid negative concentrations to arise 151 ENDIF 152 sbc_trc(ji,jj,jn) = zdtra 153 END_2D 157 154 END DO 158 155 END SELECT 159 156 ! 160 CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1. )157 CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1.0_wp ) 161 158 ! Concentration dilution effect on tracers due to evaporation & precipitation 162 159 DO jn = 1, jptra 163 160 ! 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 161 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends 162 ! 163 DO_2D( 0, 1, 0, 0 ) 164 zse3t = zfact / e3t(ji,jj,1,Kmm) 165 ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 166 END_2D 172 167 ! 173 168 IF( l_trdtrc ) THEN 174 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)175 CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd )169 ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:) 170 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_nsr, ztrtrd ) 176 171 END IF 177 172 ! ! =========== … … 191 186 ENDIF 192 187 ! 193 IF( ln_ctl) THEN194 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_ trc_info(charout)195 CALL prt_ctl _trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )188 IF( sn_cfctl%l_prttrc ) THEN 189 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_info( charout, cdcomp = 'top' ) 190 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 196 191 ENDIF 197 192 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) … … 205 200 !! Dummy module : NO passive tracer 206 201 !!---------------------------------------------------------------------- 202 USE par_oce 203 USE par_trc 207 204 CONTAINS 208 SUBROUTINE trc_sbc (kt) ! Empty routine 209 INTEGER, INTENT(in) :: kt 205 SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs ) ! Empty routine 206 INTEGER, INTENT(in ) :: kt ! ocean time-step index 207 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 208 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 210 209 WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt 211 210 END SUBROUTINE trc_sbc -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcsink.F90
r10788 r13463 24 24 INTEGER, PUBLIC :: nitermax !: Maximum number of iterations for sinking 25 25 26 !! * Substitutions 27 # include "do_loop_substitute.h90" 28 # include "domzgr_substitute.h90" 26 29 !!---------------------------------------------------------------------- 27 30 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 35 38 !!---------------------------------------------------------------------- 36 39 37 SUBROUTINE trc_sink ( kt, pwsink, psinkflx, jp_tra, rsfact )40 SUBROUTINE trc_sink ( kt, Kbb, Kmm, pwsink, psinkflx, jp_tra, rsfact ) 38 41 !!--------------------------------------------------------------------- 39 42 !! *** ROUTINE trc_sink *** … … 45 48 !!--------------------------------------------------------------------- 46 49 INTEGER , INTENT(in) :: kt 50 INTEGER , INTENT(in) :: Kbb, Kmm 47 51 INTEGER , INTENT(in) :: jp_tra ! tracer index index 48 52 REAL(wp), INTENT(in) :: rsfact ! time step duration … … 70 74 iiter(:,:) = 1 71 75 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 76 DO_2D( 1, 1, 1, 1 ) 77 iiter(ji,jj) = 1 78 DO jk = 1, jpkm1 79 IF( tmask(ji,jj,jk) == 1.0 ) THEN 80 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 81 iiter(ji,jj) = MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) ) 82 ENDIF 83 END DO 84 END_2D 83 85 iiter(:,:) = MIN( iiter(:,:), nitermax ) 84 86 ENDIF 85 87 86 DO jk = 1,jpkm1 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 IF( tmask(ji,jj,jk) == 1 ) 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 ENDIF 93 END DO 94 END DO 95 END DO 88 DO_3D( 1, 1, 1, 1, 1,jpkm1 ) 89 IF( tmask(ji,jj,jk) == 1.0 ) THEN 90 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * 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_3D 96 97 97 98 ! Initializa to zero all the sinking arrays … … 101 102 ! Compute the sedimentation term using trc_sink2 for the considered sinking particle 102 103 ! ----------------------------------------------------- 103 CALL trc_sink2( zwsink, psinkflx, jp_tra, iiter, rsfact )104 CALL trc_sink2( Kbb, Kmm, zwsink, psinkflx, jp_tra, iiter, rsfact ) 104 105 ! 105 106 IF( ln_timing ) CALL timing_stop('trc_sink') … … 107 108 END SUBROUTINE trc_sink 108 109 109 SUBROUTINE trc_sink2( pwsink, psinkflx, jp_tra, kiter, rsfact )110 SUBROUTINE trc_sink2( Kbb, Kmm, pwsink, psinkflx, jp_tra, kiter, rsfact ) 110 111 !!--------------------------------------------------------------------- 111 112 !! *** ROUTINE trc_sink2 *** … … 118 119 !! transport term, i.e. div(u*tra). 119 120 !!--------------------------------------------------------------------- 121 INTEGER, INTENT(in ) :: Kbb, Kmm ! time level indices 120 122 INTEGER, INTENT(in ) :: jp_tra ! tracer index index 121 123 REAL(wp), INTENT(in ) :: rsfact ! duration of time step … … 133 135 ztraz(:,:,:) = 0.e0 134 136 zakz (:,:,:) = 0.e0 135 ztrb (:,:,:) = tr b(:,:,:,jp_tra)137 ztrb (:,:,:) = tr(:,:,:,jp_tra,Kbb) 136 138 137 139 DO jk = 1, jpkm1 … … 144 146 DO jn = 1, 2 145 147 ! first guess of the slopes interior values 146 DO jj = 1, jpj 147 DO ji = 1, jpi 148 ! 149 zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 150 ! 151 DO jk = 2, jpkm1 152 ztraz(ji,jj,jk) = ( trb(ji,jj,jk-1,jp_tra) - trb(ji,jj,jk,jp_tra) ) * 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_n(ji,jj,jk+1) 172 zew = zwsink2(ji,jj,jk+1) 173 psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 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_n(ji,jj,jk) 182 trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx 183 END DO 184 END DO 185 END DO 148 DO_2D( 1, 1, 1, 1 ) 149 ! 150 zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 151 ! 152 DO jk = 2, jpkm1 153 ztraz(ji,jj,jk) = ( tr(ji,jj,jk-1,jp_tra,Kbb) - tr(ji,jj,jk,jp_tra,Kbb) ) * tmask(ji,jj,jk) 154 END DO 155 ztraz(ji,jj,1 ) = 0.0 156 ztraz(ji,jj,jpk) = 0.0 157 158 ! slopes 159 DO jk = 2, jpkm1 160 zign = 0.25 + SIGN( 0.25_wp, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 161 zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 162 END DO 163 164 ! Slopes limitation 165 DO jk = 2, jpkm1 166 zakz(ji,jj,jk) = SIGN( 1.0_wp, zakz(ji,jj,jk) ) * & 167 & MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 168 END DO 169 170 ! vertical advective flux 171 DO jk = 1, jpkm1 172 zigma = zwsink2(ji,jj,jk+1) * zstep / e3w(ji,jj,jk+1,Kmm) 173 zew = zwsink2(ji,jj,jk+1) 174 psinkflx(ji,jj,jk+1) = -zew * ( tr(ji,jj,jk,jp_tra,Kbb) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 175 END DO 176 ! 177 ! Boundary conditions 178 psinkflx(ji,jj,1 ) = 0.e0 179 psinkflx(ji,jj,jpk) = 0.e0 180 181 DO jk=1,jpkm1 182 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 183 tr(ji,jj,jk,jp_tra,Kbb) = tr(ji,jj,jk,jp_tra,Kbb) + zflx 184 END DO 185 END_2D 186 186 END DO 187 187 188 DO jk = 1,jpkm1 189 DO jj = 1,jpj 190 DO ji = 1, jpi 191 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 192 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 193 END DO 194 END DO 195 END DO 196 197 trb(:,:,:,jp_tra) = ztrb(:,:,:) 188 DO_3D( 1, 1, 1, 1, 1,jpkm1 ) 189 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 190 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 191 END_3D 192 193 tr(:,:,:,jp_tra,Kbb) = ztrb(:,:,:) 198 194 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 199 195 ! … … 213 209 !!---------------------------------------------------------------------- 214 210 ! 215 REWIND( numnat_ref ) ! namtrc_rad in reference namelist216 211 READ ( numnat_ref, namtrc_snk, IOSTAT = ios, ERR = 907) 217 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_snk in reference namelist', lwp ) 218 REWIND( numnat_cfg ) ! namtrc_rad in configuration namelist 212 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_snk in reference namelist' ) 219 213 READ ( numnat_cfg, namtrc_snk, IOSTAT = ios, ERR = 908 ) 220 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_snk in configuration namelist' , lwp)214 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_snk in configuration namelist' ) 221 215 IF(lwm) WRITE( numont, namtrc_snk ) 222 216 -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trctrp.F90
r10068 r13463 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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trczdf.F90
r10068 r13463 22 22 !!gm 23 23 USE trdtra ! trends manager: tracers 24 USE prtctl _trc! Print control24 USE prtctl ! Print control 25 25 26 26 IMPLICIT NONE … … 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', r 2dttrc, trb, tra, jptra ) ! implicit scheme58 CALL tra_zdf_imp( kt, nittrc000, 'TRC', rDt_trc, 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) ) / rDt_trc ) - 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 CALL prt_ctl_ trc_info(charout)70 CALL prt_ctl _trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )71 CALL prt_ctl_info( charout, cdcomp = 'top' ) 72 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kaa), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 71 73 END IF 72 74 ! -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trdmxl_trc.F90
r10425 r13463 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" 53 # include "domzgr_substitute.h90" 52 54 !!---------------------------------------------------------------------- 53 55 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 70 72 71 73 72 SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn )74 SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm ) 73 75 !!---------------------------------------------------------------------- 74 76 !! *** ROUTINE trd_mxl_trc_zint *** … … 92 94 !! 93 95 INTEGER, INTENT( in ) :: ktrd, kjn ! ocean trend index and passive tracer rank 96 INTEGER, INTENT( in ) :: Kmm ! time level index 94 97 CHARACTER(len=2), INTENT( in ) :: ctype ! surface/bottom (2D) or interior (3D) physics 95 98 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: ptrc_trdmxl ! passive tracer trend … … 108 111 ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer 109 112 SELECT CASE ( nn_ctls_trc ) ! choice of the control surface 110 CASE ( -2 ) ; STOP 'trdmxl_trc : not ready '! -> isopycnal surface (see ???)113 CASE ( -2 ) ; CALL ctl_stop( 'STOP', 'trdmxl_trc : not ready ' ) ! -> isopycnal surface (see ???) 111 114 CASE ( -1 ) ; nmld_trc(:,:) = neln(:,:) ! -> euphotic layer with light criterion 112 115 CASE ( 0 ) ; nmld_trc(:,:) = nmln(:,:) ! -> ML with density criterion (see zdfmxl) … … 122 125 123 126 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 127 DO_2D( 1, 1, 1, 1 ) 128 IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 129 zvlmsk(ji,jj) = tmask(ji,jj,1) 130 ELSE 131 isum = isum + 1 132 zvlmsk(ji,jj) = 0.e0 133 ENDIF 134 END_2D 134 135 ENDIF 135 136 … … 147 148 ! ... Weights for vertical averaging 148 149 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 150 DO_3D( 1, 1, 1, 1, 1, jpktrd_trc ) 151 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 152 END_3D 156 153 157 154 rmld_trc(:,:) = 0.e0 … … 183 180 184 181 185 SUBROUTINE trd_mxl_trc( kt )182 SUBROUTINE trd_mxl_trc( kt, Kmm ) 186 183 !!---------------------------------------------------------------------- 187 184 !! *** ROUTINE trd_mxl_trc *** … … 232 229 ! 233 230 INTEGER, INTENT(in) :: kt ! ocean time-step index 231 INTEGER, INTENT(in) :: Kmm ! time level index 234 232 ! 235 233 INTEGER :: ji, jj, jk, jl, ik, it, itmod, jn … … 251 249 252 250 253 IF( nn_dttrc /= 1 ) CALL ctl_stop( " Be careful, trends diags never validated " )254 255 251 ! ====================================================================== 256 252 ! I. Diagnose the purely vertical (K_z) diffusion trend … … 263 259 ! 264 260 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 261 DO_2D( 1, 1, 1, 1 ) 262 ik = nmld_trc(ji,jj) 263 IF( ln_trdtrc(jn) ) & 264 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w(ji,jj,ik,Kmm) * tmask(ji,jj,ik) & 265 & * ( tr(ji,jj,ik-1,jn,Kmm) - tr(ji,jj,ik,jn,Kmm) ) & 266 & / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 267 END_2D 274 268 END DO 275 269 … … 322 316 DO jn = 1, jptra 323 317 IF( ln_trdtrc(jn) ) & 324 tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * tr n(:,:,jk,jn)318 tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * tr(:,:,jk,jn,Kmm) 325 319 END DO 326 320 END DO … … 328 322 ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window 329 323 ! ------------------------------------------------------------------------ 330 IF( kt == nittrc000 + nn_dttrc) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) ???324 IF( kt == nittrc000 + 1 ) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) ??? 331 325 ! 332 326 DO jn = 1, jptra … … 408 402 DO jn = 1, jptra 409 403 IF( ln_trdtrc(jn) ) THEN 410 !-- Compute total trends (use rdttrc instead of rdt ???)404 !-- Compute total trends 411 405 IF ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) THEN ! EULER-FORWARD schemes 412 ztmltot(:,:,jn) = ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/r dt406 ztmltot(:,:,jn) = ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/rn_Dt 413 407 ELSE ! LEAP-FROG schemes 414 ztmltot(:,:,jn) = ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn))/(2.*r dt)408 ztmltot(:,:,jn) = ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn))/(2.*rn_Dt) 415 409 ENDIF 416 410 … … 431 425 432 426 #if defined key_diainstant 433 STOP 'tmltrd_trc : key_diainstant was never checked within trdmxl. Comment this to proceed.'427 CALL ctl_stop( 'STOP', 'tmltrd_trc : key_diainstant was never checked within trdmxl. Comment this to proceed.' ) 434 428 #endif 435 429 ENDIF … … 446 440 IF( ln_trdtrc(jn) ) THEN 447 441 tml_sum_trc(:,:,jn) = tmlbn_trc(:,:,jn) + 2 * ( tml_sum_trc(:,:,jn) - tml_trc(:,:,jn) ) + tml_trc(:,:,jn) 448 ztmltot2 (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) / ( 2.*r dt ) ! now tracer unit is /sec442 ztmltot2 (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) / ( 2.*rn_Dt ) ! now tracer unit is /sec 449 443 ENDIF 450 444 END DO … … 857 851 # if defined key_diainstant 858 852 IF( .NOT. ln_trdmxl_trc_instant ) THEN 859 STOP 'trd_mxl_trc : this was never checked. Comment this line to proceed...'860 ENDIF 861 zsto = nn_trd_trc * r dt853 CALL ctl_stop( 'STOP', 'trd_mxl_trc : this was never checked. Comment this line to proceed...' ) 854 ENDIF 855 zsto = nn_trd_trc * rn_Dt 862 856 clop = "inst("//TRIM(clop)//")" 863 857 # else 864 858 IF( ln_trdmxl_trc_instant ) THEN 865 zsto = r dt ! inst. diags : we use IOIPSL time averaging859 zsto = rn_Dt ! inst. diags : we use IOIPSL time averaging 866 860 ELSE 867 zsto = nn_trd_trc * r dt ! mean diags : we DO NOT use any IOIPSL time averaging861 zsto = nn_trd_trc * rn_Dt ! mean diags : we DO NOT use any IOIPSL time averaging 868 862 ENDIF 869 863 clop = "ave("//TRIM(clop)//")" 870 864 # endif 871 zout = nn_trd_trc * r dt872 iiter = ( nittrc000 - 1 ) / nn_dttrc865 zout = nn_trd_trc * rn_Dt 866 iiter = nittrc000 - 1 873 867 874 868 IF(lwp) WRITE (numout,*) ' netCDF initialization' … … 876 870 ! II.2 Compute julian date from starting date of the run 877 871 ! ------------------------------------------------------ 878 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian )872 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 879 873 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 880 874 IF(lwp) WRITE(numout,*)' ' … … 908 902 CALL dia_nam( clhstnam, nn_trd_trc, csuff ) 909 903 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 910 & 1, jpi, 1, jpj, iiter, zjulian, r dt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set )904 & 1, jpi, 1, jpj, iiter, zjulian, rn_Dt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 911 905 912 906 !-- Define the ML depth variable … … 928 922 !-- Define miscellaneous passive tracer mixed-layer variables 929 923 IF( jpltrd_trc /= jpmxl_trc_atf .OR. jpltrd_trc - 1 /= jpmxl_trc_radb ) THEN 930 STOP 'Error : jpltrd_trc /= jpmxl_trc_atf .OR. jpltrd_trc - 1 /= jpmxl_trc_radb'! see below924 CALL ctl_stop( 'STOP', 'Error : jpltrd_trc /= jpmxl_trc_atf .OR. jpltrd_trc - 1 /= jpmxl_trc_radb' ) ! see below 931 925 ENDIF 932 926 … … 945 939 CALL histdef(nidtrd(jn), trim(clvar)//trim(ctrd_trc(jl,2)), clmxl//" "//clvar//ctrd_trc(jl,1), & 946 940 & cltrcu, jpi, jpj, nh_t(jn), 1 , 1, 1 , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean 947 END DO ! if zsto=r dt above941 END DO ! if zsto=rn_Dt above 948 942 949 943 CALL histdef(nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmxl_trc_radb,2)), clmxl//" "//clvar//ctrd_trc(jpmxl_trc_radb,1), & … … 970 964 !!---------------------------------------------------------------------- 971 965 CONTAINS 972 SUBROUTINE trd_mxl_trc( kt ) ! Empty routine966 SUBROUTINE trd_mxl_trc( kt, Kmm ) ! Empty routine 973 967 INTEGER, INTENT( in) :: kt 968 INTEGER, INTENT( in) :: Kmm ! time level index 974 969 WRITE(*,*) 'trd_mxl_trc: You should not have seen this print! error?', kt 975 970 END SUBROUTINE trd_mxl_trc 976 SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn )971 SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm ) 977 972 INTEGER , INTENT( in ) :: ktrd, kjn ! ocean trend index and passive tracer rank 973 INTEGER , INTENT( in ) :: Kmm ! time level index 978 974 CHARACTER(len=2) , INTENT( in ) :: ctype ! surface/bottom (2D) or interior (3D) physics 979 975 REAL, DIMENSION(:,:,:), INTENT( in ) :: ptrc_trdmxl ! passive trc trend -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trdmxl_trc_rst.F90
r10425 r13463 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 … … 144 144 145 145 DO jn = 1, jptra 146 CALL iom_get( inum, jpdom_auto glo, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) )147 CALL iom_get( inum, jpdom_auto glo, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) )148 CALL iom_get( inum, jpdom_auto glo, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) )149 CALL iom_get( inum, jpdom_auto glo, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) )146 CALL iom_get( inum, jpdom_auto, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) ) 147 CALL iom_get( inum, jpdom_auto, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) ) 148 CALL iom_get( inum, jpdom_auto, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 149 CALL iom_get( inum, jpdom_auto, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) ) 150 150 END DO 151 151 152 152 ELSE 153 CALL iom_get( inum, jpdom_auto glo, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum153 CALL iom_get( inum, jpdom_auto, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum 154 154 155 155 ! ! =========== 156 156 DO jn = 1, jptra ! tracer loop 157 157 ! ! =========== 158 CALL iom_get( inum, jpdom_auto glo, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) )159 CALL iom_get( inum, jpdom_auto glo, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) )160 CALL iom_get( inum, jpdom_auto glo, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) )161 162 CALL iom_get( inum, jpdom_auto glo, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) ) ! needed for tml_sum163 CALL iom_get( inum, jpdom_auto glo, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) )158 CALL iom_get( inum, jpdom_auto, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 159 CALL iom_get( inum, jpdom_auto, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) ) 160 CALL iom_get( inum, jpdom_auto, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) ) 161 162 CALL iom_get( inum, jpdom_auto, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) ) ! needed for tml_sum 163 CALL iom_get( inum, jpdom_auto, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) ) 164 164 165 165 DO jk = 1, jpltrd_trc … … 169 169 WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I2)") ctrcnm(jn), jk 170 170 ENDIF 171 CALL iom_get( inum, jpdom_auto glo, charout, tmltrd_csum_ub_trc(:,:,jk,jn) )171 CALL iom_get( inum, jpdom_auto, charout, tmltrd_csum_ub_trc(:,:,jk,jn) ) 172 172 END DO 173 173 174 CALL iom_get( inum, jpdom_auto glo, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , &174 CALL iom_get( inum, jpdom_auto, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , & 175 175 & tmltrd_atf_sumb_trc(:,:,jn) ) 176 176 177 CALL iom_get( inum, jpdom_auto glo, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , &177 CALL iom_get( inum, jpdom_auto, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , & 178 178 & tmltrd_rad_sumb_trc(:,:,jn) ) 179 179 ! ! =========== -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trdtrc.F90
r10096 r13463 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 18 18 USE trdmxl_trc ! Mixed layer trends diag. 19 19 USE iom ! I/O library 20 USE par_kind 20 21 21 22 IMPLICIT NONE … … 32 33 CONTAINS 33 34 34 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )35 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 35 36 !!---------------------------------------------------------------------- 36 37 !! *** ROUTINE trd_trc *** 37 38 !!---------------------------------------------------------------------- 38 39 INTEGER, INTENT( in ) :: kt ! time step 40 INTEGER, INTENT( in ) :: Kmm ! time level index 39 41 INTEGER, INTENT( in ) :: kjn ! tracer index 40 42 INTEGER, INTENT( in ) :: ktrd ! tracer trend index … … 56 58 ! 57 59 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 )60 CASE ( jptra_xad ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn, Kmm ) 61 CASE ( jptra_yad ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn, Kmm ) 62 CASE ( jptra_zad ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn, Kmm ) 63 CASE ( jptra_ldf ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn, Kmm ) 64 CASE ( jptra_bbl ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn, Kmm ) 63 65 CASE ( jptra_zdf ) 64 66 IF( ln_trcldf_iso ) THEN 65 CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )67 CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn, Kmm ) 66 68 ELSE 67 CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn )69 CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn, Kmm ) 68 70 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 )71 CASE ( jptra_dmp ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn, Kmm ) 72 CASE ( jptra_nsr ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn, Kmm ) 73 CASE ( jptra_sms ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn, Kmm ) 74 CASE ( jptra_radb ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn, Kmm ) 75 CASE ( jptra_radn ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn, Kmm ) 76 CASE ( jptra_atf ) ; CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn, Kmm ) 75 77 END SELECT 76 78 ! … … 106 108 !!---------------------------------------------------------------------- 107 109 110 USE par_kind 111 108 112 PUBLIC trd_trc 109 113 110 114 CONTAINS 111 115 112 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )116 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 113 117 INTEGER , INTENT( in ) :: kt ! time step 118 INTEGER , INTENT( in ) :: Kmm ! time level index 114 119 INTEGER , INTENT( in ) :: kjn ! tracer index 115 120 INTEGER , INTENT( in ) :: ktrd ! tracer trend index 116 REAL , DIMENSION(:,:,:), INTENT( inout ) :: ptrtrd ! Temperature or U trend121 REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: ptrtrd ! Temperature or U trend 117 122 WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) 118 123 WRITE(*,*) ' " " : You should not have seen this print! error?', kjn
Note: See TracChangeset
for help on using the changeset viewer.
