Changeset 7241


Ignore:
Timestamp:
2016-11-16T16:29:54+01:00 (4 years ago)
Author:
timgraham
Message:

Added advective 2D (i/j) heat transport fields in FCT advection scheme

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r7236 r7241  
    3636 
    3737   LOGICAL  ::   l_trd   ! flag to compute trends 
     38   LOGICAL  ::   l_trans   ! flag to output vertically integrated transports 
    3839   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6 
    3940 
     
    8182      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
    8283      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrd, zptry 
     84      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d 
    8385      !!---------------------------------------------------------------------- 
    8486      ! 
     
    9496      ! 
    9597      l_trd = .FALSE. 
     98      l_trans = .FALSE. 
    9699      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    97       ! 
    98       IF( l_trd )  THEN 
     100      IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 
     101      ! 
     102      IF( l_trd .OR. l_trans )  THEN 
    99103         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    100104         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
     
    165169         CALL lbc_lnk( zwi, 'T', 1. )  ! Lateral boundary conditions on zwi  (unchanged sign) 
    166170         !                 
    167          IF( l_trd )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
     171         IF( l_trd .OR. l_trans )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
    168172            ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:) 
    169173         END IF 
     
    293297         END DO 
    294298         ! 
    295          IF( l_trd ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
     299         IF( l_trd .OR. l_trans ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    296300            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    297301            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    298302            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    299             ! 
     303         ENDIF 
     304            ! 
     305         IF( l_trd ) THEN  
    300306            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
    301307            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
    302308            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    303309            ! 
    304             CALL wrk_dealloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz ) 
    305310         END IF 
    306          !                    ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     311 
     312         IF( l_trans .AND. jn==jp_tem ) THEN 
     313            CALL wrk_alloc( jpi, jpj, z2d ) 
     314            z2d(:,:) = 0._wp  
     315            DO jk = 1, jpkm1 
     316               DO jj = 2, jpjm1 
     317                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     318                     z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk)  
     319                  END DO 
     320               END DO 
     321            END DO 
     322            CALL lbc_lnk( z2d, 'U', -1. ) 
     323            CALL iom_put( "uadv_heattr", rau0_rcp * z2d )       ! heat transport in i-direction 
     324              ! 
     325            z2d(:,:) = 0._wp  
     326            DO jk = 1, jpkm1 
     327               DO jj = 2, jpjm1 
     328                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     329                     z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk)  
     330                  END DO 
     331               END DO 
     332            END DO 
     333            CALL lbc_lnk( z2d, 'V', -1. ) 
     334            CALL iom_put( "vadv_heattr", rau0_rcp * z2d )       ! heat transport in j-direction 
     335            CALL wrk_dealloc( jpi, jpj, z2d ) 
     336         ENDIF 
     337         ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    307338         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    308339            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     
    313344      ! 
    314345      CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 
     346      IF( l_trd .OR. l_trans )  THEN  
     347         CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     348      ENDIF 
    315349      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    316350      ! 
Note: See TracChangeset for help on using the changeset viewer.