- Timestamp:
- 2017-03-17T08:46:30+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r7256 r7806 27 27 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 28 28 USE diaptr ! poleward transport diagnostics 29 USE phycst 29 30 ! 30 31 USE lib_mpp ! MPP library … … 34 35 USE timing ! Timing 35 36 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 37 USE iom 36 38 37 39 IMPLICIT NONE … … 42 44 43 45 LOGICAL :: l_trd ! flag to compute trends 46 LOGICAL :: l_trans ! flag to output vertically integrated transports 44 47 45 48 !! * Substitutions … … 85 88 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk ! - - 86 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 90 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 91 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 88 92 !!---------------------------------------------------------------------- 89 93 ! … … 97 101 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 98 102 ! 99 l_trd = .FALSE.100 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.101 103 ENDIF 102 ! 103 IF( l_trd ) THEN 104 105 l_trd = .FALSE. 106 l_trans = .FALSE. 107 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 108 IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 109 ! 110 IF( l_trd .OR. l_trans ) THEN 104 111 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 105 112 ztrdx(:,:,:) = 0.e0 ; ztrdy(:,:,:) = 0.e0 ; ztrdz(:,:,:) = 0.e0 113 CALL wrk_alloc( jpi, jpj, z2d ) 114 ENDIF 115 ! 116 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 117 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 118 zptry(:,:,:) = 0._wp 106 119 ENDIF 107 120 ! … … 187 200 188 201 ! ! trend diagnostics (contribution of upstream fluxes) 189 IF( l_trd ) THEN202 IF( l_trd .OR. l_trans ) THEN 190 203 ! store intermediate advective trends 191 204 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 192 205 END IF 193 206 ! ! "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 207 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 198 208 199 209 ! 3. antidiffusive flux : high order minus low order … … 253 263 254 264 ! ! trend diagnostics (contribution of upstream fluxes) 255 IF( l_trd ) THEN265 IF( l_trd .OR. l_trans ) THEN 256 266 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 257 267 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 258 268 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) ) 269 ENDIF 270 271 IF( l_trd ) THEN 272 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 273 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 274 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 263 275 END IF 264 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 276 277 IF( l_trans .AND. jn==jp_tem ) THEN 278 z2d(:,:) = 0._wp 279 DO jk = 1, jpkm1 280 DO jj = 2, jpjm1 281 DO ji = fs_2, fs_jpim1 ! vector opt. 282 z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk) 283 END DO 284 END DO 285 END DO 286 CALL lbc_lnk( z2d, 'U', -1. ) 287 CALL iom_put( "uadv_heattr", rau0_rcp * z2d ) ! heat transport in i-direction 288 ! 289 z2d(:,:) = 0._wp 290 DO jk = 1, jpkm1 291 DO jj = 2, jpjm1 292 DO ji = fs_2, fs_jpim1 ! vector opt. 293 z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk) 294 END DO 295 END DO 296 END DO 297 CALL lbc_lnk( z2d, 'V', -1. ) 298 CALL iom_put( "vadv_heattr", rau0_rcp * z2d ) ! heat transport in j-direction 299 ENDIF 300 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 265 301 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(:)302 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 303 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 268 304 ENDIF 269 305 ! 270 306 END DO 271 307 ! 272 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 273 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 308 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 309 IF( l_trd .OR. l_trans ) THEN 310 CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 311 CALL wrk_dealloc( jpi, jpj, z2d ) 312 ENDIF 313 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 274 314 ! 275 315 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd') … … 318 358 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 319 359 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 360 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 320 361 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 321 362 !!---------------------------------------------------------------------- … … 339 380 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 340 381 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 382 ENDIF 383 ! 384 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 385 CALL wrk_alloc( jpi, jpj,jpk, zptry ) 386 zptry(:,:,:) = 0._wp 341 387 ENDIF 342 388 ! … … 428 474 END IF 429 475 ! ! "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 476 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 434 477 435 478 ! 3. antidiffusive flux : high order minus low order … … 556 599 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 557 600 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(:)601 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) 602 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 560 603 ENDIF 561 604 ! … … 566 609 CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 567 610 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 611 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 568 612 ! 569 613 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd_zts')
Note: See TracChangeset
for help on using the changeset viewer.
