Changeset 6428 for branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

Timestamp:

2016-04-05T16:48:36+02:00 (8 years ago)

Author:

timgraham

Message:

Added advective and diffusive heat transport by basin to diaptr module

File:

• branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90 (modified) (4 diffs)

branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

@@ -40 +40 @@
 
    !                                  !!** namelist  namptr  **
-   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf   !: Heat TRansports (adv, diff, overturn.)
-   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf   !: Salt TRansports (adv, diff, overturn.)
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf   !: Heat TRansports (adv, diff, overturn.)
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf   !: Salt TRansports (adv, diff, overturn.)
    
 
@@ -256 +256 @@
          ! Initialise arrays to zero because diatpr is called before they are first calculated
          ! Note that this means diagnostics will not be exactly correct when model run is restarted.
-         htr_adv(:) = 0._wp  ;  str_adv(:) =  0._wp  
-         htr_ldf(:) = 0._wp  ;  str_ldf(:) =  0._wp 
+         htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp  
+         htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp 
          !
       ENDIF 
@@ -263 +263 @@
    END SUBROUTINE dia_ptr_init
 
+   SUBROUTINE dia_ptr_ohst_components( pva, ptr ) 
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_ptr_oht_components  ***
+      !!----------------------------------------------------------------------
+      !! Wrapper for heat and salt transport calculations to calculate them
+      !! for each basin
+      !! Called from all advection and/or diffusion routines
+      INTEGER                          :: jn
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: pva   ! 3D input array of advection/diffusion
+      REAL(wp), DIMENSION(jpi,nptr), INTENT(OUT)   :: ptr   ! zonal & vertical sum
+      
+      ptr(:, 1) = ptr_sj( pva(:,:,:) )
+      IF( ln_subbas ) THEN
+         DO jn=2,nptr
+            ptr(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
+         END DO
+      ENDIF
+
+   END SUBROUTINE
+
 
    FUNCTION dia_ptr_alloc()
@@ -274 +294 @@
       !
       ALLOCATE( btmsk(jpi,jpj,nptr) ,           &
-         &      htr_adv(jpj) , str_adv(jpj) ,   &
-         &      htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1)  )
+         &      htr_adv(jpj,nptr) , str_adv(jpj,nptr) ,   &
+         &      htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1)  )
          !
       ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2))