Changeset 14200 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trcatf.F90
- Timestamp:
- 2020-12-17T15:36:44+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trcatf.F90
r14086 r14200 25 25 !! 'key_top' TOP models 26 26 !!---------------------------------------------------------------------- 27 !! trc_atf : time stepping on passive tracers27 !! trc_atf : time stepping on passive tracers 28 28 !!---------------------------------------------------------------------- 29 29 USE par_trc ! need jptra, number of passive tracers 30 USE oce_trc 31 USE trc 30 USE oce_trc ! ocean dynamics and tracers variables 31 USE trc ! ocean passive tracers variables 32 32 USE trd_oce 33 33 USE trdtra 34 # if defined key_qco 35 USE traatf_qco 34 # if defined key_qco || defined key_linssh 35 USE traatf_qco ! tracer : Asselin filter (qco) 36 36 # else 37 USE traatf 37 USE traatf ! tracer : Asselin filter (vvl) 38 38 # endif 39 39 USE bdy_oce , ONLY: ln_bdy 40 USE trcbdy 40 USE trcbdy ! BDY open boundaries 41 41 # if defined key_agrif 42 42 USE agrif_top_interp 43 43 # endif 44 44 ! 45 USE lbclnk 46 USE prtctl 45 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 46 USE prtctl ! Print control for debbuging 47 47 48 48 IMPLICIT NONE … … 103 103 #endif 104 104 ! Update after tracer on domain lateral boundaries 105 CALL lbc_lnk( 'trcatf', ptr(:,:,:,:,Kaa), 'T', 1. )105 CALL lbc_lnk( 'trcatf', ptr(:,:,:,:,Kaa), 'T', 1._wp ) 106 106 107 107 IF( ln_bdy ) CALL trc_bdy( kt, Kbb, Kmm, Kaa ) … … 157 157 ELSE 158 158 IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping 159 # if defined key_qco 159 # if defined key_qco || defined key_linssh 160 160 IF( ln_linssh ) THEN ; CALL tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, nittrc000, 'TRC', ptr, jptra ) ! linear ssh 161 161 ELSE ; CALL tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 162 162 # else 163 IF( ln_linssh ) THEN ; CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nittrc000, 'TRC', ptr, jptra ) ! linear ssh164 ELSE ; CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh163 IF( ln_linssh ) THEN ; CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nittrc000, 'TRC', ptr, jptra ) ! linear ssh 164 ELSE ; CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 165 165 # endif 166 166 ENDIF … … 169 169 ENDIF 170 170 ! 171 CALL lbc_lnk _multi( 'trcatf', ptr(:,:,:,:,Kmm), 'T', 1._wp, ptr(:,:,:,:,Kaa), 'T', 1._wp, ptr(:,:,:,:,Kaa), 'T', 1._wp )171 CALL lbc_lnk( 'trcatf', ptr(:,:,:,:,Kmm), 'T', 1._wp ) 172 172 ENDIF 173 173 ! … … 193 193 END SUBROUTINE trc_atf 194 194 195 # if ! defined key_qco195 # if defined key_qco || defined key_linssh 196 196 SUBROUTINE trc_atf_off( kt, Kbb, Kmm, Kaa, ptr ) 197 197 !!---------------------------------------------------------------------- … … 225 225 INTEGER :: ji, jj, jk, jn ! dummy loop indices 226 226 REAL(wp) :: ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 227 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f , ze3t_d! - -227 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f ! - - 228 228 !!---------------------------------------------------------------------- 229 229 ! … … 241 241 DO jn = 1, jptra 242 242 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 243 ze3t_b = e3t(ji,jj,jk,Kbb)244 ze3t_n = e3t(ji,jj,jk,Kmm)245 ze3t_a = e3t(ji,jj,jk,Kaa)243 ze3t_b = 1._wp + r3t(ji,jj,Kbb) * tmask(ji,jj,jk) 244 ze3t_n = 1._wp + r3t(ji,jj,Kmm) * tmask(ji,jj,jk) 245 ze3t_a = 1._wp + r3t(ji,jj,Kaa) * tmask(ji,jj,jk) 246 246 ! ! tracer content at Before, now and after 247 ztc_b = ptr(ji,jj,jk,jn,Kbb) 248 ztc_n = ptr(ji,jj,jk,jn,Kmm) 247 ztc_b = ptr(ji,jj,jk,jn,Kbb) * ze3t_b 248 ztc_n = ptr(ji,jj,jk,jn,Kmm) * ze3t_n 249 249 ztc_a = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 250 250 ! 251 ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b252 251 ztc_d = ztc_a - 2. * ztc_n + ztc_b 253 252 ! 254 ze3t_f = ze3t_n + rn_atfp * ze3t_d253 ze3t_f = 1._wp + r3t_f(ji,jj)*tmask(ji,jj,jk) 255 254 ztc_f = ztc_n + rn_atfp * ztc_d 256 255 ! 257 256 IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN ! first level 258 ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj) - emp(ji,jj) )259 257 ztc_f = ztc_f - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 260 258 ENDIF … … 300 298 INTEGER :: ji, jj, jk, jn ! dummy loop indices 301 299 REAL(wp) :: ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 302 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f 300 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - - 303 301 !!---------------------------------------------------------------------- 304 302 ! … … 316 314 DO jn = 1, jptra 317 315 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 318 ze3t_b = 1._wp + r3t(ji,jj,Kbb) * tmask(ji,jj,jk)319 ze3t_n = 1._wp + r3t(ji,jj,Kmm) * tmask(ji,jj,jk)320 ze3t_a = 1._wp + r3t(ji,jj,Kaa) * tmask(ji,jj,jk)316 ze3t_b = e3t(ji,jj,jk,Kbb) 317 ze3t_n = e3t(ji,jj,jk,Kmm) 318 ze3t_a = e3t(ji,jj,jk,Kaa) 321 319 ! ! tracer content at Before, now and after 322 ztc_b = ptr(ji,jj,jk,jn,Kbb) * ze3t_b323 ztc_n = ptr(ji,jj,jk,jn,Kmm) * ze3t_n320 ztc_b = ptr(ji,jj,jk,jn,Kbb) * ze3t_b 321 ztc_n = ptr(ji,jj,jk,jn,Kmm) * ze3t_n 324 322 ztc_a = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 325 323 ! 324 ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b 326 325 ztc_d = ztc_a - 2. * ztc_n + ztc_b 327 326 ! 328 ze3t_f = 1._wp + r3t_f(ji,jj)*tmask(ji,jj,jk)327 ze3t_f = ze3t_n + rn_atfp * ze3t_d 329 328 ztc_f = ztc_n + rn_atfp * ztc_d 330 329 ! 331 330 IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN ! first level 331 ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj) - emp(ji,jj) ) 332 332 ztc_f = ztc_f - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 333 333 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
