Changeset 2618 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

Timestamp:

2011-02-26T13:31:38+01:00 (13 years ago)

Author:

gm

Message:

dynamic mem: #785 ; move dyn allocation from nemogcm to module when possible (continuation)

File:

• branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90 (modified) (3 diffs)

branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

@@ -27 +27 @@
    PUBLIC   dom_vvl_alloc ! called by nemogcm.F90
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) ::   ee_t, ee_u, ee_v, ee_f   !: ???
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mut, muu, muv, muf       !: ??? 
-
-   REAL(wp),         ALLOCATABLE, SAVE,     DIMENSION(:) ::   r2dt   ! vertical profile time-step, = 2 rdttra 
-      !                                 ! except at nit000 (=rdttra) if neuler=0
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ee_t, ee_u, ee_v, ee_f   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mut , muu , muv , muf    !: ??? 
+
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:)     ::   r2dt   ! vertical profile time-step, = 2 rdttra 
+      !                                                              ! except at nit000 (=rdttra) if neuler=0
 
    !! * Substitutions
@@ -37 +37 @@
 #  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)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS       
 
-   FUNCTION dom_vvl_alloc()
+   INTEGER FUNCTION dom_vvl_alloc()
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE dom_vvl_alloc  ***
       !!----------------------------------------------------------------------
-      IMPLICIT none
-      INTEGER :: dom_vvl_alloc
-      !!----------------------------------------------------------------------
-
-      ALLOCATE(mut(jpi,jpj,jpk), muu(jpi,jpj,jpk), muv(jpi,jpj,jpk),       &
-               muf(jpi,jpj,jpk),                                           &
-               ee_t(jpi,jpj), ee_u(jpi,jpj), ee_v(jpi,jpj), ee_f(jpi,jpj), &
-               r2dt(jpk), Stat=dom_vvl_alloc)
-
-      IF(dom_vvl_alloc /= 0)THEN
-         CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
-      END IF
-
+      !
+      ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) ,    &
+         &      ee_t(jpi,jpj)     , ee_u(jpi,jpj)     , ee_v(jpi,jpj)     , ee_f(jpi,jpj)     ,    &
+         &      r2dt(jpk)                                                                     , STAT=dom_vvl_alloc)
+         !
+      IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
+      IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
+      !
    END FUNCTION dom_vvl_alloc
 
@@ -71 +65 @@
       !!               ssh over the whole water column (scale factors)
       !!----------------------------------------------------------------------
-      USE wrk_nemo, ONLY: wrk_use, wrk_release
-      USE wrk_nemo, ONLY: zs_t   => wrk_2d_1, zs_u_1 => wrk_2d_2, &
-                          zs_v_1 => wrk_2d_3
+      USE wrk_nemo, ONLY:   wrk_use, wrk_release
+      USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1, zs_u_1 => wrk_2d_2
+      USE wrk_nemo, ONLY:   zs_v_1 => wrk_2d_3
       !!
       INTEGER  ::   ji, jj, jk
-      REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! temporary scalars
-      REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !     -        -
+      REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! local scalars
+      REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !   -      -
       !!----------------------------------------------------------------------
 
       IF(.not. wrk_use(2, 1,2,3))THEN
-         CALL ctl_stop('dom_vvl: ERROR - requested workspace arrays unavailable.')
-         RETURN
+         CALL ctl_stop('dom_vvl: ERROR - requested workspace arrays unavailable.')   ;   RETURN
       END IF
 
-      IF(lwp)   THEN
+      IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*) 'dom_vvl : Variable volume activated'
+         WRITE(numout,*) 'dom_vvl : Variable volume initialization'
          WRITE(numout,*) '~~~~~~~~  compute coef. used to spread ssh over each layers'
       ENDIF
-
+      
+      IF( dom_vvl_alloc /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl : unable to allocate arrays' )
 
       fsdept(:,:,:) = gdept (:,:,:)