- Timestamp:
- 2016-11-30T17:56:53+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r6771 r7403 20 20 USE trdtra ! tracers trends 21 21 USE diaptr ! poleward transport diagnostics 22 USE diaar5 ! AR5 diagnostics 23 USE phycst, ONLY: rau0_rcp 22 24 ! 23 25 USE in_out_manager ! I/O manager 26 USE iom 24 27 USE lib_mpp ! MPP library 25 28 USE lbclnk ! ocean lateral boundary condition (or mpp link) … … 36 39 37 40 LOGICAL :: l_trd ! flag to compute trends 41 LOGICAL :: l_ptr ! flag to compute poleward transport 42 LOGICAL :: l_hst ! flag to compute heat/salt transport 38 43 REAL(wp) :: r1_6 = 1._wp / 6._wp ! =1/6 39 44 … … 80 85 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - 81 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 88 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 83 89 !!---------------------------------------------------------------------- 84 90 ! … … 94 100 ! 95 101 l_trd = .FALSE. 96 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 97 ! 98 IF( l_trd ) THEN 102 l_hst = .FALSE. 103 l_ptr = .FALSE. 104 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 105 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 106 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 107 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 108 ! 109 IF( l_trd .OR. l_hst ) THEN 99 110 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 100 111 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 101 112 ENDIF 102 113 ! 114 IF( l_ptr ) THEN 115 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 116 zptry(:,:,:) = 0._wp 117 ENDIF 103 118 ! ! surface & bottom value : flux set to zero one for all 104 119 zwz(:,:, 1 ) = 0._wp … … 161 176 CALL lbc_lnk( zwi, 'T', 1. ) ! Lateral boundary conditions on zwi (unchanged sign) 162 177 ! 163 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)178 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 164 179 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 165 180 END IF 166 181 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 167 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 168 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 169 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 170 ENDIF 182 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 171 183 ! 172 184 ! !== anti-diffusive flux : high order minus low order ==! … … 292 304 END DO 293 305 ! 294 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)306 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 295 307 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 296 308 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 297 309 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 298 ! 310 ENDIF 311 ! 312 IF( l_trd ) THEN 299 313 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 300 314 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 301 315 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 302 316 ! 303 CALL wrk_dealloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz )304 317 END IF 305 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 306 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 307 IF( jn == jp_tem ) htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) ) 308 IF( jn == jp_sal ) str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) ) 318 ! ! heat/salt transport 319 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 320 321 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 322 IF( l_ptr ) THEN 323 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 324 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 309 325 ENDIF 310 326 ! 311 327 END DO ! end of tracer loop 312 328 ! 313 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 329 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 330 IF( l_trd .OR. l_hst ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 331 IF( l_ptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 314 332 ! 315 333 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_fct') … … 357 375 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav 358 376 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 377 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 359 378 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 360 379 !!---------------------------------------------------------------------- … … 373 392 ! 374 393 l_trd = .FALSE. 375 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 376 ! 377 IF( l_trd ) THEN 394 l_hst = .FALSE. 395 l_ptr = .FALSE. 396 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 397 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 398 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 399 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 400 ! 401 IF( l_trd .OR. l_hst ) THEN 378 402 CALL wrk_alloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz ) 379 403 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 380 404 ENDIF 381 405 ! 406 IF( l_ptr ) THEN 407 CALL wrk_alloc( jpi, jpj,jpk, zptry ) 408 zptry(:,:,:) = 0._wp 409 ENDIF 382 410 zwi(:,:,:) = 0._wp 383 411 z_rzts = 1._wp / REAL( kn_fct_zts, wp ) … … 445 473 CALL lbc_lnk( zwi, 'T', 1. ) ! Lateral boundary conditions on zwi (unchanged sign) 446 474 ! 447 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)475 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 448 476 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 449 477 END IF 450 478 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 451 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 452 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 453 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 454 ENDIF 479 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 455 480 456 481 ! 3. anti-diffusive flux : high order minus low order … … 568 593 END DO 569 594 570 ! ! trend diagnostics (contribution of upstream fluxes)571 IF( l_trd ) THEN595 ! 596 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 572 597 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 573 598 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 574 599 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 575 ! 576 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 577 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 578 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 579 ! 580 CALL wrk_dealloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz ) 600 ENDIF 601 ! 602 IF( l_trd ) THEN 603 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 604 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 605 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 606 ! 581 607 END IF 582 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 583 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 584 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 585 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 608 ! ! heat/salt transport 609 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 610 611 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 612 IF( l_ptr ) THEN 613 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 614 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 586 615 ENDIF 587 616 ! 588 617 END DO 589 618 ! 590 CALL wrk_alloc( jpi,jpj, zwx_sav, zwy_sav ) 591 CALL wrk_alloc( jpi,jpj, jpk, zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 592 CALL wrk_alloc( jpi,jpj,jpk,kjpt+1, ztrs ) 619 CALL wrk_alloc( jpi,jpj, zwx_sav, zwy_sav ) 620 CALL wrk_alloc( jpi,jpj, jpk, zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 621 CALL wrk_alloc( jpi,jpj,jpk,kjpt+1, ztrs ) 622 IF( l_trd .OR. l_hst ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 623 IF( l_ptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 593 624 ! 594 625 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_fct_zts')
Note: See TracChangeset
for help on using the changeset viewer.
