Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.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/ZDF/zdfmxl.F90 (modified) (4 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

@@ -14 +14 @@
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
-   USE iom
+   USE iom             ! I/O library
+   USE lib_mpp         ! MPP library
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   zdf_mxl    ! called by step.F90
+   PUBLIC   zdf_mxl       ! called by step.F90
 
-   INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   nmln    !: number of level in the mixed layer (used by TOP)
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hmld    !: mixing layer depth (turbocline)      [m]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hmlpt   !: mixed layer depth at t-points        [m]
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m]
 
    !! * 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)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
+CONTAINS
 
-CONTAINS
+   INTEGER FUNCTION zdf_mxl_alloc()
+      !!----------------------------------------------------------------------
+      !!               ***  FUNCTION zdf_mxl_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT= zdf_mxl_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc )
+      IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.')
+   END FUNCTION zdf_mxl_alloc
+
 
    SUBROUTINE zdf_mxl( kt )
@@ -53 +64 @@
       !! ** Action  :   nmln, hmld, hmlp, hmlpt
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      USE wrk_nemo, ONLY:   iwrk_in_use, iwrk_not_released
+      USE wrk_nemo, ONLY:   imld => iwrk_2d_1    ! 2D integer workspace
       !!
-      INTEGER                     ::   ji, jj, jk          ! dummy loop indices
-      INTEGER                     ::   iikn, iiki          ! temporary integer within a do loop
-      INTEGER, DIMENSION(jpi,jpj) ::   imld                ! temporary workspace
-      REAL(wp)                    ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth
-      REAL(wp)                    ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      INTEGER  ::   iikn, iiki          ! temporary integer within a do loop
+      REAL(wp) ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth
+      REAL(wp) ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
       !!----------------------------------------------------------------------
+
+      IF( iwrk_in_use(2, 1) ) THEN
+         CALL ctl_stop('zdf_mxl : requested workspace array unavailable')   ;   RETURN
+      ENDIF
 
       IF( kt == nit000 ) THEN
@@ -66 +83 @@
          IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         !                             ! allocate zdfmxl arrays
+         IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' )
       ENDIF
 
@@ -94 +113 @@
       IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 )
       !
+      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('zdf_mxl: failed to release workspace array')
+      !
    END SUBROUTINE zdf_mxl