New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 7236 for branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2016-11-16T12:48:46+01:00 (7 years ago)
Author:
timgraham
Message:

All changes related to diaptr (basin heat transports and transport components)

Location:
branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r6140 r7236  
    99   !!            3.3  ! 2010-10  (G. Madec)  dynamical allocation 
    1010   !!            3.6  ! 2014-12  (C. Ethe) use of IOM 
     11   !!            3.6  ! 2016-06  (T. Graham) Addition of diagnostics for CMIP6 
    1112   !!---------------------------------------------------------------------- 
    1213 
     
    2122   USE dom_oce          ! ocean space and time domain 
    2223   USE phycst           ! physical constants 
     24   USE ldftra  
    2325   ! 
    2426   USE iom              ! IOM library 
     
    3840   PUBLIC   dia_ptr_init   ! call in step module 
    3941   PUBLIC   dia_ptr        ! call in step module 
     42   PUBLIC   dia_ptr_ohst_components        ! called from tra_ldf/tra_adv routines 
    4043 
    4144   !                                  !!** namelist  namptr  ** 
    42    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf   !: Heat TRansports (adv, diff, overturn.) 
    43    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf   !: Salt TRansports (adv, diff, overturn.) 
    44     
     45   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf, htr_eiv, htr_vt   !: Heat TRansports (adv, diff, Bolus.) 
     46   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf, str_eiv, str_vs   !: Salt TRansports (adv, diff, Bolus.) 
     47   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_ove, str_ove   !: heat Salt TRansports ( overturn.) 
     48   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_btr, str_btr   !: heat Salt TRansports ( barotropic ) 
    4549 
    4650   LOGICAL, PUBLIC ::   ln_diaptr   !  Poleward transport flag (T) or not (F) 
    4751   LOGICAL, PUBLIC ::   ln_subbas   !  Atlantic/Pacific/Indian basins calculation 
    48    INTEGER        ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T)  
     52   INTEGER, PUBLIC ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T)  
    4953 
    5054   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
     
    7579      ! 
    7680      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    77       REAL(wp) ::   zv, zsfc               ! local scalar 
     81      REAL(wp) ::   zsfc,zvfc               ! local scalar 
    7882      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace 
    7983      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d   ! 3D workspace 
    8084      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace 
    8185      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace 
    82       CHARACTER( len = 10 )  :: cl1 
     86      REAL(wp), DIMENSION(jpj)     ::  vsum   ! 1D workspace 
     87      REAL(wp), DIMENSION(jpj,jpts)     ::  tssum   ! 1D workspace 
     88  
     89      ! 
     90      !overturning calculation 
     91      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   sjk  , r1_sjk ! i-mean i-k-surface and its inverse 
     92      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   v_msf, sn_jk  , tn_jk ! i-mean T and S, j-Stream-Function 
     93      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zvn   ! 3D workspace 
     94 
     95 
     96      CHARACTER( len = 12 )  :: cl1 
    8397      !!---------------------------------------------------------------------- 
    8498      ! 
     
    109123            END DO 
    110124         ENDIF 
     125         IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 
     126            ! define fields multiplied by scalar 
     127            zmask(:,:,:) = 0._wp 
     128            zts(:,:,:,:) = 0._wp 
     129            zvn(:,:,:) = 0._wp 
     130            DO jk = 1, jpkm1 
     131               DO jj = 1, jpjm1 
     132                  DO ji = 1, jpi 
     133                     zvfc = e1v(ji,jj) * e3v_n(ji,jj,jk) 
     134                     zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
     135                     zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid 
     136                     zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 
     137                     zvn(ji,jj,jk)        = vn(ji,jj,jk)         * zvfc 
     138                  ENDDO 
     139               ENDDO 
     140             ENDDO 
     141         ENDIF 
     142         IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 
     143             sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 
     144             r1_sjk(:,:,1) = 0._wp 
     145             WHERE( sjk(:,:,1) /= 0._wp )   r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 
     146 
     147             ! i-mean T and S, j-Stream-Function, global 
     148             tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 
     149             sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 
     150             v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 
     151 
     152             htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 
     153             str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 
     154 
     155             z2d(1,:) = htr_ove(:,1) * rc_pwatt        !  (conversion in PW) 
     156             DO ji = 1, jpi 
     157               z2d(ji,:) = z2d(1,:) 
     158             ENDDO 
     159             cl1 = 'sophtove' 
     160             CALL iom_put( TRIM(cl1), z2d ) 
     161             z2d(1,:) = str_ove(:,1) * rc_ggram        !  (conversion in Gg) 
     162             DO ji = 1, jpi 
     163               z2d(ji,:) = z2d(1,:) 
     164             ENDDO 
     165             cl1 = 'sopstove' 
     166             CALL iom_put( TRIM(cl1), z2d ) 
     167             IF( ln_subbas ) THEN 
     168                DO jn = 2, nptr 
     169                    sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
     170                    r1_sjk(:,:,jn) = 0._wp 
     171                    WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 
     172 
     173                    ! i-mean T and S, j-Stream-Function, basin 
     174                    tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
     175                    sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
     176                    v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) )  
     177                    htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 
     178                    str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 
     179 
     180                    z2d(1,:) = htr_ove(:,jn) * rc_pwatt !  (conversion in PW) 
     181                    DO ji = 1, jpi 
     182                        z2d(ji,:) = z2d(1,:) 
     183                    ENDDO 
     184                    cl1 = TRIM('sophtove_'//clsubb(jn)) 
     185                    CALL iom_put( cl1, z2d ) 
     186                    z2d(1,:) = str_ove(:,jn) * rc_ggram        ! (conversion in Gg) 
     187                    DO ji = 1, jpi 
     188                        z2d(ji,:) = z2d(1,:) 
     189                    ENDDO 
     190                    cl1 = TRIM('sopstove_'//clsubb(jn)) 
     191                    CALL iom_put( cl1, z2d ) 
     192                END DO 
     193             ENDIF 
     194         ENDIF 
     195         IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 
     196         ! Calculate barotropic heat and salt transport here  
     197             sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 
     198             r1_sjk(:,1,1) = 0._wp 
     199             WHERE( sjk(:,1,1) /= 0._wp )   r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 
     200             
     201            vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1)) 
     202            tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 
     203            tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 
     204            htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1) 
     205            str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1) 
     206            z2d(1,:) = htr_btr(:,1) * rc_pwatt        !  (conversion in PW) 
     207            DO ji = 2, jpi 
     208               z2d(ji,:) = z2d(1,:) 
     209            ENDDO 
     210            cl1 = 'sophtbtr' 
     211            CALL iom_put( TRIM(cl1), z2d ) 
     212            z2d(1,:) = str_btr(:,1) * rc_ggram        !  (conversion in Gg) 
     213            DO ji = 2, jpi 
     214              z2d(ji,:) = z2d(1,:) 
     215            ENDDO 
     216            cl1 = 'sopstbtr' 
     217            CALL iom_put( TRIM(cl1), z2d ) 
     218            IF( ln_subbas ) THEN 
     219                DO jn = 2, nptr 
     220                    sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 
     221                    r1_sjk(:,1,jn) = 0._wp 
     222                    WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 
     223                    vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn)) 
     224                    tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
     225                    tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     226                    htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn) 
     227                    str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn) 
     228                    z2d(1,:) = htr_btr(:,jn) * rc_pwatt !  (conversion in PW) 
     229                    DO ji = 1, jpi 
     230                        z2d(ji,:) = z2d(1,:) 
     231                    ENDDO 
     232                    cl1 = TRIM('sophtbtr_'//clsubb(jn)) 
     233                    CALL iom_put( cl1, z2d ) 
     234                    z2d(1,:) = str_btr(:,jn) * rc_ggram        ! (conversion in Gg) 
     235                    DO ji = 1, jpi 
     236                        z2d(ji,:) = z2d(1,:) 
     237                    ENDDO 
     238                    cl1 = TRIM('sopstbtr_'//clsubb(jn)) 
     239                    CALL iom_put( cl1, z2d ) 
     240               ENDDO 
     241            ENDIF !ln_subbas 
     242         ENDIF !iom_use("sopstbtr....) 
    111243         ! 
    112244      ELSE 
     
    148280         !                                ! Advective and diffusive heat and salt transport 
    149281         IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN    
    150             z2d(1,:) = htr_adv(:) * rc_pwatt        !  (conversion in PW) 
     282            z2d(1,:) = htr_adv(:,1) * rc_pwatt        !  (conversion in PW) 
    151283            DO ji = 1, jpi 
    152284               z2d(ji,:) = z2d(1,:) 
     
    154286            cl1 = 'sophtadv'                  
    155287            CALL iom_put( TRIM(cl1), z2d ) 
    156             z2d(1,:) = str_adv(:) * rc_ggram        ! (conversion in Gg) 
     288            z2d(1,:) = str_adv(:,1) * rc_ggram        ! (conversion in Gg) 
    157289            DO ji = 1, jpi 
    158290               z2d(ji,:) = z2d(1,:) 
     
    160292            cl1 = 'sopstadv' 
    161293            CALL iom_put( TRIM(cl1), z2d ) 
     294            IF( ln_subbas ) THEN 
     295              DO jn=2,nptr 
     296               z2d(1,:) = htr_adv(:,jn) * rc_pwatt        !  (conversion in PW) 
     297               DO ji = 1, jpi 
     298                 z2d(ji,:) = z2d(1,:) 
     299               ENDDO 
     300               cl1 = TRIM('sophtadv_'//clsubb(jn))                  
     301               CALL iom_put( cl1, z2d ) 
     302               z2d(1,:) = str_adv(:,jn) * rc_ggram        ! (conversion in Gg) 
     303               DO ji = 1, jpi 
     304                  z2d(ji,:) = z2d(1,:) 
     305               ENDDO 
     306               cl1 = TRIM('sopstadv_'//clsubb(jn))                  
     307               CALL iom_put( cl1, z2d )               
     308              ENDDO 
     309            ENDIF 
    162310         ENDIF 
    163311         ! 
    164312         IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN    
    165             z2d(1,:) = htr_ldf(:) * rc_pwatt        !  (conversion in PW)  
     313            z2d(1,:) = htr_ldf(:,1) * rc_pwatt        !  (conversion in PW)  
    166314            DO ji = 1, jpi 
    167315               z2d(ji,:) = z2d(1,:) 
     
    169317            cl1 = 'sophtldf' 
    170318            CALL iom_put( TRIM(cl1), z2d ) 
    171             z2d(1,:) = str_ldf(:) * rc_ggram        !  (conversion in Gg) 
     319            z2d(1,:) = str_ldf(:,1) * rc_ggram        !  (conversion in Gg) 
    172320            DO ji = 1, jpi 
    173321               z2d(ji,:) = z2d(1,:) 
     
    175323            cl1 = 'sopstldf' 
    176324            CALL iom_put( TRIM(cl1), z2d ) 
     325            IF( ln_subbas ) THEN 
     326              DO jn=2,nptr 
     327               z2d(1,:) = htr_ldf(:,jn) * rc_pwatt        !  (conversion in PW) 
     328               DO ji = 1, jpi 
     329                 z2d(ji,:) = z2d(1,:) 
     330               ENDDO 
     331               cl1 = TRIM('sophtldf_'//clsubb(jn))                  
     332               CALL iom_put( cl1, z2d ) 
     333               z2d(1,:) = str_ldf(:,jn) * rc_ggram        ! (conversion in Gg) 
     334               DO ji = 1, jpi 
     335                  z2d(ji,:) = z2d(1,:) 
     336               ENDDO 
     337               cl1 = TRIM('sopstldf_'//clsubb(jn))                  
     338               CALL iom_put( cl1, z2d )               
     339              ENDDO 
     340            ENDIF 
     341         ENDIF 
     342 
     343         IF( iom_use("sopht_vt") .OR. iom_use("sopst_vs") ) THEN    
     344            z2d(1,:) = htr_vt(:,1) * rc_pwatt        !  (conversion in PW)  
     345            DO ji = 1, jpi 
     346               z2d(ji,:) = z2d(1,:) 
     347            ENDDO 
     348            cl1 = 'sopht_vt' 
     349            CALL iom_put( TRIM(cl1), z2d ) 
     350            z2d(1,:) = str_vs(:,1) * rc_ggram        !  (conversion in Gg) 
     351            DO ji = 1, jpi 
     352               z2d(ji,:) = z2d(1,:) 
     353            ENDDO 
     354            cl1 = 'sopst_vs' 
     355            CALL iom_put( TRIM(cl1), z2d ) 
     356            IF( ln_subbas ) THEN 
     357              DO jn=2,nptr 
     358               z2d(1,:) = htr_vt(:,jn) * rc_pwatt        !  (conversion in PW) 
     359               DO ji = 1, jpi 
     360                 z2d(ji,:) = z2d(1,:) 
     361               ENDDO 
     362               cl1 = TRIM('sopht_vt_'//clsubb(jn))                  
     363               CALL iom_put( cl1, z2d ) 
     364               z2d(1,:) = str_vs(:,jn) * rc_ggram        ! (conversion in Gg) 
     365               DO ji = 1, jpi 
     366                  z2d(ji,:) = z2d(1,:) 
     367               ENDDO 
     368               cl1 = TRIM('sopst_vs_'//clsubb(jn))                  
     369               CALL iom_put( cl1, z2d )               
     370              ENDDO 
     371            ENDIF 
     372         ENDIF 
     373 
     374         IF(ln_ldfeiv) THEN 
     375            IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN  
     376               z2d(1,:) = htr_eiv(:,1) * rc_pwatt        !  (conversion in PW)  
     377               DO ji = 1, jpi 
     378                  z2d(ji,:) = z2d(1,:) 
     379               ENDDO 
     380               cl1 = 'sophteiv' 
     381               CALL iom_put( TRIM(cl1), z2d ) 
     382               z2d(1,:) = str_eiv(:,1) * rc_ggram        !  (conversion in Gg) 
     383               DO ji = 1, jpi 
     384                  z2d(ji,:) = z2d(1,:) 
     385               ENDDO 
     386               cl1 = 'sopsteiv' 
     387               CALL iom_put( TRIM(cl1), z2d ) 
     388               IF( ln_subbas ) THEN 
     389                  DO jn=2,nptr 
     390                     z2d(1,:) = htr_eiv(:,jn) * rc_pwatt        !  (conversion in PW) 
     391                     DO ji = 1, jpi 
     392                        z2d(ji,:) = z2d(1,:) 
     393                     ENDDO 
     394                     cl1 = TRIM('sophteiv_'//clsubb(jn))                  
     395                     CALL iom_put( cl1, z2d ) 
     396                     z2d(1,:) = str_eiv(:,jn) * rc_ggram        ! (conversion in Gg) 
     397                     DO ji = 1, jpi 
     398                        z2d(ji,:) = z2d(1,:) 
     399                     ENDDO 
     400                     cl1 = TRIM('sopsteiv_'//clsubb(jn))  
     401                     CALL iom_put( cl1, z2d )               
     402                  ENDDO 
     403               ENDIF 
     404            ENDIF 
    177405         ENDIF 
    178406         ! 
     
    254482         ! Initialise arrays to zero because diatpr is called before they are first calculated 
    255483         ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
    256          htr_adv(:) = 0._wp  ;  str_adv(:) =  0._wp   
    257          htr_ldf(:) = 0._wp  ;  str_ldf(:) =  0._wp  
     484         htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp  
     485         htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp  
     486         htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp  
     487         htr_vt(:,:) = 0._wp  ;   str_vs(:,:) =  0._wp 
     488         htr_ove(:,:) = 0._wp  ;   str_ove(:,:) =  0._wp 
     489         htr_btr(:,:) = 0._wp  ;   str_btr(:,:) =  0._wp 
    258490         ! 
    259491      ENDIF  
     
    261493   END SUBROUTINE dia_ptr_init 
    262494 
     495   SUBROUTINE dia_ptr_ohst_components( ktra, cptr, pva )  
     496      !!---------------------------------------------------------------------- 
     497      !!                    ***  ROUTINE dia_ptr_ohst_components  *** 
     498      !!---------------------------------------------------------------------- 
     499      !! Wrapper for heat and salt transport calculations to calculate them for each basin 
     500      !! Called from all advection and/or diffusion routines 
     501      !!---------------------------------------------------------------------- 
     502      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
     503      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'/'eiv' 
     504      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion 
     505      INTEGER                                        :: jn    ! 
     506 
     507      IF( cptr == 'adv' ) THEN 
     508         IF( ktra == jp_tem )  htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 
     509         IF( ktra == jp_sal )  str_adv(:,1) = ptr_sj( pva(:,:,:) ) 
     510      ENDIF 
     511      IF( cptr == 'ldf' ) THEN 
     512         IF( ktra == jp_tem )  htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
     513         IF( ktra == jp_sal )  str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
     514      ENDIF 
     515      IF( cptr == 'eiv' ) THEN 
     516         IF( ktra == jp_tem )  htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
     517         IF( ktra == jp_sal )  str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
     518      ENDIF 
     519      IF( cptr == 'vts' ) THEN 
     520         IF( ktra == jp_tem )  htr_vt(:,1) = ptr_sj( pva(:,:,:) ) 
     521         IF( ktra == jp_sal )  str_vs(:,1) = ptr_sj( pva(:,:,:) ) 
     522      ENDIF 
     523      ! 
     524      IF( ln_subbas ) THEN 
     525         ! 
     526         IF( cptr == 'adv' ) THEN 
     527             IF( ktra == jp_tem ) THEN  
     528                DO jn = 2, nptr 
     529                   htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     530                END DO 
     531             ENDIF 
     532             IF( ktra == jp_sal ) THEN  
     533                DO jn = 2, nptr 
     534                   str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     535                END DO 
     536             ENDIF 
     537         ENDIF 
     538         IF( cptr == 'ldf' ) THEN 
     539             IF( ktra == jp_tem ) THEN  
     540                DO jn = 2, nptr 
     541                    htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     542                 END DO 
     543             ENDIF 
     544             IF( ktra == jp_sal ) THEN  
     545                DO jn = 2, nptr 
     546                   str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     547                END DO 
     548             ENDIF 
     549         ENDIF 
     550         IF( cptr == 'eiv' ) THEN 
     551             IF( ktra == jp_tem ) THEN  
     552                DO jn = 2, nptr 
     553                    htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     554                 END DO 
     555             ENDIF 
     556             IF( ktra == jp_sal ) THEN  
     557                DO jn = 2, nptr 
     558                   str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     559                END DO 
     560             ENDIF 
     561         ENDIF 
     562         IF( cptr == 'vts' ) THEN 
     563             IF( ktra == jp_tem ) THEN  
     564                DO jn = 2, nptr 
     565                    htr_vt(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     566                 END DO 
     567             ENDIF 
     568             IF( ktra == jp_sal ) THEN  
     569                DO jn = 2, nptr 
     570                   str_vs(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     571                END DO 
     572             ENDIF 
     573         ENDIF 
     574         ! 
     575      ENDIF 
     576   END SUBROUTINE dia_ptr_ohst_components 
     577 
    263578 
    264579   FUNCTION dia_ptr_alloc() 
     
    271586      ierr(:) = 0 
    272587      ! 
    273       ALLOCATE( btmsk(jpi,jpj,nptr) ,           & 
    274          &      htr_adv(jpj) , str_adv(jpj) ,   & 
    275          &      htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1)  ) 
     588      ALLOCATE( btmsk(jpi,jpj,nptr) ,              & 
     589         &      htr_adv(jpj,nptr) , str_adv(jpj,nptr) ,   & 
     590         &      htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) ,   & 
     591         &      htr_vt(jpj,nptr)  , str_vs(jpj,nptr)  ,   & 
     592         &      htr_ove(jpj,nptr) , str_ove(jpj,nptr) ,   & 
     593         &      htr_btr(jpj,nptr) , str_btr(jpj,nptr) ,   & 
     594         &      htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1)  ) 
    276595         ! 
    277596      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 
  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90

    r6140 r7236  
    189189            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 
    190190         END IF 
    191          !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    192          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    193            IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    194            IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    195          ENDIF 
     191         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     192         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
    196193         ! 
    197194      END DO 
  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r6771 r7236  
    8080      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      - 
    8181      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
    82       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrdz 
     82      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrd, zptry 
    8383      !!---------------------------------------------------------------------- 
    8484      ! 
     
    101101      ENDIF 
    102102      ! 
     103      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     104         CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
     105         zptry(:,:,:) = 0._wp 
     106      ENDIF 
    103107      !                          ! surface & bottom value : flux set to zero one for all 
    104108      zwz(:,:, 1 ) = 0._wp             
     
    165169         END IF 
    166170         !                             ! "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 
     171         IF( cdtype == 'TRA' .AND. ln_diaptr )    zptry(:,:,:) = zwy(:,:,:)  
    171172         ! 
    172173         !        !==  anti-diffusive flux : high order minus low order  ==! 
     
    305306         !                    ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    306307         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(:,:,:) ) 
     308            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     309            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    309310         ENDIF 
    310311         ! 
     
    312313      ! 
    313314      CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 
     315      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    314316      ! 
    315317      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct') 
     
    357359      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav 
    358360      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdx, ztrdy, ztrdz 
     361      REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
    359362      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrs 
    360363      !!---------------------------------------------------------------------- 
     
    380383      ENDIF 
    381384      ! 
     385      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     386         CALL wrk_alloc( jpi, jpj,jpk, zptry ) 
     387         zptry(:,:,:) = 0._wp 
     388      ENDIF 
    382389      zwi(:,:,:) = 0._wp 
    383390      z_rzts = 1._wp / REAL( kn_fct_zts, wp ) 
     
    449456         END IF 
    450457         !                                ! "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 
     458         IF( cdtype == 'TRA' .AND. ln_diaptr )  zptry(:,:,:) = zwy(:,:,:) 
    455459 
    456460         ! 3. anti-diffusive flux : high order minus low order 
     
    582586         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    583587         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(:) 
     588            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  
     589            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    586590         ENDIF 
    587591         ! 
     
    591595      CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
    592596      CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs ) 
     597      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    593598      ! 
    594599      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct_zts') 
  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90

    r6140 r7236  
    197197            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) ) 
    198198         END IF 
     199         !                                 ! "Poleward" heat and salt transports 
     200         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:)  ) 
    199201         !                                ! "Poleward" heat and salt transports 
    200          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    201             IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    202             IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    203          ENDIF 
    204202         ! 
    205203         !                          !* Vertical advective fluxes 
  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r6140 r7236  
    349349         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    350350         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    351          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    352            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    353            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    354          ENDIF 
     351         IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
    355352         ! 
    356353      END DO 
  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r6140 r7236  
    177177         END IF 
    178178         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    179          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    180             IF( jn == jp_tem )  htr_adv(:) = ptr_sj( ztv(:,:,:) ) 
    181             IF( jn == jp_sal )  str_adv(:) = ptr_sj( ztv(:,:,:) ) 
    182          ENDIF 
     179         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', ztv(:,:,:) ) 
    183180         ! 
    184181         !                       !== vertical advective trend  ==! 
  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r6140 r7236  
    369369            ! 
    370370            !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    371             IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    372371               ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    373                IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    374                IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    375             ENDIF 
     372            IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:)  ) 
    376373            ! 
    377374            IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90

    r6140 r7236  
    150150         IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR.  &     !==  first pass only (  laplacian)  ==! 
    151151             ( kpass == 2 .AND.      ln_traldf_blp ) ) THEN      !==  2nd   pass only (bilaplacian)  ==! 
    152             IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    153                IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( -ztv(:,:,:) ) 
    154                IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( -ztv(:,:,:) ) 
    155             ENDIF 
     152            IF( cdtype == 'TRA' .AND. ln_diaptr )    CALL dia_ptr_ohst_components( jn, 'ldf', -ztv(:,:,:) ) 
    156153         ENDIF 
    157154         !                          ! ================== 
  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90

    r6140 r7236  
    416416            ! 
    417417            !                          ! "Poleward" diffusive heat or salt transports (T-S case only) 
    418             IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    419                IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names 
    420                IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) ) 
    421             ENDIF 
     418            IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'ldf', zftv(:,:,:) ) 
    422419            ! 
    423420            IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
Note: See TracChangeset for help on using the changeset viewer.