Changeset 7236 for branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

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)

File:

• branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90 (modified) (10 diffs)

branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

@@ -80 +80 @@
       REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrdz
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrd, zptry
       !!----------------------------------------------------------------------
       !
@@ -101 +101 @@
       ENDIF
       !
+      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+         CALL wrk_alloc( jpi, jpj, jpk, zptry )
+         zptry(:,:,:) = 0._wp
+      ENDIF
       !                          ! surface & bottom value : flux set to zero one for all
       zwz(:,:, 1 ) = 0._wp            
@@ -165 +169 @@
          END IF
          !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
+         IF( cdtype == 'TRA' .AND. ln_diaptr )    zptry(:,:,:) = zwy(:,:,:) 
          !
          !        !==  anti-diffusive flux : high order minus low order  ==!
@@ -305 +306 @@
          !                    ! "Poleward" heat and salt transports (contribution of upstream fluxes)
          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )   htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )   str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) )
+            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) )
          ENDIF
          !
@@ -312 +313 @@
       !
       CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
+      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct')
@@ -357 +359 @@
       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav
       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdx, ztrdy, ztrdz
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrs
       !!----------------------------------------------------------------------
@@ -380 +383 @@
       ENDIF
       !
+      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+         CALL wrk_alloc( jpi, jpj,jpk, zptry )
+         zptry(:,:,:) = 0._wp
+      ENDIF
       zwi(:,:,:) = 0._wp
       z_rzts = 1._wp / REAL( kn_fct_zts, wp )
@@ -449 +456 @@
          END IF
          !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
+         IF( cdtype == 'TRA' .AND. ln_diaptr )  zptry(:,:,:) = zwy(:,:,:)
 
          ! 3. anti-diffusive flux : high order minus low order
@@ -582 +586 @@
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
+            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) 
+            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) )
          ENDIF
          !
@@ -591 +595 @@
       CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )
       CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs )
+      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct_zts')