Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

Timestamp:

2011-03-30T17:58:35+02:00 (13 years ago)

Author:

rblod

Message:

First attempt to put dynamic allocation on the trunk

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90 (modified) (4 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

@@ -21 +21 @@
    USE phycst          ! physical constants
    USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
    USE iom             ! I/O library
 
@@ -26 +27 @@
    PRIVATE
 
-   PUBLIC   dia_hth    ! routine called by step.F90
-
-   LOGICAL , PUBLIC, PARAMETER          ::   lk_diahth = .TRUE.   !: thermocline-20d depths flag
+   PUBLIC   dia_hth       ! routine called by step.F90
+   PUBLIC   dia_hth_alloc ! routine called by nemogcm.F90
+
+   LOGICAL , PUBLIC, PARAMETER          ::   lk_diahth = .TRUE.    !: thermocline-20d depths flag
    ! note: following variables should move to local variables once iom_put is always used 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hth                  !: depth of the max vertical temperature gradient [m]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hd20                 !: depth of 20 C isotherm                         [m]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hd28                 !: depth of 28 C isotherm                         [m]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   htc3                 !: heat content of first 300 m                    [W]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth    !: depth of the max vertical temperature gradient [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd20   !: depth of 20 C isotherm                         [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd28   !: depth of 28 C isotherm                         [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3   !: heat content of first 300 m                    [W]
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
+
+   FUNCTION dia_hth_alloc()
+      !!---------------------------------------------------------------------
+      INTEGER :: dia_hth_alloc
+      !!---------------------------------------------------------------------
+      !
+      ALLOCATE(hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc)
+      !
+      IF( lk_mpp           )   CALL mpp_sum ( dia_hth_alloc )
+      IF(dia_hth_alloc /= 0)   CALL ctl_warn('dia_hth_alloc: failed to allocate arrays.')
+      !
+   END FUNCTION dia_hth_alloc
+
 
    SUBROUTINE dia_hth( kt )
@@ -68 +83 @@
       INTEGER                          ::   ji, jj, jk            ! dummy loop arguments
       INTEGER                          ::   iid, ilevel           ! temporary integers
-      INTEGER, DIMENSION(jpi,jpj)      ::   ik20, ik28            ! levels
+      INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ik20, ik28  ! levels
       REAL(wp)                         ::   zavt5 = 5.e-4_wp      ! Kz criterion for the turbocline depth
       REAL(wp)                         ::   zrho3 = 0.03_wp       ! density     criterion for mixed layer depth
@@ -76 +91 @@
       REAL(wp)                         ::   zztmp, zzdep          ! temporary scalars inside do loop
       REAL(wp)                         ::   zu, zv, zw, zut, zvt  ! temporary workspace
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zabs2                 ! MLD: abs( tn - tn(10m) ) = ztem2 
-      REAL(wp), DIMENSION(jpi,jpj)     ::   ztm2                  ! Top of thermocline: tn = tn(10m) - ztem2     
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zrho10_3              ! MLD: rho = rho10m + zrho3      
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zpycn                 ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)
-      REAL(wp), DIMENSION(jpi,jpj)     ::   ztinv                 ! max of temperature inversion
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zdepinv               ! depth of temperature inversion
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zrho0_3               ! MLD rho = rho(surf) = 0.03
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zrho0_1               ! MLD rho = rho(surf) = 0.01
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zmaxdzT               ! max of dT/dz
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zthick                ! vertical integration thickness 
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zdelr                 ! delta rho equivalent to deltaT = 0.2
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zabs2      ! MLD: abs( tn - tn(10m) ) = ztem2 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ztm2       ! Top of thermocline: tn = tn(10m) - ztem2     
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zrho10_3   ! MLD: rho = rho10m + zrho3      
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zpycn      ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ztinv      ! max of temperature inversion
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zdepinv    ! depth of temperature inversion
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zrho0_3    ! MLD rho = rho(surf) = 0.03
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zrho0_1    ! MLD rho = rho(surf) = 0.01
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zmaxdzT    ! max of dT/dz
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zthick     ! vertical integration thickness 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zdelr      ! delta rho equivalent to deltaT = 0.2
       !!----------------------------------------------------------------------
 
       IF( kt == nit000 ) THEN
+         !                                      ! allocate dia_hth array
+         IF( dia_hth_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' )
+
+         IF(.not. ALLOCATED(ik20))THEN
+            ALLOCATE(ik20(jpi,jpj), ik28(jpi,jpj), &
+               &      zabs2(jpi,jpj),   &
+               &      ztm2(jpi,jpj),    &
+               &      zrho10_3(jpi,jpj),&
+               &      zpycn(jpi,jpj),   &
+               &      ztinv(jpi,jpj),   &
+               &      zdepinv(jpi,jpj), &
+               &      zrho0_3(jpi,jpj), &
+               &      zrho0_1(jpi,jpj), &
+               &      zmaxdzT(jpi,jpj), &
+               &      zthick(jpi,jpj),  &
+               &      zdelr(jpi,jpj), STAT=ji)
+            IF( lk_mpp  )   CALL mpp_sum(ji)
+            IF( ji /= 0 )   CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard ocean arrays' )
+         END IF
+
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth'