Changeset 2616 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

Timestamp:

2011-02-26T11:28:03+01:00 (13 years ago)

Author:

gm

Message:

dynamic mem: #785 ; move the allocation vertical physics from nemogcm to ZDF modules (compilation check using key_esopa)

File:

• branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90 (modified) (7 diffs)

branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

@@ -56 +56 @@
    PUBLIC   zdf_tke_init   ! routine called in opa module
    PUBLIC   tke_rst        ! routine called in step module
-   PUBLIC   zdf_tke_alloc  ! routine called in nemogcm module
 
    LOGICAL , PUBLIC, PARAMETER              ::   lk_zdftke = .TRUE.  !: TKE vertical mixing flag
-
-#if defined key_c1d
-   !                                                           !!** 1D cfg only  **   ('key_c1d')
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_dis, e_mix   !: dissipation and mixing turbulent lengh scales
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers
-#endif
 
    !                                      !!** Namelist  namzdf_tke  **
@@ -88 +81 @@
    REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3)
 
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PUBLIC ::   en   ! now turbulent kinetic energy   [m2/s2]
-   
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)           ::   htau    ! depth of tke penetration (nn_htau)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)         ::   dissl   ! now mixing lenght of dissipation
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2]
+#if defined key_c1d
+   !                                                                        !!** 1D cfg only  **   ('key_c1d')
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_dis, e_mix   !: dissipation and mixing turbulent lengh scales
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers
+#endif
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau)
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation
 
    !! * Substitutions
@@ -97 +94 @@
 #  include "vectopt_loop_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)
@@ -103 +100 @@
 CONTAINS
 
-   FUNCTION zdf_tke_alloc()
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE zdf_tke_alloc  ***
-      !!----------------------------------------------------------------------
-      IMPLICIT none
-      INTEGER :: zdf_tke_alloc
-      !!----------------------------------------------------------------------
-
-      ALLOCATE(                                                            &
+   INTEGER FUNCTION zdf_tke_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION zdf_tke_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE(                                                                    &
 #if defined key_c1d
-               e_dis(jpi,jpj,jpk), e_mix(jpi,jpj,jpk),                     &
-               e_pdl(jpi,jpj,jpk), e_ric(jpi,jpj,jpk),                     &
+         &      e_dis(jpi,jpj,jpk) , e_mix(jpi,jpj,jpk) ,                          &
+         &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          &
 #endif
-               en(jpi,jpj,jpk),    htau(jpi,jpj),      dissl(jpi,jpj,jpk), &
-               Stat=zdf_tke_alloc)
-
-      IF(zdf_tke_alloc /= 0)THEN
-         CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays.')
-      END IF
-
+         &      en   (jpi,jpj,jpk) , htau (jpi,jpj)     , dissl(jpi,jpj,jpk) , STAT=zdf_tke_alloc )
+         !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc )
+      IF( zdf_tke_alloc /= 0 )   CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays')
+      !
    END FUNCTION zdf_tke_alloc
 
@@ -220 +211 @@
       !!--------------------------------------------------------------------
       !
-      IF( (.NOT. iwrk_use(2,1)) .OR. &
-          (.NOT. wrk_use(2, 1)) .OR. &
-          (.NOT. wrk_use(3, 1)) )THEN
-         CALL ctl_stop('tke_tke : requested workspace arrays unavailable.')
-         RETURN
+      IF( .NOT. iwrk_use(2, 1) .OR. &
+          .NOT.  wrk_use(2, 1) .OR. &
+          .NOT.  wrk_use(3, 1)   )THEN
+         CALL ctl_stop('tke_tke : requested workspace arrays unavailable.')   ;   RETURN
       END IF
 
@@ -438 +428 @@
          END DO
       ENDIF
-      !
       CALL lbc_lnk( en, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
       !
-      IF( (.NOT. iwrk_release(2,1)) .OR. &
-          (.NOT. wrk_release(2, 1)) .OR. &
-          (.NOT. wrk_release(3, 1)) )THEN
-         CALL ctl_stop('tke_tke : failed to release workspace arrays.')
-      END IF
+      IF( .NOT. iwrk_release(2 ,1) .OR.   &
+          .NOT.  wrk_release(2, 1) .OR.   &
+          .NOT.  wrk_release(3, 1)  )   CALL ctl_stop( 'tke_tke : failed to release workspace arrays' )
       !
    END SUBROUTINE tke_tke
@@ -724 +711 @@
          WRITE(numout,*) '      critical Richardson nb with your parameters  ri_cri = ', ri_cri
       ENDIF
+
+      !                              ! allocate tke arrays
+      IF( zdf_tke_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tke_init : unable to allocate arrays' )
 
       !                               !* Check of some namelist values