- Timestamp:
- 2015-12-16T10:25:22+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r5930 r6060 56 56 PUBLIC tra_nxt_vvl ! to be used in trcnxt 57 57 58 59 58 !! * Substitutions 60 # include " domzgr_substitute.h90"59 # include "vectopt_loop_substitute.h90" 61 60 !!---------------------------------------------------------------------- 62 61 !! NEMO/OPA 3.3 , NEMO-Consortium (2010) … … 86 85 !! domains (lk_agrif=T) 87 86 !! 88 !! ** Action : - (tb,sb) and (tn,sn) ready for the next time step 89 !! 87 !! ** Action : - tsb & tsn ready for the next time step 90 88 !!---------------------------------------------------------------------- 91 89 INTEGER, INTENT(in) :: kt ! ocean time-step index 92 90 !! 93 INTEGER :: j k, jn! dummy loop indices94 REAL(wp) :: zfact ! local scalars91 INTEGER :: ji, jj, jk, jn ! dummy loop indices 92 REAL(wp) :: zfact ! local scalars 95 93 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds 96 94 !!---------------------------------------------------------------------- … … 106 104 ! Update after tracer on domain lateral boundaries 107 105 ! 108 !109 106 #if defined key_agrif 110 107 CALL Agrif_tra ! AGRIF zoom boundaries … … 140 137 END DO 141 138 END DO 139 ! 142 140 ELSE ! Leap-Frog + Asselin filter time stepping 143 141 ! 144 IF( l k_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa, &145 & sbc_tsc, sbc_tsc_b, jpts ) ! variable volume level (vvl)146 ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level142 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! linear free surface 143 ELSE ; CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa, & 144 & sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface 147 145 ENDIF 146 ! 147 DO jn = 1, jpts 148 CALL lbc_lnk( tsb(:,:,:,jn), 'T', 1._wp ) 149 CALL lbc_lnk( tsn(:,:,:,jn), 'T', 1._wp ) 150 CALL lbc_lnk( tsa(:,:,:,jn), 'T', 1._wp ) 151 END DO 148 152 ENDIF 149 153 ! 150 ! trends computation151 154 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 152 155 DO jk = 1, jpkm1 … … 179 182 !! - swap tracer fields to prepare the next time_step. 180 183 !! 181 !! ** Action : - (tb,sb) and (tn,sn) ready for the next time step 182 !! 183 !!---------------------------------------------------------------------- 184 INTEGER , INTENT(in ) :: kt ! ocean time-step index 185 INTEGER , INTENT(in ) :: kit000 ! first time step index 186 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 187 INTEGER , INTENT(in ) :: kjpt ! number of tracers 188 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields 189 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields 190 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 184 !! ** Action : - tsb & tsn ready for the next time step 185 !!---------------------------------------------------------------------- 186 INTEGER , INTENT(in ) :: kt ! ocean time-step index 187 INTEGER , INTENT(in ) :: kit000 ! first time step index 188 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 189 INTEGER , INTENT(in ) :: kjpt ! number of tracers 190 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptb ! before tracer fields 191 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptn ! now tracer fields 192 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 191 193 ! 192 194 INTEGER :: ji, jj, jk, jn ! dummy loop indices 193 195 REAL(wp) :: ztn, ztd ! local scalars 194 196 !!---------------------------------------------------------------------- 195 197 ! 196 198 IF( kt == kit000 ) THEN 197 199 IF(lwp) WRITE(numout,*) … … 200 202 ENDIF 201 203 ! 202 !203 204 DO jn = 1, kjpt 204 205 ! 205 206 DO jk = 1, jpkm1 206 DO jj = 1, jpj207 DO ji = 1, jpi207 DO jj = 2, jpjm1 208 DO ji = fs_2, fs_jpim1 208 209 ztn = ptn(ji,jj,jk,jn) 209 ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers 210 ! 211 ptb(ji,jj,jk,jn) = ztn + atfp * ztd ! ptb <-- filtered ptn 212 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 213 ! 210 ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers 211 ! 212 ptb(ji,jj,jk,jn) = ztn + atfp * ztd ! ptb <-- filtered ptn 213 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 214 214 END DO 215 215 END DO … … 230 230 !! ** Method : - Apply a thickness weighted Asselin time filter on now fields. 231 231 !! - swap tracer fields to prepare the next time_step. 232 !! This can be summurized for tempearture as:233 !! 234 !! ** Action : - (tb,sb) and (tn,sn) ready for the next time step235 !! 236 !! ----------------------------------------------------------------------237 INTEGER , INTENT(in ) :: kt ! ocean time-step index238 INTEGER , INTENT(in ) :: kit000 ! first timestep index239 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! time-step240 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)241 INTEGER , INTENT(in ) :: kjpt ! number of tracers242 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields243 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! nowtracer fields244 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend245 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt) :: psbc_tc ! surface tracer content246 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt) :: psbc_tc_b ! beforesurface tracer content247 248 ! !232 !! tb = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 233 !! /( e3t_n + atfp*[ e3t_b - 2 e3t_n + e3t_a ] ) 234 !! tn = ta 235 !! 236 !! ** Action : - tsb & tsn ready for the next time step 237 !!---------------------------------------------------------------------- 238 INTEGER , INTENT(in ) :: kt ! ocean time-step index 239 INTEGER , INTENT(in ) :: kit000 ! first time step index 240 REAL(wp), DIMENSION(jpk) , INTENT(in ) :: p2dt ! time-step 241 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 242 INTEGER , INTENT(in ) :: kjpt ! number of tracers 243 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptb ! before tracer fields 244 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptn ! now tracer fields 245 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 246 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: psbc_tc ! surface tracer content 247 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: psbc_tc_b ! before surface tracer content 248 ! 249 249 LOGICAL :: ll_traqsr, ll_rnf, ll_isf ! local logical 250 250 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 259 259 ENDIF 260 260 ! 261 IF( cdtype == 'TRA' ) THEN 262 ll_traqsr = ln_traqsr ! active tracers case andsolar penetration263 ll_rnf = ln_rnf ! active tracers case andriver runoffs264 IF (nn_isf .GE. 1) THEN265 ll_isf = .TRUE. ! active tracers case andice shelf melting/freezing261 IF( cdtype == 'TRA' ) THEN ! active tracers case 262 ll_traqsr = ln_traqsr ! solar penetration 263 ll_rnf = ln_rnf ! river runoffs 264 IF( nn_isf >= 1 ) THEN 265 ll_isf = .TRUE. ! ice shelf melting/freezing 266 266 ELSE 267 267 ll_isf = .FALSE. 268 268 END IF 269 ELSE 270 ll_traqsr = .FALSE. ! active tracers case andNO solar penetration271 ll_rnf = .FALSE. ! passive tracers or NO river runoffs272 ll_isf = .FALSE. ! passive tracers or NO ice shelf melting/freezing269 ELSE ! passive tracers case 270 ll_traqsr = .FALSE. ! NO solar penetration 271 ll_rnf = .FALSE. ! NO river runoffs ???? !!gm BUG ? 272 ll_isf = .FALSE. ! NO ice shelf melting/freezing !!gm BUG ?? 273 273 ENDIF 274 274 ! … … 276 276 DO jk = 1, jpkm1 277 277 zfact1 = atfp * p2dt(jk) 278 zfact2 = zfact1 /rau0279 DO jj = 1, jpj280 DO ji = 1, jpi281 ze3t_b = fse3t_b(ji,jj,jk)282 ze3t_n = fse3t_n(ji,jj,jk)283 ze3t_a = fse3t_a(ji,jj,jk)278 zfact2 = zfact1 * r1_rau0 279 DO jj = 2, jpjm1 280 DO ji = fs_2, fs_jpim1 281 ze3t_b = e3t_b(ji,jj,jk) 282 ze3t_n = e3t_n(ji,jj,jk) 283 ze3t_a = e3t_a(ji,jj,jk) 284 284 ! ! tracer content at Before, now and after 285 285 ztc_b = ptb(ji,jj,jk,jn) * ze3t_b … … 299 299 ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 300 300 ENDIF 301 301 ! 302 302 ! solar penetration (temperature only) 303 303 IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) & 304 304 & ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 305 305 ! 306 306 ! river runoff 307 307 IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & 308 308 & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 309 & * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)310 309 & * e3t_n(ji,jj,jk) / h_rnf(ji,jj) 310 ! 311 311 ! ice shelf 312 312 IF( ll_isf ) THEN … … 314 314 IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) ) & 315 315 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 316 & * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)316 & * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) 317 317 ! level partially include in Losch_2008 ice shelf boundary layer 318 318 IF ( jk == misfkb(ji,jj) ) & 319 319 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 320 & * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)320 & * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 321 321 END IF 322 322 ! 323 323 ze3t_f = 1.e0 / ze3t_f 324 324 ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered
Note: See TracChangeset
for help on using the changeset viewer.