- Timestamp:
- 2016-11-03T16:39:56+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6795 r7179 34 34 USE timing ! Timing 35 35 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 36 USE iom 36 37 37 38 IMPLICIT NONE … … 42 43 43 44 LOGICAL :: l_trd ! flag to compute trends 45 LOGICAL :: l_trans ! flag to output vertically integrated transports 44 46 45 47 !! * Substitutions … … 85 87 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk ! - - 86 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 90 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 88 91 !!---------------------------------------------------------------------- 89 92 ! … … 98 101 ! 99 102 l_trd = .FALSE. 103 l_trans = .FALSE. 100 104 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 105 IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 101 106 ENDIF 102 107 ! 103 IF( l_trd ) THEN108 IF( l_trd .OR. l_trans ) THEN 104 109 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 105 110 ztrdx(:,:,:) = 0.e0 ; ztrdy(:,:,:) = 0.e0 ; ztrdz(:,:,:) = 0.e0 111 CALL wrk_alloc( jpi, jpj, z2d ) 112 ENDIF 113 ! 114 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 115 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 116 zptry(:,:,:) = 0._wp 106 117 ENDIF 107 118 ! … … 187 198 188 199 ! ! trend diagnostics (contribution of upstream fluxes) 189 IF( l_trd ) THEN200 IF( l_trd .OR. l_trans ) THEN 190 201 ! store intermediate advective trends 191 202 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 192 203 END IF 193 204 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 194 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 195 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 196 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 197 ENDIF 205 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 198 206 199 207 ! 3. antidiffusive flux : high order minus low order … … 253 261 254 262 ! ! trend diagnostics (contribution of upstream fluxes) 255 IF( l_trd ) THEN263 IF( l_trd .OR. l_trans ) THEN 256 264 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 257 265 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 258 266 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 259 260 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 261 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 262 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 267 ENDIF 268 269 IF( l_trd ) THEN 270 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 271 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 272 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 263 273 END IF 264 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 274 275 IF( l_trans .AND. jn==jp_tem ) THEN 276 z2d(:,:) = 0._wp 277 DO jk = 1, jpkm1 278 DO jj = 2, jpjm1 279 DO ji = fs_2, fs_jpim1 ! vector opt. 280 z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk) 281 END DO 282 END DO 283 END DO 284 CALL lbc_lnk( z2d, 'U', -1. ) 285 CALL iom_put( "uadv_heattr", rau0_rcp * z2d ) ! heat transport in i-direction 286 ! 287 z2d(:,:) = 0._wp 288 DO jk = 1, jpkm1 289 DO jj = 2, jpjm1 290 DO ji = fs_2, fs_jpim1 ! vector opt. 291 z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk) 292 END DO 293 END DO 294 END DO 295 CALL lbc_lnk( z2d, 'V', -1. ) 296 CALL iom_put( "vadv_heattr", rau0_rcp * z2d ) ! heat transport in j-direction 297 ENDIF 298 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 265 299 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 266 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)267 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)300 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 301 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 268 302 ENDIF 269 303 ! 270 304 END DO 271 305 ! 272 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 273 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 306 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 307 IF( l_trd .OR. l_trans ) THEN 308 CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 309 CALL wrk_dealloc( jpi, jpj, z2d ) 310 ENDIF 311 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 274 312 ! 275 313 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd') … … 318 356 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 319 357 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 358 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 320 359 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 321 360 !!---------------------------------------------------------------------- … … 339 378 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 340 379 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 380 ENDIF 381 ! 382 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 383 CALL wrk_alloc( jpi, jpj,jpk, zptry ) 384 zptry(:,:,:) = 0._wp 341 385 ENDIF 342 386 ! … … 428 472 END IF 429 473 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 430 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 431 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 432 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 433 ENDIF 474 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 434 475 435 476 ! 3. antidiffusive flux : high order minus low order … … 556 597 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 557 598 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 558 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)559 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)599 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) 600 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 560 601 ENDIF 561 602 ! … … 566 607 CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 567 608 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 609 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 568 610 ! 569 611 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd_zts')
Note: See TracChangeset
for help on using the changeset viewer.