Changeset 9987 for branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
- Timestamp:
- 2018-07-23T11:33:03+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r7960 r9987 28 28 USE sbc_oce ! surface boundary condition: ocean 29 29 USE sbcrnf ! river runoffs 30 USE sbcisf ! ice shelf melting/freezing 30 31 USE zdf_oce ! ocean vertical mixing 31 32 USE domvvl ! variable volume … … 46 47 USE timing ! Timing 47 48 #if defined key_agrif 48 USE agrif_opa_update49 49 USE agrif_opa_interp 50 50 #endif … … 110 110 ! Update after tracer on domain lateral boundaries 111 111 ! 112 #if defined key_agrif 113 CALL Agrif_tra ! AGRIF zoom boundaries 114 #endif 115 ! 112 116 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp ) ! local domain boundaries (T-point, unchanged sign) 113 117 CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) … … 115 119 #if defined key_bdy 116 120 IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 117 #endif118 #if defined key_agrif119 CALL Agrif_tra ! AGRIF zoom boundaries120 121 #endif 121 122 … … 126 127 127 128 ! trends computation initialisation 128 IF( l_trdtra ) THEN ! store now fields before applying the Asselin filter129 IF( l_trdtra ) THEN 129 130 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 130 ztrdt(:,:, :) = tsn(:,:,:,jp_tem)131 ztrds(:,:, :) = tsn(:,:,:,jp_sal)131 ztrdt(:,:,jpk) = 0._wp 132 ztrds(:,:,jpk) = 0._wp 132 133 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 133 134 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 134 135 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 135 136 ENDIF 137 ! total trend for the non-time-filtered variables. 138 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms 139 IF( lk_vvl ) THEN 140 DO jk = 1, jpkm1 141 zfact = 1.0 / rdttra(jk) 142 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact 143 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact 144 END DO 145 ELSE 146 DO jk = 1, jpkm1 147 zfact = 1.0 / rdttra(jk) 148 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 149 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 150 END DO 151 END IF 152 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 153 CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 154 IF( .NOT.lk_vvl ) THEN 155 ! Store now fields before applying the Asselin filter 156 ! in order to calculate Asselin filter trend later. 157 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 158 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 159 END IF 136 160 ENDIF 137 161 … … 142 166 END DO 143 167 END DO 168 IF (l_trdtra.AND.lk_vvl) THEN ! Zero Asselin filter contribution must be explicitly written out since for vvl 169 ! Asselin filter is output by tra_nxt_vvl that is not called on this time step 170 ztrdt(:,:,:) = 0._wp 171 ztrds(:,:,:) = 0._wp 172 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 173 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 174 END IF 144 175 ELSE ! Leap-Frog + Asselin filter time stepping 145 176 ! … … 148 179 ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level 149 180 ENDIF 150 ENDIF 151 ! 152 #if defined key_agrif 153 ! Update tracer at AGRIF zoom boundaries 154 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tra( kt ) ! children only 155 #endif 156 ! 157 ! trends computation 158 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 181 ENDIF 182 ! 183 ! trends computation 184 IF( l_trdtra.AND..NOT.lk_vvl) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 159 185 DO jk = 1, jpkm1 160 186 zfact = 1._wp / r2dtra(jk) … … 164 190 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 165 191 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 166 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )167 192 END IF 193 IF( l_trdtra) CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 168 194 ! 169 195 ! ! control print … … 279 305 280 306 !! 281 LOGICAL :: ll_tra_hpg, ll_traqsr, ll_rnf ! local logical307 LOGICAL :: ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf ! local logical 282 308 INTEGER :: ji, jj, jk, jn ! dummy loop indices 283 REAL(wp) :: zfact 1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar309 REAL(wp) :: zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 284 310 REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - - 311 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrd_atf 285 312 !!---------------------------------------------------------------------- 286 313 ! … … 295 322 ll_traqsr = ln_traqsr ! active tracers case and solar penetration 296 323 ll_rnf = ln_rnf ! active tracers case and river runoffs 324 IF (nn_isf .GE. 1) THEN 325 ll_isf = .TRUE. ! active tracers case and ice shelf melting/freezing 326 ELSE 327 ll_isf = .FALSE. 328 END IF 297 329 ELSE 298 330 ll_tra_hpg = .FALSE. ! passive tracers case or NO semi-implicit hpg 299 331 ll_traqsr = .FALSE. ! active tracers case and NO solar penetration 300 332 ll_rnf = .FALSE. ! passive tracers or NO river runoffs 301 ENDIF 302 ! 333 ll_isf = .FALSE. ! passive tracers or NO ice shelf melting/freezing 334 ENDIF 335 ! 336 IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN 337 CALL wrk_alloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 338 ztrd_atf(:,:,:,:) = 0.0_wp 339 ENDIF 303 340 DO jn = 1, kjpt 304 341 DO jk = 1, jpkm1 342 zfact = 1._wp / r2dtra(jk) 305 343 zfact1 = atfp * p2dt(jk) 306 344 zfact2 = zfact1 / rau0 … … 321 359 ztc_f = ztc_n + atfp * ztc_d 322 360 ! 323 IF( jk == 1 ) THEN ! first level 324 ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) + rnf(ji,jj) - rnf_b(ji,jj) ) 361 IF( jk == mikt(ji,jj) ) THEN ! first level 362 ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj) - emp(ji,jj) ) & 363 & - (rnf_b(ji,jj) - rnf(ji,jj) ) & 364 & + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) 325 365 ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 326 366 ENDIF 327 367 328 IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) & ! solar penetration (temperature only) 368 ! solar penetration (temperature only) 369 IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) & 329 370 & ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 330 371 331 IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & ! river runoffs 372 ! river runoff 373 IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & 332 374 & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 333 375 & * fse3t_n(ji,jj,jk) / h_rnf(ji,jj) 376 377 ! ice shelf 378 IF( ll_isf ) THEN 379 ! level fully include in the Losch_2008 ice shelf boundary layer 380 IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) ) & 381 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 382 & * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) 383 ! level partially include in Losch_2008 ice shelf boundary layer 384 IF ( jk == misfkb(ji,jj) ) & 385 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 386 & * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 387 END IF 334 388 335 389 ze3t_f = 1.e0 / ze3t_f … … 340 394 ze3t_d = 1.e0 / ( ze3t_n + rbcp * ze3t_d ) 341 395 pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n + rbcp * ztc_d ) ! ta <-- Brown & Campana average 396 ENDIF 397 IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN 398 ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n 342 399 ENDIF 343 400 END DO … … 347 404 END DO 348 405 ! 406 IF( l_trdtra .and. cdtype == 'TRA' ) THEN 407 CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) ) 408 CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) ) 409 CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 410 ENDIF 411 IF( l_trdtrc .and. cdtype == 'TRC' ) THEN 412 DO jn = 1, kjpt 413 CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) ) 414 END DO 415 CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 416 ENDIF 417 349 418 END SUBROUTINE tra_nxt_vvl 350 419
Note: See TracChangeset
for help on using the changeset viewer.