Changeset 6671
- Timestamp:
- 2016-06-07T14:10:11+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6535 r6671 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 88 REAL(wp), POINTER, DIMENSION(:,: ,:) :: zptry89 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, z2d, zptry 90 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 89 91 !!---------------------------------------------------------------------- 90 92 ! … … 99 101 ! 100 102 l_trd = .FALSE. 103 l_trans = .FALSE. 101 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. 102 106 ENDIF 103 107 ! 104 IF( l_trd ) THEN108 IF( l_trd .OR. l_trans ) THEN 105 109 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 106 110 ztrdx(:,:,:) = 0.e0 ; ztrdy(:,:,:) = 0.e0 ; ztrdz(:,:,:) = 0.e0 111 CALL wrk_alloc( jpi, jpj, z2d ) 107 112 ENDIF 108 113 ! … … 194 199 195 200 ! ! trend diagnostics (contribution of upstream fluxes) 196 IF( l_trd ) THEN201 IF( l_trd .OR. l_trans ) THEN 197 202 ! store intermediate advective trends 198 203 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) … … 257 262 258 263 ! ! trend diagnostics (contribution of upstream fluxes) 259 IF( l_trd ) THEN264 IF( l_trd .OR. l_trans ) THEN 260 265 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 261 266 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 262 267 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 263 268 ENDIF 269 270 IF( l_trd ) THEN 264 271 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 265 272 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 266 273 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 267 274 END IF 268 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 275 276 IF( l_trans .AND. jn==jp_tem ) THEN 277 z2d(:,:) = 0._wp 278 DO jk = 1, jpkm1 279 DO jj = 2, jpjm1 280 DO ji = fs_2, fs_jpim1 ! vector opt. 281 z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk) 282 END DO 283 END DO 284 END DO 285 CALL lbc_lnk( z2d, 'U', -1. ) 286 CALL iom_put( "uadv_heattr", rau0_rcp * z2d ) ! heat transport in i-direction 287 ! 288 z2d(:,:) = 0._wp 289 DO jk = 1, jpkm1 290 DO jj = 2, jpjm1 291 DO ji = fs_2, fs_jpim1 ! vector opt. 292 z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk) 293 END DO 294 END DO 295 END DO 296 CALL lbc_lnk( z2d, 'V', -1. ) 297 CALL iom_put( "vadv_heattr", rau0_rcp * z2d ) ! heat transport in j-direction 298 ENDIF 299 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 269 300 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 270 301 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed … … 274 305 END DO 275 306 ! 276 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 277 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 307 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 308 IF( l_trd .OR. l_trans ) THEN 309 CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 310 CALL wrk_dealloc( jpi, jpj, z2d ) 311 ENDIF 278 312 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 279 313 !
Note: See TracChangeset
for help on using the changeset viewer.