Changeset 9019 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC
- Timestamp:
- 2017-12-13T15:58:53+01:00 (6 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
r7981 r9019 119 119 ! ! -------------- 120 120 neln(:,:) = 1 ! euphotic layer level 121 DO jk = 1, jpkm1 121 DO jk = 1, jpkm1 ! (i.e. 1rst T-level strictly below EL bottom) 122 122 DO jj = 1, jpj 123 123 DO ji = 1, jpi … … 147 147 END SUBROUTINE p2z_opt 148 148 149 149 150 SUBROUTINE p2z_opt_init 150 151 !!---------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r7753 r9019 7 7 !! 3.0 ! 2010-06 (C. Ethe) Adapted to passive tracers 8 8 !! 3.7 ! 2014-05 (G. Madec, C. Ethe) Add 2nd/4th order cases for CEN and FCT schemes 9 !! 4.0 ! 2017-09 (G. Madec) remove vertical time-splitting option 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_top … … 17 18 USE oce_trc ! ocean dynamics and active tracers 18 19 USE trc ! ocean passive tracers variables 20 USE sbcwave ! wave module 21 USE sbc_oce ! surface boundary condition: ocean 19 22 USE traadv_cen ! centered scheme (tra_adv_cen routine) 20 23 USE traadv_fct ! FCT scheme (tra_adv_fct routine) … … 23 26 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) 24 27 USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine) 25 USE ldftra ! lateral diffusion coefficient on tracers28 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 26 29 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 27 30 ! 28 USE prtctl_trc ! Print control 31 USE prtctl_trc ! control print 32 USE timing ! Timing 29 33 30 34 IMPLICIT NONE 31 35 PRIVATE 32 36 33 PUBLIC trc_adv 34 PUBLIC trc_adv_ini 37 PUBLIC trc_adv ! called by trctrp.F90 38 PUBLIC trc_adv_ini ! called by trcini.F90 35 39 36 40 ! !!* Namelist namtrc_adv * 41 LOGICAL :: ln_trcadv_NONE ! no advection on passive tracers 37 42 LOGICAL :: ln_trcadv_cen ! centered scheme flag 38 43 INTEGER :: nn_cen_h, nn_cen_v ! =2/4 : horizontal and vertical choices of the order of CEN scheme 39 44 LOGICAL :: ln_trcadv_fct ! FCT scheme flag 40 45 INTEGER :: nn_fct_h, nn_fct_v ! =2/4 : horizontal and vertical choices of the order of FCT scheme 41 INTEGER :: nn_fct_zts ! >=1 : 2nd order FCT with vertical sub-timestepping42 46 LOGICAL :: ln_trcadv_mus ! MUSCL scheme flag 43 47 LOGICAL :: ln_mus_ups ! use upstream scheme in vivcinity of river mouths … … 46 50 LOGICAL :: ln_trcadv_qck ! QUICKEST scheme flag 47 51 48 ! ! choices of advection scheme: 52 INTEGER :: nadv ! choice of the type of advection scheme 53 ! ! associated indices: 49 54 INTEGER, PARAMETER :: np_NO_adv = 0 ! no T-S advection 50 55 INTEGER, PARAMETER :: np_CEN = 1 ! 2nd/4th order centered scheme 51 56 INTEGER, PARAMETER :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme 52 INTEGER, PARAMETER :: np_FCT_zts = 3 ! 2nd order FCT scheme with vertical sub-timestepping 53 INTEGER, PARAMETER :: np_MUS = 4 ! MUSCL scheme 54 INTEGER, PARAMETER :: np_UBS = 5 ! 3rd order Upstream Biased Scheme 55 INTEGER, PARAMETER :: np_QCK = 6 ! QUICK scheme 56 57 INTEGER :: nadv ! chosen advection scheme 58 ! 57 INTEGER, PARAMETER :: np_MUS = 3 ! MUSCL scheme 58 INTEGER, PARAMETER :: np_UBS = 4 ! 3rd order Upstream Biased Scheme 59 INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme 60 59 61 !! * Substitutions 60 62 # include "vectopt_loop_substitute.h90" 61 63 !!---------------------------------------------------------------------- 62 !! NEMO/TOP 3.7 , NEMO Consortium (2015)64 !! NEMO/TOP 4.0 , NEMO Consortium (2017) 63 65 !! $Id$ 64 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)66 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 65 67 !!---------------------------------------------------------------------- 66 68 CONTAINS … … 72 74 !! ** Purpose : compute the ocean tracer advection trend. 73 75 !! 74 !! ** Method : - Update the tracerwith the advection term following nadv76 !! ** Method : - Update after tracers (tra) with the advection term following nadv 75 77 !!---------------------------------------------------------------------- 76 78 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 78 80 INTEGER :: jk ! dummy loop index 79 81 CHARACTER (len=22) :: charout 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn ! effective velocity 81 !!---------------------------------------------------------------------- 82 ! 83 IF( nn_timing == 1 ) CALL timing_start('trc_adv') 84 ! 85 CALL wrk_alloc( jpi,jpj,jpk, zun, zvn, zwn ) 86 ! !== effective transport ==! 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! effective velocity 83 !!---------------------------------------------------------------------- 84 ! 85 IF( ln_timing ) CALL timing_start('trc_adv') 86 ! 87 ! !== effective transport ==! 87 88 IF( l_offline ) THEN 88 zun(:,:,:) = un(:,:,:) ! effective transport already in un/vn/wn89 zun(:,:,:) = un(:,:,:) ! already in (un,vn,wn) 89 90 zvn(:,:,:) = vn(:,:,:) 90 91 zwn(:,:,:) = wn(:,:,:) 91 ELSE 92 ! 93 DO jk = 1, jpkm1 94 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport 95 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 96 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 97 END DO 92 ELSE ! build the effective transport 93 zun(:,:,jpk) = 0._wp 94 zvn(:,:,jpk) = 0._wp 95 zwn(:,:,jpk) = 0._wp 96 IF( ln_wave .AND. ln_sdw ) THEN 97 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift 98 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) ) 99 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) ) 100 zwn(:,:,jk) = e1e2t(:,:) * ( wn(:,:,jk) + wsd(:,:,jk) ) 101 END DO 102 ELSE 103 DO jk = 1, jpkm1 104 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport 105 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 106 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 107 END DO 108 ENDIF 98 109 ! 99 110 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections … … 107 118 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport 108 119 ! 109 zun(:,:,jpk) = 0._wp ! no transport trough the bottom110 zvn(:,:,jpk) = 0._wp111 zwn(:,:,jpk) = 0._wp112 !113 120 ENDIF 114 121 ! 115 122 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 116 123 ! 117 CASE ( np_CEN ) ! Centered : 2nd / 4th order 118 CALL tra_adv_cen ( kt, nittrc000,'TRC', zun, zvn, zwn , trn, tra, jptra, nn_cen_h, nn_cen_v ) 119 CASE ( np_FCT ) ! FCT : 2nd / 4th order 120 CALL tra_adv_fct ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 121 CASE ( np_FCT_zts ) ! 2nd order FCT with vertical time-splitting 122 CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra , nn_fct_zts ) 123 CASE ( np_MUS ) ! MUSCL 124 CALL tra_adv_mus ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, tra, jptra , ln_mus_ups ) 125 CASE ( np_UBS ) ! UBS 126 CALL tra_adv_ubs ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra , nn_ubs_v ) 127 CASE ( np_QCK ) ! QUICKEST 128 CALL tra_adv_qck ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) 124 CASE ( np_CEN ) ! Centered : 2nd / 4th order 125 CALL tra_adv_cen( kt, nittrc000,'TRC', zun, zvn, zwn , trn, tra, jptra, nn_cen_h, nn_cen_v ) 126 CASE ( np_FCT ) ! FCT : 2nd / 4th order 127 CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 128 CASE ( np_MUS ) ! MUSCL 129 CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, tra, jptra , ln_mus_ups ) 130 CASE ( np_UBS ) ! UBS 131 CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra , nn_ubs_v ) 132 CASE ( np_QCK ) ! QUICKEST 133 CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) 129 134 ! 130 135 END SELECT 131 136 ! 132 IF( ln_ctl ) THEN !== print mean trends (used for debugging) 133 WRITE(charout, FMT="('adv ')") ; CALL prt_ctl_trc_info(charout) 134 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 137 IF( ln_ctl ) THEN !== print mean trends (used for debugging) 138 WRITE(charout, FMT="('adv ')") 139 CALL prt_ctl_trc_info(charout) 140 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 135 141 END IF 136 142 ! 137 CALL wrk_dealloc( jpi,jpj,jpk, zun, zvn, zwn ) 138 ! 139 IF( nn_timing == 1 ) CALL timing_stop('trc_adv') 143 IF( ln_timing ) CALL timing_stop('trc_adv') 140 144 ! 141 145 END SUBROUTINE trc_adv … … 146 150 !! *** ROUTINE trc_adv_ini *** 147 151 !! 148 !! ** Purpose : Control the consistency between namelist options for152 !! ** Purpose : Control the consistency between namelist options for 149 153 !! passive tracer advection schemes and set nadv 150 154 !!---------------------------------------------------------------------- … … 152 156 INTEGER :: ios ! Local integer output status for namelist read 153 157 !! 154 NAMELIST/namtrc_adv/ ln_trcadv_cen, nn_cen_h, nn_cen_v, & ! CEN 155 & ln_trcadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts, & ! FCT 156 & ln_trcadv_mus, ln_mus_ups, & ! MUSCL 157 & ln_trcadv_ubs, nn_ubs_v, & ! UBS 158 & ln_trcadv_qck ! QCK 159 !!---------------------------------------------------------------------- 160 ! 161 REWIND( numnat_ref ) ! namtrc_adv in reference namelist 158 NAMELIST/namtrc_adv/ ln_trcadv_NONE, & ! No advection 159 & ln_trcadv_cen, nn_cen_h, nn_cen_v, & ! CEN 160 & ln_trcadv_fct, nn_fct_h, nn_fct_v, & ! FCT 161 & ln_trcadv_mus, ln_mus_ups, & ! MUSCL 162 & ln_trcadv_ubs, nn_ubs_v, & ! UBS 163 & ln_trcadv_qck ! QCK 164 !!---------------------------------------------------------------------- 165 ! 166 ! !== Namelist ==! 167 REWIND( numnat_ref ) ! namtrc_adv in reference namelist 162 168 READ ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 163 169 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 164 165 REWIND( numnat_cfg ) ! namtrc_adv in configuration namelist170 ! 171 REWIND( numnat_cfg ) ! namtrc_adv in configuration namelist 166 172 READ ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 167 173 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 168 174 IF(lwm) WRITE ( numont, namtrc_adv ) 169 170 IF(lwp) THEN ! Namelist print175 ! 176 IF(lwp) THEN ! Namelist print 171 177 WRITE(numout,*) 172 178 WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme' 173 179 WRITE(numout,*) '~~~~~~~~~~~' 174 180 WRITE(numout,*) ' Namelist namtrc_adv : chose a advection scheme for tracers' 181 WRITE(numout,*) ' No advection on passive tracers ln_trcadv_NONE= ', ln_trcadv_NONE 175 182 WRITE(numout,*) ' centered scheme ln_trcadv_cen = ', ln_trcadv_cen 176 183 WRITE(numout,*) ' horizontal 2nd/4th order nn_cen_h = ', nn_fct_h … … 179 186 WRITE(numout,*) ' horizontal 2nd/4th order nn_fct_h = ', nn_fct_h 180 187 WRITE(numout,*) ' vertical 2nd/4th order nn_fct_v = ', nn_fct_v 181 WRITE(numout,*) ' 2nd order + vertical sub-timestepping nn_fct_zts = ', nn_fct_zts182 188 WRITE(numout,*) ' MUSCL scheme ln_trcadv_mus = ', ln_trcadv_mus 183 189 WRITE(numout,*) ' + upstream scheme near river mouths ln_mus_ups = ', ln_mus_ups … … 187 193 ENDIF 188 194 ! 189 190 ioptio = 0 !== Parameter control ==! 191 IF( ln_trcadv_cen ) ioptio = ioptio + 1 192 IF( ln_trcadv_fct ) ioptio = ioptio + 1 193 IF( ln_trcadv_mus ) ioptio = ioptio + 1 194 IF( ln_trcadv_ubs ) ioptio = ioptio + 1 195 IF( ln_trcadv_qck ) ioptio = ioptio + 1 196 197 ! 198 IF( ioptio == 0 ) THEN 199 nadv = np_NO_adv 200 CALL ctl_warn( 'trc_adv_init: You are running without tracer advection.' ) 201 ENDIF 202 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' ) 195 ! !== Parameter control & set nadv ==! 196 ioptio = 0 197 IF( ln_trcadv_NONE ) THEN ; ioptio = ioptio + 1 ; nadv = np_NO_adv ; ENDIF 198 IF( ln_trcadv_cen ) THEN ; ioptio = ioptio + 1 ; nadv = np_CEN ; ENDIF 199 IF( ln_trcadv_fct ) THEN ; ioptio = ioptio + 1 ; nadv = np_FCT ; ENDIF 200 IF( ln_trcadv_mus ) THEN ; ioptio = ioptio + 1 ; nadv = np_MUS ; ENDIF 201 IF( ln_trcadv_ubs ) THEN ; ioptio = ioptio + 1 ; nadv = np_UBS ; ENDIF 202 IF( ln_trcadv_qck ) THEN ; ioptio = ioptio + 1 ; nadv = np_QCK ; ENDIF 203 ! 204 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_adv_ini: Choose ONE advection option in namelist namtrc_adv' ) 203 205 ! 204 206 IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 ) & 205 207 .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 ) ) THEN 206 CALL ctl_stop( 'trc_adv_ini t: CEN scheme, choose 2nd or 4th order' )208 CALL ctl_stop( 'trc_adv_ini: CEN scheme, choose 2nd or 4th order' ) 207 209 ENDIF 208 210 IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 ) & 209 211 .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 ) ) THEN 210 CALL ctl_stop( 'trc_adv_init: FCT scheme, choose 2nd or 4th order' ) 211 ENDIF 212 IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) THEN 213 IF( nn_fct_h == 4 ) THEN 214 nn_fct_h = 2 215 CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 216 ENDIF 217 IF( .NOT.ln_linssh ) THEN 218 CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 219 ENDIF 220 IF( nn_fct_zts == 1 ) CALL ctl_warn( 'trc_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' ) 212 CALL ctl_stop( 'trc_adv_ini: FCT scheme, choose 2nd or 4th order' ) 221 213 ENDIF 222 214 IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 ) ) THEN 223 CALL ctl_stop( 'trc_adv_ini t: UBS scheme, choose 2nd or 4th order' )215 CALL ctl_stop( 'trc_adv_ini: UBS scheme, choose 2nd or 4th order' ) 224 216 ENDIF 225 217 IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN 226 CALL ctl_warn( 'trc_adv_ini t: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )218 CALL ctl_warn( 'trc_adv_ini: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' ) 227 219 ENDIF 228 220 IF( ln_isfcav ) THEN ! ice-shelf cavities 229 IF( ln_trcadv_cen .AND. nn_cen_v /= 4 .OR. & ! NO 4th order with ISF 230 & ln_trcadv_fct .AND. nn_fct_v /= 4 ) CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' ) 231 ENDIF 232 ! 233 ! !== used advection scheme ==! 234 ! ! set nadv 235 IF( ln_trcadv_cen ) nadv = np_CEN 236 IF( ln_trcadv_fct ) nadv = np_FCT 237 IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) nadv = np_FCT_zts 238 IF( ln_trcadv_mus ) nadv = np_MUS 239 IF( ln_trcadv_ubs ) nadv = np_UBS 240 IF( ln_trcadv_qck ) nadv = np_QCK 241 ! 242 IF(lwp) THEN ! Print the choice 221 IF( ln_trcadv_cen .AND. nn_cen_v == 4 .OR. & ! NO 4th order with ISF 222 & ln_trcadv_fct .AND. nn_fct_v == 4 ) CALL ctl_stop( 'tra_adv_ini: 4th order COMPACT scheme not allowed with ISF' ) 223 ENDIF 224 ! 225 ! !== Print the choice ==! 226 IF(lwp) THEN 243 227 WRITE(numout,*) 244 IF( nadv == np_NO_adv ) WRITE(numout,*) ' NO passive tracer advection' 245 IF( nadv == np_CEN ) WRITE(numout,*) ' CEN scheme is used. Horizontal order: ', nn_cen_h, & 246 & ' Vertical order: ', nn_cen_v 247 IF( nadv == np_FCT ) WRITE(numout,*) ' FCT scheme is used. Horizontal order: ', nn_fct_h, & 248 & ' Vertical order: ', nn_fct_v 249 IF( nadv == np_FCT_zts ) WRITE(numout,*) ' use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 250 IF( nadv == np_MUS ) WRITE(numout,*) ' MUSCL scheme is used' 251 IF( nadv == np_UBS ) WRITE(numout,*) ' UBS scheme is used' 252 IF( nadv == np_QCK ) WRITE(numout,*) ' QUICKEST scheme is used' 228 SELECT CASE ( nadv ) 229 CASE( np_NO_adv ) ; WRITE(numout,*) ' ===>> NO passive tracer advection' 230 CASE( np_CEN ) ; WRITE(numout,*) ' ===>> CEN scheme is used. Horizontal order: ', nn_cen_h, & 231 & ' Vertical order: ', nn_cen_v 232 CASE( np_FCT ) ; WRITE(numout,*) ' ===>> FCT scheme is used. Horizontal order: ', nn_fct_h, & 233 & ' Vertical order: ', nn_fct_v 234 CASE( np_MUS ) ; WRITE(numout,*) ' ===>> MUSCL scheme is used' 235 CASE( np_UBS ) ; WRITE(numout,*) ' ===>> UBS scheme is used' 236 CASE( np_QCK ) ; WRITE(numout,*) ' ===>> QUICKEST scheme is used' 237 END SELECT 253 238 ENDIF 254 239 ! 255 240 END SUBROUTINE trc_adv_ini 256 241 257 #else258 !!----------------------------------------------------------------------259 !! Default option Empty module260 !!----------------------------------------------------------------------261 CONTAINS262 SUBROUTINE trc_adv( kt )263 INTEGER, INTENT(in) :: kt264 WRITE(*,*) 'trc_adv: You should not have seen this print! error?', kt265 END SUBROUTINE trc_adv266 242 #endif 267 243 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r7753 r9019 5 5 !! layer scheme 6 6 !!====================================================================== 7 !!==============================================================================8 7 !! History : OPA ! 1996-06 (L. Mortier) Original code 9 8 !! 8.0 ! 1997-11 (G. Madec) Optimization … … 13 12 !! - ! 2010-04 (G. Madec) Campin & Goosse advective bbl 14 13 !! - ! 2010-06 (C. Ethe, G. Madec) merge TRA-TRC 14 !! 4.0 ! 2017-04 (G. Madec) ln_trabbl namelist variable instead of a CPP key 15 15 !!---------------------------------------------------------------------- 16 #if defined key_top && defined key_trabbl16 #if defined key_top 17 17 !!---------------------------------------------------------------------- 18 !! 'key_t rabbl diffusive or/and adevective bottom boundary layer18 !! 'key_top' TOP models 19 19 !!---------------------------------------------------------------------- 20 !! trc_bbl 20 !! trc_bbl : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 21 21 !!---------------------------------------------------------------------- 22 USE oce_trc 23 USE trc 24 USE tr abbl !25 USE prtctl_trc ! Print control for debbuging26 USE tr d_oce27 USE trdtra22 USE oce_trc ! ocean dynamics and active tracers variables 23 USE trc ! ocean passive tracers variables 24 USE trd_oce ! trends: ocean variables 25 USE trdtra ! tracer trends 26 USE trabbl ! bottom boundary layer 27 USE prtctl_trc ! Print control for debbuging 28 28 29 PUBLIC trc_bbl ! routine called by step.F9029 PUBLIC trc_bbl ! routine called by trctrp.F90 30 30 31 31 !!---------------------------------------------------------------------- 32 !! NEMO/TOP 3.3 , NEMO Consortium (2010)32 !! NEMO/TOP 4.0 , NEMO Consortium (2017) 33 33 !! $Id$ 34 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 35 35 !!---------------------------------------------------------------------- 36 37 36 CONTAINS 38 39 37 40 38 SUBROUTINE trc_bbl( kt ) … … 73 71 ENDIF 74 72 ! 75 END 73 ENDIF 76 74 77 75 !* Advective bbl : bbl upstream advective trends added to the tracer trends … … 84 82 ENDIF 85 83 ! 86 END 84 ENDIF 87 85 88 86 IF( l_trdtrc ) THEN ! save the horizontal diffusive trends for further diagnostics … … 98 96 END SUBROUTINE trc_bbl 99 97 100 #else101 !!----------------------------------------------------------------------102 !! Dummy module : No bottom boundary layer scheme103 !!----------------------------------------------------------------------104 CONTAINS105 SUBROUTINE trc_bbl( kt ) ! Empty routine106 WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt107 END SUBROUTINE trc_bbl108 98 #endif 109 99 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r7646 r9019 121 121 DO jj = 2, jpjm1 122 122 DO ji = fs_2, fs_jpim1 ! vector opt. 123 IF( av t(ji,jj,jk) <= 5.e-4_wp ) THEN123 IF( avs(ji,jj,jk) <= 5.e-4_wp ) THEN 124 124 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 125 125 ENDIF … … 222 222 ! 223 223 ENDIF 224 IF( nn_timing == 1 ) CALL timing_stop('trc_dmp_ini t')224 IF( nn_timing == 1 ) CALL timing_stop('trc_dmp_ini') 225 225 ! 226 226 END SUBROUTINE trc_dmp_ini -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r7753 r9019 17 17 USE trc ! ocean passive tracers variables 18 18 USE oce_trc ! ocean dynamics and active tracers 19 USE ldfslp ! lateral diffusion: iso-neutral slope 19 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 20 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 20 21 USE traldf_lap_blp ! lateral diffusion: lap/bilaplacian iso-level operator (tra_ldf_lap/_blp routine) 21 22 USE traldf_iso ! lateral diffusion: laplacian iso-neutral standard operator (tra_ldf_iso routine) … … 32 33 PUBLIC trc_ldf_ini 33 34 ! 35 LOGICAL , PUBLIC :: ln_trcldf_NONE !: No operator (no explicit lateral diffusion) 34 36 LOGICAL , PUBLIC :: ln_trcldf_lap !: laplacian operator 35 37 LOGICAL , PUBLIC :: ln_trcldf_blp !: bilaplacian operator … … 45 47 REAL(wp) :: rldf ! ratio between active and passive tracers diffusive coefficient 46 48 47 INTEGER :: nldf = 0! type of lateral diffusion used defined from ln_trcldf_... namlist logicals)49 INTEGER :: nldf ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 48 50 49 51 !! * Substitutions … … 98 100 CASE ( np_lap ) ! iso-level laplacian 99 101 CALL tra_ldf_lap ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, 1 ) 100 !101 102 CASE ( np_lap_i ) ! laplacian : standard iso-neutral operator (Madec) 102 103 CALL tra_ldf_iso ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 ) 103 !104 104 CASE ( np_lap_it ) ! laplacian : triad iso-neutral operator (griffies) 105 105 CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 ) 106 !107 106 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: all operator (iso-level, -neutral) 108 107 CALL tra_ldf_blp ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb , tra, jptra, nldf ) 109 !110 108 END SELECT 111 109 ! … … 148 146 NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp, & 149 147 & ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad, & 150 & rn_ahtrc_0 , rn_bhtrc_0 , rn_fact_lap148 & rn_ahtrc_0 , rn_bhtrc_0 , rn_fact_lap 151 149 !!---------------------------------------------------------------------- 152 150 ! … … 166 164 WRITE(numout,*) ' Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)' 167 165 WRITE(numout,*) ' operator' 166 WRITE(numout,*) ' no explicit diffusion ln_trcldf_NONE = ', ln_trcldf_NONE 168 167 WRITE(numout,*) ' laplacian ln_trcldf_lap = ', ln_trcldf_lap 169 168 WRITE(numout,*) ' bilaplacian ln_trcldf_blp = ', ln_trcldf_blp … … 182 181 ! ! control the namelist parameters 183 182 ioptio = 0 184 IF( ln_trcldf_ lap ) ioptio = ioptio + 1185 IF( ln_trcldf_ blp ) ioptio = ioptio + 1186 IF( ioptio > 1 ) CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' )187 IF( ioptio == 0 ) nldf = np_no_ldf ! No lateral diffusion183 IF( ln_trcldf_NONE ) THEN ; nldf = np_no_ldf ; ioptio = ioptio + 1 ; ENDIF 184 IF( ln_trcldf_lap ) THEN ; ioptio = ioptio + 1 ; ENDIF 185 IF( ln_trcldf_blp ) THEN ; ioptio = ioptio + 1 ; ENDIF 186 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_ldf_ini: use ONE of the 3 operator options (NONE/lap/blp)' ) 188 187 189 IF( ln_trcldf_lap .AND. ln_trcldf_blp ) CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' ) 190 IF( ln_trcldf_blp .AND. ln_trcldf_lap ) CALL ctl_stop( 'trc_ldf_ctl: laplacian should be used on both TRC and TRA' ) 191 ! 192 ioptio = 0 193 IF( ln_trcldf_lev ) ioptio = ioptio + 1 194 IF( ln_trcldf_hor ) ioptio = ioptio + 1 195 IF( ln_trcldf_iso ) ioptio = ioptio + 1 196 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 197 ! 198 ! defined the type of lateral diffusion from ln_trcldf_... logicals 199 ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 200 ierr = 0 201 IF( ln_trcldf_lap ) THEN !== laplacian operator ==! 202 IF ( ln_zco ) THEN ! z-coordinate 203 IF ( ln_trcldf_lev ) nldf = np_lap ! iso-level = horizontal (no rotation) 204 IF ( ln_trcldf_hor ) nldf = np_lap ! iso-level = horizontal (no rotation) 205 IF ( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard ( rotation) 206 IF ( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad ( rotation) 188 IF( ln_trcldf_lap .AND. .NOT.ln_traldf_lap ) CALL ctl_stop( 'trc_ldf_ini: laplacian should be used on both TRC and TRA' ) 189 IF( ln_trcldf_blp .AND. .NOT.ln_traldf_blp ) CALL ctl_stop( 'trc_ldf_ini: bilaplacian should be used on both TRC and TRA' ) 190 ! 191 IF( .NOT.ln_trcldf_NONE ) THEN ! direction ==>> type of operator 192 ioptio = 0 193 IF( ln_trcldf_lev ) ioptio = ioptio + 1 194 IF( ln_trcldf_hor ) ioptio = ioptio + 1 195 IF( ln_trcldf_iso ) ioptio = ioptio + 1 196 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_ldf_ini: use ONE direction (level/hor/iso)' ) 197 ! 198 ! defined the type of lateral diffusion from ln_trcldf_... logicals 199 ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 200 ierr = 0 201 IF( ln_trcldf_lap ) THEN !== laplacian operator ==! 202 IF( ln_zco ) THEN ! z-coordinate 203 IF( ln_trcldf_lev ) nldf = np_lap ! iso-level = horizontal (no rotation) 204 IF( ln_trcldf_hor ) nldf = np_lap ! iso-level = horizontal (no rotation) 205 IF( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard ( rotation) 206 IF( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad ( rotation) 207 ENDIF 208 IF( ln_zps ) THEN ! z-coordinate with partial step 209 IF( ln_trcldf_lev ) ierr = 1 ! iso-level not allowed 210 IF( ln_trcldf_hor ) nldf = np_lap ! horizontal (no rotation) 211 IF( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard (rotation) 212 IF( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad (rotation) 213 ENDIF 214 IF( ln_sco ) THEN ! s-coordinate 215 IF( ln_trcldf_lev ) nldf = np_lap ! iso-level (no rotation) 216 IF( ln_trcldf_hor ) nldf = np_lap_it ! horizontal ( rotation) !!gm a checker.... 217 IF( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard (rotation) 218 IF( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad (rotation) 219 ENDIF 220 ! ! diffusivity ratio: passive / active tracers 221 IF( ABS(rn_aht_0) < 2._wp*TINY(1._wp) ) THEN 222 IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1._wp) ) THEN 223 rldf = 1.0_wp 224 ELSE 225 CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 226 ENDIF 227 ELSE 228 rldf = rn_ahtrc_0 / rn_aht_0 229 ENDIF 207 230 ENDIF 208 IF ( ln_zps ) THEN ! z-coordinate with partial step 209 IF ( ln_trcldf_lev ) ierr = 1 ! iso-level not allowed 210 IF ( ln_trcldf_hor ) nldf = np_lap ! horizontal (no rotation) 211 IF ( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard (rotation) 212 IF ( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad (rotation) 231 ! 232 IF( ln_trcldf_blp ) THEN !== bilaplacian operator ==! 233 IF ( ln_zco ) THEN ! z-coordinate 234 IF ( ln_trcldf_lev ) nldf = np_blp ! iso-level = horizontal (no rotation) 235 IF ( ln_trcldf_hor ) nldf = np_blp ! iso-level = horizontal (no rotation) 236 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 237 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 238 ENDIF 239 IF ( ln_zps ) THEN ! z-coordinate with partial step 240 IF ( ln_trcldf_lev ) ierr = 1 ! iso-level not allowed 241 IF ( ln_trcldf_hor ) nldf = np_blp ! horizontal (no rotation) 242 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 243 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 244 ENDIF 245 IF ( ln_sco ) THEN ! s-coordinate 246 IF ( ln_trcldf_lev ) nldf = np_blp ! iso-level (no rotation) 247 IF ( ln_trcldf_hor ) nldf = np_blp_it ! horizontal ( rotation) !!gm a checker.... 248 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 249 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 250 ENDIF 251 ! ! diffusivity ratio: passive / active tracers 252 IF( ABS(rn_bht_0) < 2._wp*TINY(1._wp) ) THEN 253 IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1._wp) ) THEN 254 rldf = 1.0_wp 255 ELSE 256 CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 257 ENDIF 258 ELSE 259 rldf = SQRT( ABS( rn_bhtrc_0 / rn_bht_0 ) ) 260 ENDIF 213 261 ENDIF 214 IF ( ln_sco ) THEN ! s-coordinate 215 IF ( ln_trcldf_lev ) nldf = np_lap ! iso-level (no rotation) 216 IF ( ln_trcldf_hor ) nldf = np_lap_it ! horizontal ( rotation) !!gm a checker.... 217 IF ( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard (rotation) 218 IF ( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad (rotation) 219 ENDIF 220 ! ! diffusivity ratio: passive / active tracers 221 IF( ABS(rn_aht_0) < 2._wp*TINY(1._wp) ) THEN 222 IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1._wp) ) THEN 223 rldf = 1.0_wp 224 ELSE 225 CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 226 ENDIF 227 ELSE 228 rldf = rn_ahtrc_0 / rn_aht_0 229 ENDIF 230 ENDIF 231 ! 232 IF( ln_trcldf_blp ) THEN !== bilaplacian operator ==! 233 IF ( ln_zco ) THEN ! z-coordinate 234 IF ( ln_trcldf_lev ) nldf = np_blp ! iso-level = horizontal (no rotation) 235 IF ( ln_trcldf_hor ) nldf = np_blp ! iso-level = horizontal (no rotation) 236 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 237 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 238 ENDIF 239 IF ( ln_zps ) THEN ! z-coordinate with partial step 240 IF ( ln_trcldf_lev ) ierr = 1 ! iso-level not allowed 241 IF ( ln_trcldf_hor ) nldf = np_blp ! horizontal (no rotation) 242 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 243 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 244 ENDIF 245 IF ( ln_sco ) THEN ! s-coordinate 246 IF ( ln_trcldf_lev ) nldf = np_blp ! iso-level (no rotation) 247 IF ( ln_trcldf_hor ) nldf = np_blp_it ! horizontal ( rotation) !!gm a checker.... 248 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 249 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 250 ENDIF 251 ! ! diffusivity ratio: passive / active tracers 252 IF( ABS(rn_bht_0) < 2._wp*TINY(1._wp) ) THEN 253 IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1._wp) ) THEN 254 rldf = 1.0_wp 255 ELSE 256 CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 257 ENDIF 258 ELSE 259 rldf = SQRT( ABS( rn_bhtrc_0 / rn_bht_0 ) ) 260 ENDIF 261 ENDIF 262 ! 263 IF( ierr == 1 ) CALL ctl_stop( 'trc_ldf_ctl: iso-level in z-partial step, not allowed' ) 264 IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso ) CALL ctl_stop( 'trc_ldf_ctl: eiv requires isopycnal laplacian diffusion' ) 262 ! 263 IF( ierr == 1 ) CALL ctl_stop( 'trc_ldf_ini: iso-level in z-partial step, not allowed' ) 264 ENDIF 265 ! 266 IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso ) CALL ctl_stop( 'trc_ldf_ini: eiv requires isopycnal laplacian diffusion' ) 265 267 IF( nldf == 1 .OR. nldf == 3 ) l_ldfslp = .TRUE. ! slope of neutral surfaces required 266 268 ! … … 268 270 WRITE(numout,*) 269 271 SELECT CASE( nldf ) 270 CASE( np_no_ldf ) ; WRITE(numout,*) ' 271 CASE( np_lap ) ; WRITE(numout,*) ' 272 CASE( np_lap_i ) ; WRITE(numout,*) ' 273 CASE( np_lap_it ) ; WRITE(numout,*) ' 274 CASE( np_blp ) ; WRITE(numout,*) ' 275 CASE( np_blp_i ) ; WRITE(numout,*) ' 276 CASE( np_blp_it ) ; WRITE(numout,*) ' 272 CASE( np_no_ldf ) ; WRITE(numout,*) ' ===>> NO lateral diffusion' 273 CASE( np_lap ) ; WRITE(numout,*) ' ===>> laplacian iso-level operator' 274 CASE( np_lap_i ) ; WRITE(numout,*) ' ===>> Rotated laplacian operator (standard)' 275 CASE( np_lap_it ) ; WRITE(numout,*) ' ===>> Rotated laplacian operator (triad)' 276 CASE( np_blp ) ; WRITE(numout,*) ' ===>> bilaplacian iso-level operator' 277 CASE( np_blp_i ) ; WRITE(numout,*) ' ===>> Rotated bilaplacian operator (standard)' 278 CASE( np_blp_it ) ; WRITE(numout,*) ' ===>> Rotated bilaplacian operator (triad)' 277 279 END SELECT 278 280 ENDIF 279 281 ! 280 282 END SUBROUTINE trc_ldf_ini 281 #else 282 !!---------------------------------------------------------------------- 283 !! Default option Empty module 284 !!---------------------------------------------------------------------- 285 CONTAINS 286 SUBROUTINE trc_ldf( kt ) 287 INTEGER, INTENT(in) :: kt 288 WRITE(*,*) 'trc_ldf: You should not have seen this print! error?', kt 289 END SUBROUTINE trc_ldf 283 290 284 #endif 291 285 !!====================================================================== -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r8399 r9019 28 28 USE oce_trc ! ocean dynamics and tracers variables 29 29 USE trc ! ocean passive tracers variables 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link)31 USE prtctl_trc ! Print control for debbuging32 30 USE trd_oce 33 31 USE trdtra … … 38 36 USE agrif_top_interp 39 37 # endif 38 ! 39 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 40 USE prtctl_trc ! Print control for debbuging 40 41 41 42 IMPLICIT NONE 42 43 PRIVATE 43 44 44 PUBLIC trc_nxt 45 PUBLIC trc_nxt ! routine called by step.F90 45 46 46 47 REAL(wp) :: rfact1, rfact2 … … 82 83 REAL(wp) :: zfact ! temporary scalar 83 84 CHARACTER (len=22) :: charout 84 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrdt85 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrdt ! 4D workspace 85 86 !!---------------------------------------------------------------------- 86 87 ! … … 102 103 103 104 IF( l_trdtrc ) THEN ! trends: store now fields before the Asselin filter application 104 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt)105 ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) ) 105 106 ztrdt(:,:,:,:) = trn(:,:,:,:) 106 107 ENDIF … … 138 139 END DO 139 140 END DO 140 CALL wrk_dealloc( jpi, jpj, jpk, jptra,ztrdt )141 DEALLOCATE( ztrdt ) 141 142 END IF 142 143 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r7753 r9019 58 58 !! 59 59 !!---------------------------------------------------------------------- 60 ! 61 INTEGER, INTENT( in ) :: kt ! ocean time-step index 62 ! 63 INTEGER :: ji, jj, jn ! dummy loop indices 64 REAL(wp) :: zse3t, zrtrn, zratio, zfact ! temporary scalars 65 REAL(wp) :: zswitch, zftra, zcd, zdtra, ztfx, ztra ! temporary scalars 60 INTEGER, INTENT(in) :: kt ! ocean time-step index 61 ! 62 INTEGER :: ji, jj, jn ! dummy loop indices 63 REAL(wp) :: zse3t, zrtrn, zratio, zfact ! local scalars 64 REAL(wp) :: zftra, zcd, zdtra, ztfx, ztra ! - - 66 65 CHARACTER (len=22) :: charout 67 REAL(wp), POINTER, DIMENSION(:,: ) :: zsfx 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 69 66 REAL(wp), POINTER, DIMENSION(:,:) :: zsfx 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 70 68 !!--------------------------------------------------------------------- 71 69 ! … … 77 75 ! 78 76 zrtrn = 1.e-15_wp 79 80 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option81 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only82 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect83 ! ! (2) embedded sea-ice : salt and volume fluxes and pressure84 END SELECT85 77 86 78 IF( kt == nittrc000 ) THEN … … 88 80 IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 89 81 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 90 82 ! 91 83 IF( ln_rsttr .AND. .NOT.ln_top_euler .AND. & ! Restart: read in restart file 92 84 iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN … … 125 117 ! 126 118 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 127 128 IF ( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) 129 119 ! 120 IF( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) 130 121 DO jj = 2, jpj 131 122 DO ji = fs_2, fs_jpim1 ! vector opt. … … 133 124 END DO 134 125 END DO 135 136 126 ELSE 137 138 127 DO jj = 2, jpj 139 128 DO ji = fs_2, fs_jpim1 ! vector opt. … … 142 131 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 143 132 zcd = trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting, 144 133 ! ! only used in the levitating sea ice case 145 134 ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux 146 135 ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 147 ztfx = zftra + zswitch * zcd ! net tracer flux (+C/D if no ice/ocean mass exchange)148 136 ztfx = zftra ! net tracer flux 137 ! 149 138 zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 150 139 IF ( zdtra < 0. ) THEN … … 173 162 END DO ! tracer loop 174 163 ! ! =========== 175 164 ! 176 165 ! Write in the tracer restar file 177 166 ! ******************************* -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r7646 r9019 15 15 USE oce_trc ! ocean dynamics and active tracers variables 16 16 USE trc ! ocean passive tracers variables 17 USE trabbl ! bottom boundary layer (trc_bbl routine)18 17 USE trcbbl ! bottom boundary layer (trc_bbl routine) 19 18 USE trcdmp ! internal damping (trc_dmp routine) … … 63 62 ! 64 63 CALL trc_sbc ( kt ) ! surface boundary condition 65 IF( l k_trabbl ) CALL trc_bbl ( kt ) ! advective (and/or diffusive) bottom boundary layer scheme64 IF( ln_trabbl ) CALL trc_bbl ( kt ) ! advective (and/or diffusive) bottom boundary layer scheme 66 65 IF( ln_trcdmp ) CALL trc_dmp ( kt ) ! internal damping trends 67 66 IF( ln_bdy ) CALL trc_bdy_dmp( kt ) ! BDY damping trends -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r7753 r9019 4 4 !! Ocean Passive tracers : vertical diffusive trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 2005-11 (G. Madec) Original code6 !! History : 9.0 ! 2005-11 (G. Madec) Original code 7 7 !! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 8 !! 4.0 ! 2017-04 (G. Madec) remove the explicit case 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_top … … 11 12 !! 'key_top' TOP models 12 13 !!---------------------------------------------------------------------- 13 !! trc_zdf : update the tracer trend with the lateral diffusion 14 !! trc_zdf_ini : initialization, namelist read, and parameters control 14 !! trc_zdf : update the tracer trend with the vertical diffusion 15 15 !!---------------------------------------------------------------------- 16 16 USE trc ! ocean passive tracers variables 17 17 USE oce_trc ! ocean dynamics and active tracers 18 18 USE trd_oce ! trends: ocean variables 19 USE trazdf _exp ! vertical diffusion: explicit (tra_zdf_exp routine)20 USE trazdf_imp ! vertical diffusion: implicit (tra_zdf_imp routine) 19 USE trazdf ! tracer: vertical diffusion 20 !!gm do we really need this ? 21 21 USE trcldf ! passive tracers: lateral diffusion 22 !!gm 22 23 USE trdtra ! trends manager: tracers 23 24 USE prtctl_trc ! Print control … … 27 28 28 29 PUBLIC trc_zdf ! called by step.F90 29 PUBLIC trc_zdf_ini ! called by nemogcm.F9030 30 31 ! !!** Vertical diffusion (nam_trczdf) **32 LOGICAL , PUBLIC :: ln_trczdf_exp !: explicit vertical diffusion scheme flag33 INTEGER , PUBLIC :: nn_trczdf_exp !: number of sub-time step (explicit time stepping)34 35 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used36 ! ! defined from ln_zdf... namlist logicals)37 !! * Substitutions38 # include "zdfddm_substitute.h90"39 # include "vectopt_loop_substitute.h90"40 31 !!---------------------------------------------------------------------- 41 32 !! NEMO/TOP 3.7 , NEMO Consortium (2015) … … 49 40 !! *** ROUTINE trc_zdf *** 50 41 !! 51 !! ** Purpose : compute the vertical ocean tracer physics. 42 !! ** Purpose : compute the vertical ocean tracer physics using 43 !! an implicit time-stepping scheme. 52 44 !!--------------------------------------------------------------------- 53 45 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 55 47 INTEGER :: jk, jn 56 48 CHARACTER (len=22) :: charout 57 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd ! 4D workspace49 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztrtrd ! 4D workspace 58 50 !!--------------------------------------------------------------------- 59 51 ! 60 52 IF( nn_timing == 1 ) CALL timing_start('trc_zdf') 61 53 ! 62 IF( l_trdtrc ) THEN 63 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 64 ztrtrd(:,:,:,:) = tra(:,:,:,:) 65 ENDIF 66 67 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 68 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme 69 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra ) ! implicit scheme 70 END SELECT 71 54 IF( l_trdtrc ) ztrtrd(:,:,:,:) = tra(:,:,:,:) 55 ! 56 CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra ) ! implicit scheme 57 ! 72 58 IF( l_trdtrc ) THEN ! save the vertical diffusive trends for further diagnostics 73 59 DO jn = 1, jptra … … 77 63 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 78 64 END DO 79 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )80 65 ENDIF 81 66 ! ! print mean trends (used for debugging) 82 67 IF( ln_ctl ) THEN 83 WRITE(charout, FMT="('zdf ')") ; CALL prt_ctl_trc_info(charout) 84 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 68 WRITE(charout, FMT="('zdf ')") 69 CALL prt_ctl_trc_info(charout) 70 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 85 71 END IF 86 72 ! … … 88 74 ! 89 75 END SUBROUTINE trc_zdf 90 91 92 SUBROUTINE trc_zdf_ini93 !!----------------------------------------------------------------------94 !! *** ROUTINE trc_zdf_ini ***95 !!96 !! ** Purpose : Choose the vertical mixing scheme97 !!98 !! ** Method : Set nzdf from ln_zdfexp99 !! nzdf = 0 explicit (time-splitting) scheme (ln_trczdf_exp=T)100 !! = 1 implicit (euler backward) scheme (ln_trczdf_exp=F)101 !! NB: The implicit scheme is required when using :102 !! - rotated lateral mixing operator103 !! - TKE, GLS vertical mixing scheme104 !!----------------------------------------------------------------------105 INTEGER :: ios ! Local integer output status for namelist read106 !!107 NAMELIST/namtrc_zdf/ ln_trczdf_exp , nn_trczdf_exp108 !!----------------------------------------------------------------------109 !110 REWIND( numnat_ref ) ! namtrc_zdf in reference namelist111 READ ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905)112 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp )113 !114 REWIND( numnat_cfg ) ! namtrc_zdf in configuration namelist115 READ ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 )116 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp )117 IF(lwm) WRITE ( numont, namtrc_zdf )118 !119 IF(lwp) THEN ! Control print120 WRITE(numout,*)121 WRITE(numout,*) ' Namelist namtrc_zdf : set vertical diffusion parameters'122 WRITE(numout,*) ' time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp123 WRITE(numout,*) ' number of time step nn_trczdf_exp = ', nn_trczdf_exp124 ENDIF125 126 ! ! Define the vertical tracer physics scheme127 IF( ln_trczdf_exp ) THEN ; nzdf = 0 ! explicit scheme128 ELSE ; nzdf = 1 ! implicit scheme129 ENDIF130 131 ! ! Force implicit schemes132 IF( ln_trcldf_iso ) nzdf = 1 ! iso-neutral lateral physics133 IF( ln_trcldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate134 #if defined key_zdftke || defined key_zdfgls135 nzdf = 1 ! TKE or GLS physics136 #endif137 IF( ln_trczdf_exp .AND. nzdf == 1 ) &138 CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS vertical scheme ', &139 & ' the implicit scheme is required, set ln_trczdf_exp = .false.' )140 141 IF(lwp) THEN142 WRITE(numout,*)143 WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme'144 WRITE(numout,*) '~~~~~~~~~~~'145 IF( nzdf == 0 ) WRITE(numout,*) ' Explicit time-splitting scheme'146 IF( nzdf == 1 ) WRITE(numout,*) ' Implicit (euler backward) scheme'147 ENDIF148 !149 END SUBROUTINE trc_zdf_ini150 76 151 77 #else -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
r7646 r9019 20 20 USE dom_oce ! domain definition 21 21 USE zdfmxl , ONLY : nmln ! number of level in the mixed layer 22 USE zdf_oce , ONLY : avt ! vert. diffusivity coef. at w-point for temp 23 # if defined key_zdfddm 24 USE zdfddm , ONLY : avs ! salinity vertical diffusivity coeff. at w-point 25 # endif 22 USE zdf_oce , ONLY : avs ! vert. diffusivity coef. at w-point for temp 26 23 USE trdtrc_oce ! definition of main arrays used for trends computations 27 24 USE in_out_manager ! I/O manager … … 54 51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: ztmltrd2 ! 55 52 56 !! * Substitutions57 # include "zdfddm_substitute.h90"58 53 !!---------------------------------------------------------------------- 59 54 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 275 270 IF( ln_trcldf_iso ) THEN 276 271 ! 277 DO jj = 1,jpj 278 DO ji = 1,jpi 279 ik = nmld_trc(ji,jj) 280 zavt = fsavs(ji,jj,ik) 281 DO jn = 1, jptra 272 DO jn = 1, jptra 273 DO jj = 1, jpj 274 DO ji = 1, jpi 275 ik = nmld_trc(ji,jj) 282 276 IF( ln_trdtrc(jn) ) & 283 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt/ e3w_n(ji,jj,ik) * tmask(ji,jj,ik) &277 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w_n(ji,jj,ik) * tmask(ji,jj,ik) & 284 278 & * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) ) & 285 279 & / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r7881 r9019 63 63 USE sbc_oce , ONLY : ln_rnf => ln_rnf !: runoffs / runoff mouths 64 64 USE sbc_oce , ONLY : fr_i => fr_i !: ice fraction (between 0 to 1) 65 USE sbc_oce , ONLY : nn_ice_embd => nn_ice_embd !: flag for levitating/embedding sea-ice in the ocean66 65 USE sbc_oce , ONLY : atm_co2 => atm_co2 ! atmospheric pCO2 67 66 USE traqsr , ONLY : rn_abs => rn_abs !: fraction absorbed in the very near surface … … 101 100 102 101 !* vertical diffusion * 103 USE zdf_oce , ONLY : avt => avt !: vert. diffusivity coef. at w-point for temp 104 # if defined key_zdfddm 105 USE zdfddm , ONLY : avs => avs !: salinity vertical diffusivity coeff. at w-point 106 # endif 102 USE zdf_oce , ONLY : avs => avs !: vert. diffusivity coef. for salinity (w-point) 107 103 108 104 !* mixing & mixed layer depth * -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trc.F90
r8665 r9019 17 17 PUBLIC trc_alloc ! called by nemogcm.F90 18 18 19 !! parameters for the control of passive tracers 20 !! --------------------------------------------- 21 INTEGER, PUBLIC :: numnat_ref = -1 !: logical unit for the reference passive tracer namelist_top_ref 22 INTEGER, PUBLIC :: numnat_cfg = -1 !: logical unit for the reference passive tracer namelist_top_cfg 23 INTEGER, PUBLIC :: numont = -1 !: logical unit for the reference passive tracer namelist output output.namelist.top 24 INTEGER, PUBLIC :: numtrc_ref = -1 !: logical unit for the reference passive tracer namelist_top_ref 25 INTEGER, PUBLIC :: numtrc_cfg = -1 !: logical unit for the reference passive tracer namelist_top_cfg 26 INTEGER, PUBLIC :: numonr = -1 !: logical unit for the reference passive tracer namelist output output.namelist.top 27 INTEGER, PUBLIC :: numstr !: logical unit for tracer statistics 28 INTEGER, PUBLIC :: numrtr !: logical unit for trc restart (read ) 29 INTEGER, PUBLIC :: numrtw !: logical unit for trc restart ( write ) 19 ! !!- logical units of passive tracers 20 INTEGER, PUBLIC :: numnat_ref = -1 !: reference passive tracer namelist_top_ref 21 INTEGER, PUBLIC :: numnat_cfg = -1 !: reference passive tracer namelist_top_cfg 22 INTEGER, PUBLIC :: numont = -1 !: reference passive tracer namelist output output.namelist.top 23 INTEGER, PUBLIC :: numtrc_ref = -1 !: reference passive tracer namelist_top_ref 24 INTEGER, PUBLIC :: numtrc_cfg = -1 !: reference passive tracer namelist_top_cfg 25 INTEGER, PUBLIC :: numonr = -1 !: reference passive tracer namelist output output.namelist.top 26 INTEGER, PUBLIC :: numstr !: tracer statistics 27 INTEGER, PUBLIC :: numrtr !: trc restart (read ) 28 INTEGER, PUBLIC :: numrtw !: trc restart ( write ) 30 29 31 30 !! passive tracers fields (before,now,after) 32 31 !! -------------------------------------------------- 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) 34 REAL(wp), PUBLIC 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: trai !: initial total tracer 33 REAL(wp), PUBLIC :: areatot !: total volume 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: cvol !: volume correction -degrad option- 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trn !: tracer concentration for now time step 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tra !: tracer concentration for next time step 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trb !: tracer concentration for before time step 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: sbc_trc_b !: Before sbc fluxes for tracers 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: sbc_trc !: Now sbc fluxes for tracers 41 40 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) 44 INTEGER , PUBLIC 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: trc_i !: prescribed tracer concentration in sea ice for SBC 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: trc_o !: prescribed tracer concentration in ocean for SBC 43 INTEGER , PUBLIC :: nn_ice_tr !: handling of sea ice tracers 45 44 46 45 !! interpolated gradient 47 46 !!-------------------------------------------------- 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtru !: hor. gradient at u-points at bottom ocean level 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrv !: hor. gradient at v-points at bottom ocean level 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrui !: hor. gradient at u-points at top ocean level 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrvi !: hor. gradient at v-points at top ocean level 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_mean !: daily mean qsr 53 52 54 53 !! passive tracers (input and output) 55 54 !! ------------------------------------------ 56 LOGICAL , PUBLIC :: ln_rsttr!: boolean term for restart i/o for passive tracers (namelist)57 LOGICAL , PUBLIC :: lrst_trc!: logical to control the trc restart write58 INTEGER , PUBLIC :: nn_writetrc!: time step frequency for concentration outputs (namelist)59 INTEGER , PUBLIC :: nutwrs!: output FILE for passive tracers restart60 INTEGER , PUBLIC :: nutrst!: logical unit for restart FILE for passive tracers61 INTEGER , PUBLIC :: nn_rsttr!: control of the time step ( 0 or 1 ) for pass. tr.62 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_in!: suffix of pass. tracer restart name (input)63 CHARACTER(len = 256), PUBLIC :: cn_trcrst_indir!: restart input directory64 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_out!: suffix of pass. tracer restart name (output)65 CHARACTER(len = 256), PUBLIC :: cn_trcrst_outdir!: restart output directory66 REAL(wp) , PUBLIC :: rdttrc!: passive tracer time step67 REAL(wp) , PUBLIC :: r2dttrc!: = 2*rdttrc except at nit000 (=rdttrc) if neuler=068 LOGICAL , PUBLIC :: ln_top_euler!: boolean term for euler integration69 LOGICAL , PUBLIC :: ln_trcdta!: Read inputs data from files70 LOGICAL , PUBLIC :: ln_trcdmp!: internal damping flag71 LOGICAL , PUBLIC :: ln_trcdmp_clo!: internal damping flag on closed seas72 INTEGER , PUBLIC :: nittrc000!: first time step of passive tracers model73 LOGICAL , PUBLIC :: l_trcdm2dc!: Diurnal cycle for TOP55 LOGICAL , PUBLIC :: ln_rsttr !: boolean term for restart i/o for passive tracers (namelist) 56 LOGICAL , PUBLIC :: lrst_trc !: logical to control the trc restart write 57 INTEGER , PUBLIC :: nn_writetrc !: time step frequency for concentration outputs (namelist) 58 INTEGER , PUBLIC :: nutwrs !: output FILE for passive tracers restart 59 INTEGER , PUBLIC :: nutrst !: logical unit for restart FILE for passive tracers 60 INTEGER , PUBLIC :: nn_rsttr !: control of the time step ( 0 or 1 ) for pass. tr. 61 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_in !: suffix of pass. tracer restart name (input) 62 CHARACTER(len = 256), PUBLIC :: cn_trcrst_indir !: restart input directory 63 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 64 CHARACTER(len = 256), PUBLIC :: cn_trcrst_outdir !: restart output directory 65 REAL(wp) , PUBLIC :: rdttrc !: passive tracer time step 66 REAL(wp) , PUBLIC :: r2dttrc !: = 2*rdttrc except at nit000 (=rdttrc) if neuler=0 67 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration 68 LOGICAL , PUBLIC :: ln_trcdta !: Read inputs data from files 69 LOGICAL , PUBLIC :: ln_trcdmp !: internal damping flag 70 LOGICAL , PUBLIC :: ln_trcdmp_clo !: internal damping flag on closed seas 71 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 72 LOGICAL , PUBLIC :: l_trcdm2dc !: Diurnal cycle for TOP 74 73 75 74 !! Information for the ice module for tracers 76 75 !! ------------------------------------------ 77 TYPE TRC_I_NML !---Ice tracer namelist structure78 REAL(wp) :: trc_ratio ! ice-ocean trc ratio79 REAL(wp) :: trc_prescr ! prescribed ice trc cc80 CHARACTER(len=2) :: ctrc_o ! choice of ocean trc cc76 TYPE, PUBLIC :: TRC_I_NML !: Ice tracer namelist structure 77 REAL(wp) :: trc_ratio ! ice-ocean trc ratio 78 REAL(wp) :: trc_prescr ! prescribed ice trc cc 79 CHARACTER(len=2) :: ctrc_o ! choice of ocean trc cc 81 80 END TYPE 82 83 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: trc_ice_ratio !ice-ocean tracer ratio84 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: trc_ice_prescr !prescribed ice trc cc85 CHARACTER(len=2), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cn_trc_o !choice of ocean tracer cc81 ! 82 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: trc_ice_ratio !: ice-ocean tracer ratio 83 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: trc_ice_prescr !: prescribed ice trc cc 84 CHARACTER(len=2), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cn_trc_o !: choice of ocean tracer cc 86 85 87 86 88 87 !! information for outputs 89 88 !! -------------------------------------------------- 90 TYPE, PUBLIC :: PTRACER!: Passive tracer type91 CHARACTER(len = 20) :: clsname !:short name92 CHARACTER(len = 80) :: cllname !:long name93 CHARACTER(len = 20) :: clunit !:unit94 LOGICAL :: llinit !:read in a file or not95 LOGICAL :: llsbc !:read in a file or not96 LOGICAL :: llcbc !:read in a file or not97 LOGICAL :: llobc !:read in a file or not89 TYPE, PUBLIC :: PTRACER !: Passive tracer type 90 CHARACTER(len=20) :: clsname ! short name 91 CHARACTER(len=80) :: cllname ! long name 92 CHARACTER(len=20) :: clunit ! unit 93 LOGICAL :: llinit ! read in a file or not 94 LOGICAL :: llsbc ! read in a file or not 95 LOGICAL :: llcbc ! read in a file or not 96 LOGICAL :: llobc ! read in a file or not 98 97 END TYPE PTRACER 99 100 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcnm!: tracer name101 CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcln!: trccer field long name102 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcun!: tracer unit103 104 TYPE, PUBLIC :: DIAG !: passive trcacer ddditional diagnostic type105 CHARACTER(len = 20) :: sname !:short name106 CHARACTER(len = 80) :: lname !:long name107 CHARACTER(len = 20) :: units !:unit98 ! 99 CHARACTER(len=20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcnm !: tracer name 100 CHARACTER(len=80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcln !: trccer field long name 101 CHARACTER(len=20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcun !: tracer unit 102 ! 103 TYPE, PUBLIC :: DIAG !: Passive trcacer ddditional diagnostic type 104 CHARACTER(len=20) :: sname ! short name 105 CHARACTER(len=80) :: lname ! long name 106 CHARACTER(len=20) :: units ! unit 108 107 END TYPE DIAG 109 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trc3d!: 3D diagnostics for tracers111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trc2d!: 2D diagnostics for tracers108 ! 109 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trc3d !: 3D diagnostics for tracers 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trc2d !: 2D diagnostics for tracers 112 111 113 112 !! information for inputs 114 113 !! -------------------------------------------------- 115 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_ini !: Initialisation from data input file 116 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_obc !: Use open boundary condition data 117 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_sbc !: Use surface boundary condition data 118 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_cbc !: Use coastal boundary condition data 119 LOGICAL , PUBLIC :: ln_rnf_ctl !: remove runoff dilution on tracers 120 REAL(wp), PUBLIC :: rn_bc_time !: Time scaling factor for SBC and CBC data (seconds in a day) 121 122 123 !! variables to average over physics over passive tracer sub-steps. 124 !! ---------------------------------------------------------------- 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_tm !: i-horizontal velocity average [m/s] 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vn_tm !: j-horizontal velocity average [m/s] 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsn_tm !: t/s average [m/s] 128 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_tm !: vertical diffusivity coeff. at w-point [m2/s] 129 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhop_tm !: 130 # if defined key_zdfddm 131 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_tm !: vertical double diffusivity coeff. at w-point [m/s] 132 # endif 133 #if defined key_trabbl 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_tm !: u-, w-points 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahv_bbl_tm !: j-direction slope at u-, w-points 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utr_bbl_tm !: j-direction slope at u-, w-points 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtr_bbl_tm !: j-direction slope at u-, w-points 138 #endif 139 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_tm !: average ssh for the now step [m] 140 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshb_hold !:hold sshb from the beginning of each sub-stepping[m] 141 142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf_tm !: river runoff 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_rnf_tm !: depth in metres to the bottom of the relevant grid box 144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld_tm !: mixed layer depth average [m] 145 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i_tm !: average ice fraction [m/s] 146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tm !: freshwater budget: volume flux [Kg/m2/s] 147 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx_tm !: freshwater budget: freezing/melting [Kg/m2/s] 148 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_b_hold !: hold emp from the beginning of each sub-stepping[m] 149 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tm !: solar radiation average [m] 150 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm_tm !: 10m wind average [m] 151 ! 152 153 ! Temporary physical arrays for sub_stepping 154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsn_temp 155 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_temp,vn_temp,wn_temp !: hold current values of avt, un, vn, wn 156 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_temp, rhop_temp !: hold current values of avt, un, vn, wn 157 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp 158 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivn_temp, rotn_temp 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivb_temp, rotb_temp 160 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld_temp, qsr_temp, fr_i_temp,wndm_temp 161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_temp, fmmflx_temp, emp_b_temp 162 ! 163 #if defined key_trabbl 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_temp, ahv_bbl_temp, utr_bbl_temp, vtr_bbl_temp !: hold current values 165 #endif 166 ! 167 # if defined key_zdfddm 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_temp !: salinity vertical diffusivity coeff. at w-point [m/s] 169 # endif 114 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_ini !: Initialisation from data input file 115 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_obc !: Use open boundary condition data 116 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_sbc !: Use surface boundary condition data 117 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_cbc !: Use coastal boundary condition data 118 LOGICAL , PUBLIC :: ln_rnf_ctl !: remove runoff dilution on tracers 119 REAL(wp), PUBLIC :: rn_bc_time !: Time scaling factor for SBC and CBC data (seconds in a day) 170 120 ! 171 121 CHARACTER(len=20), PUBLIC, DIMENSION(jp_bdy) :: cn_trc_dflt ! Default OBC condition for all tracers … … 174 124 !$AGRIF_DO_NOT_TREAT 175 125 ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp 176 TYPE(OBC_DATA), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: trcdta_bdy!: bdy external data (local process)126 TYPE(OBC_DATA), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: trcdta_bdy !: bdy external data (local process) 177 127 !$AGRIF_END_DO_NOT_TREAT 128 ! 178 129 !!---------------------------------------------------------------------- 179 !! NEMO/TOP 3.3.1 , NEMO Consortium (2010)130 !! NEMO/TOP 4.0 , NEMO Consortium (2017) 180 131 !! $Id$ 181 132 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 205 156 & STAT = ierr(1) ) 206 157 ! 207 IF ( ln_bdy ) THEN 208 ALLOCATE( trcdta_bdy(jptra, jp_bdy), STAT = ierr(2) ) 209 ENDIF 158 IF( ln_bdy ) ALLOCATE( trcdta_bdy(jptra, jp_bdy) , STAT = ierr(2) ) 210 159 ! 211 IF (jp_dia3d > 0 ) ALLOCATE( trc3d(jpi,jpj,jpk,jp_dia3d), STAT = ierr(3) )160 IF (jp_dia3d > 0 ) ALLOCATE( trc3d(jpi,jpj,jpk,jp_dia3d), STAT = ierr(3) ) 212 161 ! 213 IF (jp_dia2d > 0 ) ALLOCATE( trc2d(jpi,jpj,jpk,jp_dia2d), STAT = ierr(4) )162 IF (jp_dia2d > 0 ) ALLOCATE( trc2d(jpi,jpj,jpk,jp_dia2d), STAT = ierr(4) ) 214 163 ! 215 164 trc_alloc = MAXVAL( ierr ) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r8542 r9019 197 197 USE trcadv , ONLY: trc_adv_ini 198 198 USE trcldf , ONLY: trc_ldf_ini 199 USE trczdf , ONLY: trc_zdf_ini200 199 USE trcrad , ONLY: trc_rad_ini 201 200 ! … … 206 205 CALL trc_adv_ini ! advection 207 206 CALL trc_ldf_ini ! lateral diffusion 208 CALL trc_zdf_ini ! vertical diffusion207 ! ! vertical diffusion: always implicit time stepping scheme 209 208 CALL trc_rad_ini ! positivity of passive tracers 210 209 ! … … 224 223 !!---------------------------------------------------------------------- 225 224 ! 226 ! Initialisation of tracers Initial Conditions 227 IF( ln_trcdta ) CALL trc_dta_ini(jptra)228 229 ! Initialisation oftracers Boundary Conditions230 IF( ln_my_trc ) CALL trc_bc_ini(jptra) 231 232 IF( ln_rsttr ) THEN 225 226 IF( ln_trcdta ) CALL trc_dta_ini( jptra ) ! set initial tracers values 227 228 IF( ln_my_trc ) CALL trc_bc_ini ( jptra ) ! set tracers Boundary Conditions 229 230 231 IF( ln_rsttr ) THEN ! restart from a file 233 232 ! 234 CALL trc_rst_read ! restart from a file233 CALL trc_rst_read 235 234 ! 236 ELSE 237 ! Initialisation of tracer from a file that may also be used for damping 235 ELSE ! Initialisation of tracer from a file that may also be used for damping 236 !!gm BUG ? if damping and restart, what's happening ? 238 237 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN 239 238 ! update passive tracers arrays with input data read from file … … 251 250 ENDIF 252 251 ENDIF 253 END DO252 END DO 254 253 ! 255 254 ENDIF … … 263 262 END SUBROUTINE trc_ini_state 264 263 264 265 265 SUBROUTINE top_alloc 266 266 !!---------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r7812 r9019 8 8 #if defined key_top 9 9 !!---------------------------------------------------------------------- 10 !! trc_stp : passive tracer system time-stepping11 !!---------------------------------------------------------------------- 12 USE oce_trc 10 !! trc_stp : passive tracer system time-stepping 11 !!---------------------------------------------------------------------- 12 USE oce_trc ! ocean dynamics and active tracers variables 13 13 USE sbc_oce 14 14 USE trc 15 USE trctrp 16 USE trcsms 15 USE trctrp ! passive tracers transport 16 USE trcsms ! passive tracers sources and sinks 17 17 USE trcwri 18 18 USE trcrst 19 USE trcsub ! 19 20 USE trdtrc_oce 20 21 USE trdmxl_trc 21 USE prtctl_trc ! Print control for debbuging22 USE iom23 USE i n_out_manager24 USE trcsub22 ! 23 USE prtctl_trc ! Print control for debbuging 24 USE iom ! 25 USE in_out_manager ! 25 26 26 27 IMPLICIT NONE … … 29 30 PUBLIC trc_stp ! called by step 30 31 31 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step32 REAL(wp) :: rdt_sampl33 INTEGER :: nb_rec_per_day, ktdcy34 REAL(wp) :: rsecfst, rseclast35 LOGICAL :: llnew32 LOGICAL :: llnew ! ??? 33 REAL(wp) :: rdt_sampl ! ??? 34 INTEGER :: nb_rec_per_day, ktdcy ! ??? 35 REAL(wp) :: rsecfst, rseclast ! ??? 36 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step 36 37 37 38 !!---------------------------------------------------------------------- … … 46 47 !! *** ROUTINE trc_stp *** 47 48 !! 48 !! ** Purpose : Time loop of opa for passive tracer49 !! ** Purpose : Time loop of opa for passive tracer 49 50 !! 50 !! ** Method : 51 !! Compute the passive tracers trends 52 !! Update the passive tracers 51 !! ** Method : Compute the passive tracers trends 52 !! Update the passive tracers 53 53 !!------------------------------------------------------------------- 54 INTEGER, INTENT( in ) :: kt! ocean time-step index55 INTEGER :: jk, jn ! dummy loop indices56 REAL(wp) :: ztrai57 CHARACTER (len=25) :: charout58 54 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 ! 56 INTEGER :: jk, jn ! dummy loop indices 57 REAL(wp):: ztrai ! local scalar 58 CHARACTER (len=25) :: charout ! 59 59 !!------------------------------------------------------------------- 60 60 ! … … 115 115 ! 116 116 END SUBROUTINE trc_stp 117 117 118 118 119 SUBROUTINE trc_mean_qsr( kt ) … … 128 129 !! In coupled mode, the sampling is done at every coupling frequency 129 130 !!---------------------------------------------------------------------- 130 INTEGER, INTENT(in) :: kt 131 INTEGER :: jn 132 REAL(wp) :: zkt, zrec 133 CHARACTER(len=1) :: cl1 ! 1 character 134 CHARACTER(len=2) :: cl2 ! 2 characters 135 131 INTEGER, INTENT( in ) :: kt ! ocean time-step index 132 ! 133 INTEGER :: jn ! dummy loop indices 134 REAL(wp) :: zkt, zrec ! local scalars 135 CHARACTER(len=1) :: cl1 ! 1 character 136 CHARACTER(len=2) :: cl2 ! 2 characters 137 !!---------------------------------------------------------------------- 138 ! 136 139 IF( kt == nittrc000 ) THEN 137 140 IF( ln_cpl ) THEN … … 143 146 ENDIF 144 147 ! 145 IF( lwp) THEN148 IF(lwp) THEN 146 149 WRITE(numout,*) 147 150 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day … … 171 174 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) ! A mean of qsr 172 175 ENDIF 173 END DO176 END DO 174 177 ELSE 175 178 DO jn = 1, nb_rec_per_day … … 184 187 DO jn = 1, nb_rec_per_day 185 188 qsr_arr(:,:,jn) = qsr_mean(:,:) 186 END DO189 END DO 187 190 ENDIF 188 191 ! … … 220 223 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) 221 224 ENDIF 222 END DO225 END DO 223 226 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) ) 224 227 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r7646 r9019 2 2 !!====================================================================== 3 3 !! *** MODULE trcsubstp *** 4 !! TOP : Averages physics variables for TOP substepping.4 !! TOP : Averages physics variables for TOP substepping. 5 5 !!====================================================================== 6 6 !! History : 1.0 ! 2011-10 (K. Edwards) Original … … 8 8 #if defined key_top 9 9 !!---------------------------------------------------------------------- 10 !! trc_sub : passive tracer system sub-stepping10 !! trc_sub : passive tracer system sub-stepping 11 11 !!---------------------------------------------------------------------- 12 USE oce_trc 12 USE oce_trc ! ocean dynamics and active tracers variables 13 13 USE trc 14 USE prtctl_trc ! Print control for debbuging 15 USE iom 16 USE in_out_manager 17 USE lbclnk 18 USE trabbl 14 USE trabbl ! bottom boundary layer 19 15 USE zdf_oce 20 16 USE domvvl 21 USE divhor ! horizontal divergence (div_hor routine) 22 USE sbcrnf , ONLY: h_rnf, nk_rnf ! River runoff 23 USE bdy_oce , ONLY: ln_bdy, bdytmask ! BDY 17 USE divhor ! horizontal divergence 18 USE sbcrnf , ONLY: h_rnf, nk_rnf ! River runoff 19 USE bdy_oce , ONLY: ln_bdy, bdytmask ! BDY 20 ! 21 USE prtctl_trc ! Print control for debbuging 22 USE in_out_manager ! 23 USE iom 24 USE lbclnk 24 25 #if defined key_agrif 25 26 USE agrif_opa_update … … 29 30 IMPLICIT NONE 30 31 31 PUBLIC trc_sub_stp ! called by trc_stp 32 PUBLIC trc_sub_ini ! called by trc_ini to initialize substepping arrays. 33 PUBLIC trc_sub_reset ! called by trc_stp to reset physics variables 34 PUBLIC trc_sub_ssh ! called by trc_stp to reset physics variables 35 36 REAL(wp) :: r1_ndttrc ! 1 / nn_dttrc 37 REAL(wp) :: r1_ndttrcp1 ! 1 / (nn_dttrc+1) 38 39 ! !* iso-neutral slopes (if l_ldfslp=T) 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_temp, vslp_temp, wslpi_temp, wslpj_temp !: hold current values 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm , vslp_tm , wslpi_tm , wslpj_tm !: time mean 32 PUBLIC trc_sub_stp ! called by trc_stp 33 PUBLIC trc_sub_ini ! called by trc_ini to initialize substepping arrays. 34 PUBLIC trc_sub_reset ! called by trc_stp to reset physics variables 35 PUBLIC trc_sub_ssh ! called by trc_stp to reset physics variables 36 37 REAL(wp) :: r1_ndttrc ! = 1 / nn_dttrc 38 REAL(wp) :: r1_ndttrcp1 ! = 1 / (nn_dttrc+1) 39 40 41 !! averaged and temporary saved variables (needed when a larger passive tracer time-step is used) 42 !! ---------------------------------------------------------------- 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_tm , un_temp !: i-horizontal velocity average [m/s] 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vn_tm , vn_temp !: j-horizontal velocity average [m/s] 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wn_temp !: hold current values of avt, un, vn, wn 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsn_tm , tsn_temp !: t/s average [m/s] 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_tm , avs_temp !: vertical diffusivity coeff. at w-point [m2/s] 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhop_tm , rhop_temp !: 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_tm , sshn_temp !: average ssh for the now step [m] 50 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf_tm , rnf_temp !: river runoff 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_rnf_tm , h_rnf_temp !: depth in metres to the bottom of the relevant grid box 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld_tm , hmld_temp !: mixed layer depth average [m] 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i_tm , fr_i_temp !: average ice fraction [m/s] 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tm , emp_temp !: freshwater budget: volume flux [Kg/m2/s] 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx_tm , fmmflx_temp !: freshwater budget: freezing/melting [Kg/m2/s] 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_b_hold, emp_b_temp !: hold emp from the beginning of each sub-stepping[m] 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tm , qsr_temp !: solar radiation average [m] 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm_tm , wndm_temp !: 10m wind average [m] 60 ! 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshb_hold !:hold sshb from the beginning of each sub-stepping[m] 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshb_temp, ssha_temp 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivn_temp, rotn_temp 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivb_temp, rotb_temp 65 ! 66 ! !!- bottom boundary layer param (ln_trabbl=T) 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_tm, ahu_bbl_temp ! BBL diffusive i-coef. 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahv_bbl_tm, ahv_bbl_temp ! BBL diffusive j-coef. 69 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utr_bbl_tm, utr_bbl_temp ! BBL u-advection 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtr_bbl_tm, vtr_bbl_temp ! BBL v-advection 71 72 ! !!- iso-neutral slopes (if l_ldfslp=T) 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_temp, vslp_temp, wslpi_temp, wslpj_temp !: hold current values 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm , vslp_tm , wslpi_tm , wslpj_tm !: time mean 75 42 76 43 77 !!---------------------------------------------------------------------- 44 !! NEMO/TOP 3.3 , NEMO Consortium (2010)78 !! NEMO/TOP 4.0 , NEMO Consortium (2017) 45 79 !! $Id$ 46 80 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 57 91 !! on TOP steps, calculate averages. 58 92 !!------------------------------------------------------------------- 59 INTEGER, INTENT( in ) :: kt ! ocean time-step index 60 INTEGER :: ji,jj,jk ! dummy loop indices 61 REAL(wp) :: z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w 93 INTEGER, INTENT( in ) :: kt ! ocean time-step index 94 ! 95 INTEGER :: ji, jj, jk ! dummy loop indices 96 REAL(wp):: z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w ! local scalars 62 97 !!------------------------------------------------------------------- 63 98 ! … … 74 109 r1_ndttrc = 1._wp / REAL( nn_dttrc , wp ) 75 110 r1_ndttrcp1 = 1._wp / REAL( nn_dttrc + 1, wp ) 76 !77 111 ENDIF 78 112 79 IF( MOD( kt , nn_dttrc ) /= 0 ) THEN 80 ! 81 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * e3u_n(:,:,:) 82 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * e3v_n(:,:,:) 83 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * e3t_n(:,:,:) 84 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 85 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * e3t_n(:,:,:) 86 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * e3w_n(:,:,:) 87 # if defined key_zdfddm 88 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * e3w_n(:,:,:) 89 # endif 113 IF( MOD( kt , nn_dttrc ) /= 0 ) THEN 114 ! 115 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * e3u_n(:,:,:) 116 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * e3v_n(:,:,:) 117 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * e3t_n(:,:,:) 118 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 119 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * e3t_n(:,:,:) 120 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * e3w_n(:,:,:) 90 121 IF( l_ldfslp ) THEN 91 122 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:) … … 94 125 wslpj_tm(:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:) 95 126 ENDIF 96 # if defined key_trabbl 97 IF( nn_bbl_ldf == 1 ) THEN98 ahu_bbl_tm(:,:) = ahu_bbl_tm(:,:) + ahu_bbl(:,:)99 ahv_bbl_tm(:,:) = ahv_bbl_tm(:,:) + ahv_bbl(:,:)100 ENDIF101 IF( nn_bbl_adv == 1 ) THEN102 utr_bbl_tm(:,:) = utr_bbl_tm(:,:) + utr_bbl(:,:)103 vtr_bbl_tm(:,:) = vtr_bbl_tm(:,:) + vtr_bbl(:,:)104 ENDIF105 # endif 106 107 108 109 110 111 112 113 114 115 116 127 IF( ln_trabbl ) THEN 128 IF( nn_bbl_ldf == 1 ) THEN 129 ahu_bbl_tm(:,:) = ahu_bbl_tm(:,:) + ahu_bbl(:,:) 130 ahv_bbl_tm(:,:) = ahv_bbl_tm(:,:) + ahv_bbl(:,:) 131 ENDIF 132 IF( nn_bbl_adv == 1 ) THEN 133 utr_bbl_tm(:,:) = utr_bbl_tm(:,:) + utr_bbl(:,:) 134 vtr_bbl_tm(:,:) = vtr_bbl_tm(:,:) + vtr_bbl(:,:) 135 ENDIF 136 ENDIF 137 ! 138 sshn_tm (:,:) = sshn_tm (:,:) + sshn (:,:) 139 rnf_tm (:,:) = rnf_tm (:,:) + rnf (:,:) 140 h_rnf_tm (:,:) = h_rnf_tm (:,:) + h_rnf (:,:) 141 hmld_tm (:,:) = hmld_tm (:,:) + hmld (:,:) 142 fr_i_tm (:,:) = fr_i_tm (:,:) + fr_i (:,:) 143 emp_tm (:,:) = emp_tm (:,:) + emp (:,:) 144 fmmflx_tm(:,:) = fmmflx_tm(:,:) + fmmflx(:,:) 145 qsr_tm (:,:) = qsr_tm (:,:) + qsr (:,:) 146 wndm_tm (:,:) = wndm_tm (:,:) + wndm (:,:) 147 ! 117 148 ELSE ! It is time to substep 118 ! 1. set temporary arrays to hold physics variables149 ! 1. set temporary arrays to hold physics/dynamical variables 119 150 un_temp (:,:,:) = un (:,:,:) 120 151 vn_temp (:,:,:) = vn (:,:,:) … … 122 153 tsn_temp (:,:,:,:) = tsn (:,:,:,:) 123 154 rhop_temp (:,:,:) = rhop (:,:,:) 124 avt_temp (:,:,:) = avt (:,:,:)125 # if defined key_zdfddm126 155 avs_temp (:,:,:) = avs (:,:,:) 127 # endif128 156 IF( l_ldfslp ) THEN 129 157 uslp_temp (:,:,:) = uslp (:,:,:) ; wslpi_temp (:,:,:) = wslpi (:,:,:) 130 158 vslp_temp (:,:,:) = vslp (:,:,:) ; wslpj_temp (:,:,:) = wslpj (:,:,:) 131 159 ENDIF 132 # if defined key_trabbl 133 IF( nn_bbl_ldf == 1 ) THEN134 ahu_bbl_temp(:,:) = ahu_bbl(:,:)135 ahv_bbl_temp(:,:) = ahv_bbl(:,:)136 ENDIF137 IF( nn_bbl_adv == 1 ) THEN138 utr_bbl_temp(:,:) = utr_bbl(:,:)139 vtr_bbl_temp(:,:) = vtr_bbl(:,:)140 ENDIF141 # endif 160 IF( ln_trabbl ) THEN 161 IF( nn_bbl_ldf == 1 ) THEN 162 ahu_bbl_temp(:,:) = ahu_bbl(:,:) 163 ahv_bbl_temp(:,:) = ahv_bbl(:,:) 164 ENDIF 165 IF( nn_bbl_adv == 1 ) THEN 166 utr_bbl_temp(:,:) = utr_bbl(:,:) 167 vtr_bbl_temp(:,:) = vtr_bbl(:,:) 168 ENDIF 169 ENDIF 142 170 sshn_temp (:,:) = sshn (:,:) 143 171 sshb_temp (:,:) = sshb (:,:) … … 161 189 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 162 190 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * e3t_n(:,:,:) 163 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * e3w_n(:,:,:)164 # if defined key_zdfddm165 191 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * e3w_n(:,:,:) 166 # endif167 192 IF( l_ldfslp ) THEN 168 193 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:) … … 171 196 wslpj_tm (:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:) 172 197 ENDIF 173 # if defined key_trabbl 174 IF( nn_bbl_ldf == 1 ) THEN175 ahu_bbl_tm(:,:) = ahu_bbl_tm(:,:) + ahu_bbl(:,:)176 ahv_bbl_tm(:,:) = ahv_bbl_tm(:,:) + ahv_bbl(:,:)177 ENDIF178 IF( nn_bbl_adv == 1 ) THEN179 utr_bbl_tm(:,:) = utr_bbl_tm(:,:) + utr_bbl(:,:)180 vtr_bbl_tm(:,:) = vtr_bbl_tm(:,:) + vtr_bbl(:,:)181 ENDIF182 # endif 198 IF( ln_trabbl ) THEN 199 IF( nn_bbl_ldf == 1 ) THEN 200 ahu_bbl_tm(:,:) = ahu_bbl_tm(:,:) + ahu_bbl(:,:) 201 ahv_bbl_tm(:,:) = ahv_bbl_tm(:,:) + ahv_bbl(:,:) 202 ENDIF 203 IF( nn_bbl_adv == 1 ) THEN 204 utr_bbl_tm(:,:) = utr_bbl_tm(:,:) + utr_bbl(:,:) 205 vtr_bbl_tm(:,:) = vtr_bbl_tm(:,:) + vtr_bbl(:,:) 206 ENDIF 207 ENDIF 183 208 sshn_tm (:,:) = sshn_tm (:,:) + sshn (:,:) 184 209 rnf_tm (:,:) = rnf_tm (:,:) + rnf (:,:) … … 204 229 fmmflx(:,:) = fmmflx_tm (:,:) * r1_ndttrc 205 230 fr_i (:,:) = fr_i_tm (:,:) * r1_ndttrc 206 # if defined key_trabbl 207 IF( nn_bbl_ldf == 1 ) THEN208 ahu_bbl(:,:) = ahu_bbl_tm (:,:) * r1_ndttrc209 ahv_bbl(:,:) = ahv_bbl_tm (:,:) * r1_ndttrc210 ENDIF211 IF( nn_bbl_adv == 1 ) THEN212 utr_bbl(:,:) = utr_bbl_tm (:,:) * r1_ndttrc213 vtr_bbl(:,:) = vtr_bbl_tm (:,:) * r1_ndttrc214 ENDIF215 # endif 231 IF( ln_trabbl ) THEN 232 IF( nn_bbl_ldf == 1 ) THEN 233 ahu_bbl(:,:) = ahu_bbl_tm (:,:) * r1_ndttrc 234 ahv_bbl(:,:) = ahv_bbl_tm (:,:) * r1_ndttrc 235 ENDIF 236 IF( nn_bbl_adv == 1 ) THEN 237 utr_bbl(:,:) = utr_bbl_tm (:,:) * r1_ndttrc 238 vtr_bbl(:,:) = vtr_bbl_tm (:,:) * r1_ndttrc 239 ENDIF 240 ENDIF 216 241 ELSE 217 242 wndm (:,:) = wndm_tm (:,:) * r1_ndttrcp1 … … 220 245 fmmflx(:,:) = fmmflx_tm (:,:) * r1_ndttrcp1 221 246 fr_i (:,:) = fr_i_tm (:,:) * r1_ndttrcp1 222 # if defined key_trabbl 223 IF( nn_bbl_ldf == 1 ) THEN224 ahu_bbl(:,:) = ahu_bbl_tm (:,:) * r1_ndttrcp1225 ahv_bbl(:,:) = ahv_bbl_tm (:,:) * r1_ndttrcp1226 ENDIF227 IF( nn_bbl_adv == 1 ) THEN228 utr_bbl(:,:) = utr_bbl_tm (:,:) * r1_ndttrcp1229 vtr_bbl(:,:) = vtr_bbl_tm (:,:) * r1_ndttrcp1230 ENDIF231 # endif 247 IF( ln_trabbl ) THEN 248 IF( nn_bbl_ldf == 1 ) THEN 249 ahu_bbl(:,:) = ahu_bbl_tm (:,:) * r1_ndttrcp1 250 ahv_bbl(:,:) = ahv_bbl_tm (:,:) * r1_ndttrcp1 251 ENDIF 252 IF( nn_bbl_adv == 1 ) THEN 253 utr_bbl(:,:) = utr_bbl_tm (:,:) * r1_ndttrcp1 254 vtr_bbl(:,:) = vtr_bbl_tm (:,:) * r1_ndttrcp1 255 ENDIF 256 ENDIF 232 257 ENDIF 233 258 ! … … 245 270 tsn (ji,jj,jk,jp_sal) = tsn_tm (ji,jj,jk,jp_sal) * z1_ne3t 246 271 rhop (ji,jj,jk) = rhop_tm (ji,jj,jk) * z1_ne3t 247 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 248 avt (ji,jj,jk) = avt_tm (ji,jj,jk) * z1_ne3w 249 # if defined key_zdfddm 272 !!gm : BUG ==>> for avs I don't understand the division by e3w 250 273 avs (ji,jj,jk) = avs_tm (ji,jj,jk) * z1_ne3w 251 # endif252 274 END DO 253 275 END DO … … 264 286 ENDIF 265 287 ! 266 IF( nn_timing == 1 ) CALL timing_st art('trc_sub_stp')288 IF( nn_timing == 1 ) CALL timing_stop('trc_sub_stp') 267 289 ! 268 290 END SUBROUTINE trc_sub_stp … … 297 319 rhop_tm (:,:,:) = rhop (:,:,:) * e3t_n(:,:,:) 298 320 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 299 avt_tm (:,:,:) = avt (:,:,:) * e3w_n(:,:,:)300 # if defined key_zdfddm301 321 avs_tm (:,:,:) = avs (:,:,:) * e3w_n(:,:,:) 302 # endif303 322 IF( l_ldfslp ) THEN 304 323 wslpi_tm(:,:,:) = wslpi(:,:,:) … … 313 332 314 333 ! Physics variables that are set after initialization: 315 fr_i_tm (:,:) = 0._wp316 emp_tm (:,:) = 0._wp334 fr_i_tm (:,:) = 0._wp 335 emp_tm (:,:) = 0._wp 317 336 fmmflx_tm(:,:) = 0._wp 318 qsr_tm (:,:) = 0._wp319 wndm_tm (:,:) = 0._wp320 # if defined key_trabbl 321 IF( nn_bbl_ldf == 1 ) THEN322 ahu_bbl_tm(:,:) = 0._wp323 ahv_bbl_tm(:,:) = 0._wp324 ENDIF325 IF( nn_bbl_adv == 1 ) THEN326 utr_bbl_tm(:,:) = 0._wp327 vtr_bbl_tm(:,:) = 0._wp328 ENDIF329 # endif 337 qsr_tm (:,:) = 0._wp 338 wndm_tm (:,:) = 0._wp 339 IF( ln_trabbl ) THEN 340 IF( nn_bbl_ldf == 1 ) THEN 341 ahu_bbl_tm(:,:) = 0._wp 342 ahv_bbl_tm(:,:) = 0._wp 343 ENDIF 344 IF( nn_bbl_adv == 1 ) THEN 345 utr_bbl_tm(:,:) = 0._wp 346 vtr_bbl_tm(:,:) = 0._wp 347 ENDIF 348 ENDIF 330 349 ! 331 350 IF( nn_timing == 1 ) CALL timing_stop('trc_sub_ini') … … 354 373 tsn (:,:,:,:) = tsn_temp (:,:,:,:) 355 374 rhop (:,:,:) = rhop_temp (:,:,:) 356 avt (:,:,:) = avt_temp (:,:,:)357 # if defined key_zdfddm358 375 avs (:,:,:) = avs_temp (:,:,:) 359 # endif360 376 IF( l_ldfslp ) THEN 361 377 wslpi (:,:,:)= wslpi_temp (:,:,:) … … 377 393 qsr (:,:) = qsr_temp (:,:) 378 394 wndm (:,:) = wndm_temp (:,:) 379 # if defined key_trabbl 380 IF( nn_bbl_ldf == 1 ) THEN381 ahu_bbl(:,:) = ahu_bbl_temp(:,:)382 ahv_bbl(:,:) = ahv_bbl_temp(:,:)383 ENDIF384 IF( nn_bbl_adv == 1 ) THEN385 utr_bbl(:,:) = utr_bbl_temp(:,:)386 vtr_bbl(:,:) = vtr_bbl_temp(:,:)387 ENDIF388 # endif 395 IF( ln_trabbl ) THEN 396 IF( nn_bbl_ldf == 1 ) THEN 397 ahu_bbl(:,:) = ahu_bbl_temp(:,:) 398 ahv_bbl(:,:) = ahv_bbl_temp(:,:) 399 ENDIF 400 IF( nn_bbl_adv == 1 ) THEN 401 utr_bbl(:,:) = utr_bbl_temp(:,:) 402 vtr_bbl(:,:) = vtr_bbl_temp(:,:) 403 ENDIF 404 ENDIF 389 405 ! 390 406 hdivn (:,:,:) = hdivn_temp (:,:,:) … … 396 412 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 397 413 rhop_tm (:,:,:) = rhop (:,:,:) * e3t_n(:,:,:) 398 avt_tm (:,:,:) = avt (:,:,:) * e3w_n(:,:,:)399 # if defined key_zdfddm400 414 avs_tm (:,:,:) = avs (:,:,:) * e3w_n(:,:,:) 401 # endif402 415 IF( l_ldfslp ) THEN 403 416 uslp_tm (:,:,:) = uslp (:,:,:) … … 418 431 qsr_tm (:,:) = qsr (:,:) 419 432 wndm_tm (:,:) = wndm (:,:) 420 # if defined key_trabbl 421 IF( nn_bbl_ldf == 1 ) THEN422 ahu_bbl_tm(:,:) = ahu_bbl(:,:)423 ahv_bbl_tm(:,:) = ahv_bbl(:,:)424 ENDIF425 IF( nn_bbl_adv == 1 ) THEN426 utr_bbl_tm(:,:) = utr_bbl(:,:)427 vtr_bbl_tm(:,:) = vtr_bbl(:,:)428 ENDIF429 # endif 433 IF( ln_trabbl ) THEN 434 IF( nn_bbl_ldf == 1 ) THEN 435 ahu_bbl_tm(:,:) = ahu_bbl(:,:) 436 ahv_bbl_tm(:,:) = ahv_bbl(:,:) 437 ENDIF 438 IF( nn_bbl_adv == 1 ) THEN 439 utr_bbl_tm(:,:) = utr_bbl(:,:) 440 vtr_bbl_tm(:,:) = vtr_bbl(:,:) 441 ENDIF 442 ENDIF 430 443 ! 431 444 ! … … 530 543 !!------------------------------------------------------------------- 531 544 USE lib_mpp, ONLY: ctl_warn 532 INTEGER :: ierr 533 !!------------------------------------------------------------------- 534 ! 535 ALLOCATE( un_temp(jpi,jpj,jpk) , vn_temp(jpi,jpj,jpk) , & 536 & wn_temp(jpi,jpj,jpk) , avt_temp(jpi,jpj,jpk) , & 537 & rhop_temp(jpi,jpj,jpk) , rhop_tm(jpi,jpj,jpk) , & 538 & sshn_temp(jpi,jpj) , sshb_temp(jpi,jpj) , & 539 & ssha_temp(jpi,jpj) , & 540 #if defined key_trabbl 541 & ahu_bbl_temp(jpi,jpj) , ahv_bbl_temp(jpi,jpj), & 542 & utr_bbl_temp(jpi,jpj) , vtr_bbl_temp(jpi,jpj), & 543 #endif 544 & rnf_temp(jpi,jpj) , h_rnf_temp(jpi,jpj) , & 545 & tsn_temp(jpi,jpj,jpk,2) , emp_b_temp(jpi,jpj), & 546 & emp_temp(jpi,jpj) , fmmflx_temp(jpi,jpj), & 547 & hmld_temp(jpi,jpj) , qsr_temp(jpi,jpj) , & 548 & fr_i_temp(jpi,jpj) , fr_i_tm(jpi,jpj) , & 549 & wndm_temp(jpi,jpj) , wndm_tm(jpi,jpj) , & 550 # if defined key_zdfddm 551 & avs_tm(jpi,jpj,jpk) , avs_temp(jpi,jpj,jpk) , & 552 # endif 553 & hdivn_temp(jpi,jpj,jpk) , hdivb_temp(jpi,jpj,jpk), & 554 & un_tm(jpi,jpj,jpk) , vn_tm(jpi,jpj,jpk) , & 555 & avt_tm(jpi,jpj,jpk) , & 556 & sshn_tm(jpi,jpj) , sshb_hold(jpi,jpj) , & 557 & tsn_tm(jpi,jpj,jpk,2) , & 558 & emp_tm(jpi,jpj) , fmmflx_tm(jpi,jpj) , & 559 & emp_b_hold(jpi,jpj) , & 560 & hmld_tm(jpi,jpj) , qsr_tm(jpi,jpj) , & 561 #if defined key_trabbl 562 & ahu_bbl_tm(jpi,jpj) , ahv_bbl_tm(jpi,jpj), & 563 & utr_bbl_tm(jpi,jpj) , vtr_bbl_tm(jpi,jpj), & 564 #endif 565 & rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc ) 545 INTEGER :: ierr(3) 546 !!------------------------------------------------------------------- 547 ! 548 ierr(:) = 0 549 ! 550 ALLOCATE( un_temp(jpi,jpj,jpk) , vn_temp(jpi,jpj,jpk) , & 551 & wn_temp(jpi,jpj,jpk) , & 552 & rhop_temp(jpi,jpj,jpk) , rhop_tm(jpi,jpj,jpk) , & 553 & sshn_temp(jpi,jpj) , sshb_temp(jpi,jpj) , & 554 & ssha_temp(jpi,jpj) , & 555 & rnf_temp(jpi,jpj) , h_rnf_temp(jpi,jpj) , & 556 & tsn_temp(jpi,jpj,jpk,2) , emp_b_temp(jpi,jpj) , & 557 & emp_temp(jpi,jpj) , fmmflx_temp(jpi,jpj) , & 558 & hmld_temp(jpi,jpj) , qsr_temp(jpi,jpj) , & 559 & fr_i_temp(jpi,jpj) , fr_i_tm(jpi,jpj) , & 560 & wndm_temp(jpi,jpj) , wndm_tm(jpi,jpj) , & 561 & avs_tm(jpi,jpj,jpk) , avs_temp(jpi,jpj,jpk) , & 562 & hdivn_temp(jpi,jpj,jpk) , hdivb_temp(jpi,jpj,jpk), & 563 & un_tm(jpi,jpj,jpk) , vn_tm(jpi,jpj,jpk) , & 564 & sshn_tm(jpi,jpj) , sshb_hold(jpi,jpj) , & 565 & tsn_tm(jpi,jpj,jpk,2) , & 566 & emp_tm(jpi,jpj) , fmmflx_tm(jpi,jpj) , & 567 & emp_b_hold(jpi,jpj) , & 568 & hmld_tm(jpi,jpj) , qsr_tm(jpi,jpj) , & 569 & rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , STAT=ierr(1) ) 570 ! 571 IF( l_ldfslp ) THEN 572 ALLOCATE( uslp_temp(jpi,jpj,jpk) , wslpi_temp(jpi,jpj,jpk), & 573 & vslp_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), & 574 & uslp_tm (jpi,jpj,jpk) , wslpi_tm (jpi,jpj,jpk), & 575 & vslp_tm (jpi,jpj,jpk) , wslpj_tm (jpi,jpj,jpk), STAT=ierr(2) ) 576 ENDIF 577 IF( ln_trabbl ) THEN 578 ALLOCATE( ahu_bbl_temp(jpi,jpj) , utr_bbl_temp(jpi,jpj) , & 579 & ahv_bbl_temp(jpi,jpj) , vtr_bbl_temp(jpi,jpj) , & 580 & ahu_bbl_tm (jpi,jpj) , utr_bbl_tm (jpi,jpj) , & 581 & ahv_bbl_tm (jpi,jpj) , vtr_bbl_tm (jpi,jpj) , STAT=ierr(3) ) 582 ENDIF 583 ! 584 trc_sub_alloc = MAXVAL( ierr ) 566 585 ! 567 586 IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate arrays') 568 !569 IF( l_ldfslp ) THEN570 ALLOCATE( uslp_temp(jpi,jpj,jpk) , wslpi_temp(jpi,jpj,jpk), &571 & vslp_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), &572 & uslp_tm (jpi,jpj,jpk) , wslpi_tm (jpi,jpj,jpk), &573 & vslp_tm (jpi,jpj,jpk) , wslpj_tm (jpi,jpj,jpk), STAT=trc_sub_alloc )574 ENDIF575 !576 IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays')577 587 ! 578 588 END FUNCTION trc_sub_alloc
Note: See TracChangeset
for help on using the changeset viewer.