Changeset 7871 for branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/TRP
- Timestamp:
- 2017-04-05T09:42:10+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r6204 r7871 44 44 45 45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt 46 46 REAL(wp) :: rfact1, rfact2 47 48 !! * Substitutions 49 # include "domzgr_substitute.h90" 50 # include "vectopt_loop_substitute.h90" 47 51 !!---------------------------------------------------------------------- 48 52 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 50 54 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 55 !!---------------------------------------------------------------------- 56 52 57 CONTAINS 53 58 … … 136 141 ! 137 142 ELSE 138 ! Leap-Frog + Asselin filter time stepping 139 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra, & 140 & sbc_trc, sbc_trc_b, jptra ) ! variable volume level (vvl) 141 ELSE ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! fixed volume level 143 IF( .NOT. lk_offline ) THEN ! Leap-Frog + Asselin filter time stepping 144 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra, & 145 & sbc_trc, sbc_trc_b, jptra ) ! variable volume level (vvl) 146 ELSE ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! fixed volume level 147 ENDIF 148 ELSE 149 CALL trc_nxt_off( kt ) ! offline 142 150 ENDIF 143 151 ENDIF … … 165 173 END SUBROUTINE trc_nxt 166 174 175 SUBROUTINE trc_nxt_off( kt ) 176 !!---------------------------------------------------------------------- 177 !! *** ROUTINE tra_nxt_vvl *** 178 !! 179 !! ** Purpose : Time varying volume: apply the Asselin time filter 180 !! and swap the tracer fields. 181 !! 182 !! ** Method : - Apply a thickness weighted Asselin time filter on now fields. 183 !! - save in (ta,sa) a thickness weighted average over the three 184 !! time levels which will be used to compute rdn and thus the semi- 185 !! implicit hydrostatic pressure gradient (ln_dynhpg_imp = T) 186 !! - swap tracer fields to prepare the next time_step. 187 !! This can be summurized for tempearture as: 188 !! ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) ln_dynhpg_imp = T 189 !! /( e3t_n + rbcp*[ e3t_b - 2 e3t_n + e3t_a ] ) 190 !! ztm = 0 otherwise 191 !! tb = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 192 !! /( e3t_n + atfp*[ e3t_b - 2 e3t_n + e3t_a ] ) 193 !! tn = ta 194 !! ta = zt (NB: reset to 0 after eos_bn2 call) 195 !! 196 !! ** Action : - (tb,sb) and (tn,sn) ready for the next time step 197 !! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T) 198 !!---------------------------------------------------------------------- 199 INTEGER , INTENT(in ) :: kt ! ocean time-step index 200 !! 201 INTEGER :: ji, jj, jk, jn ! dummy loop indices 202 REAL(wp) :: ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 203 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - - 204 !!---------------------------------------------------------------------- 205 ! 206 IF( kt == nittrc000 ) THEN 207 IF(lwp) WRITE(numout,*) 208 IF(lwp) WRITE(numout,*) 'trc_nxt_off : time stepping' 209 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 210 IF( lk_vvl ) THEN 211 rfact1 = atfp * rdttrc(1) 212 rfact2 = rfact1 / rau0 213 ENDIF 214 ENDIF 215 ! 216 DO jn = 1, jptra 217 DO jk = 1, jpkm1 218 DO jj = 1, jpj 219 DO ji = 1, jpi 220 ze3t_b = fse3t_b(ji,jj,jk) 221 ze3t_n = fse3t_n(ji,jj,jk) 222 ze3t_a = fse3t_a(ji,jj,jk) 223 ! ! tracer content at Before, now and after 224 ztc_b = trb(ji,jj,jk,jn) * ze3t_b 225 ztc_n = trn(ji,jj,jk,jn) * ze3t_n 226 ztc_a = tra(ji,jj,jk,jn) * ze3t_a 227 ! 228 ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b 229 ztc_d = ztc_a - 2. * ztc_n + ztc_b 230 ! 231 ze3t_f = ze3t_n + atfp * ze3t_d 232 ztc_f = ztc_n + atfp * ztc_d 233 ! 234 IF( lk_vvl .AND. jk == mikt(ji,jj) ) THEN ! first level 235 ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj) - emp(ji,jj) ) 236 ztc_f = ztc_f - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 237 ENDIF 238 239 ze3t_f = 1.e0 / ze3t_f 240 trb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered 241 trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) ! ptn <-- pta 242 ! 243 END DO 244 END DO 245 END DO 246 ! 247 END DO 248 ! 249 END SUBROUTINE trc_nxt_off 167 250 #else 168 251 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.