Changeset 2737 for trunk

Timestamp:

2011-04-11T12:30:51+02:00 (13 years ago)

Author:

rblod

Message:

Update module_example for dynamic allocation

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/module_example (modified) (8 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/module_example

@@ -23 +23 @@
    PRIVATE
 
-   PUBLIC   exa_mpl   ! routine called in xxx.F90 module
+   PUBLIC   exa_mpl        ! routine called in xxx.F90 module
+   PUBLIC   exa_mpl_init   ! routine called in nemogcm.F90 module
 
    TYPE ::   FLD_E                !: Structure type definition
@@ -30 +31 @@
    END TYPE FLD_E 
 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   var1         !: var1 description. CAUTION always use !: to describe
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var1         !: var1 description. CAUTION always use !: to describe
    !                                                          !  a PUBLIC variable: simplify its search : 
    !                                                          !  grep var1 *90 | grep '!:'
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   var2, var2   !: several variable on a same line OK, but 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var2, var2   !: several variable on a same line OK, but 
    !                                                          !  DO NOT use continuation lines in declaration
 
@@ -45 +46 @@
    INTEGER                          ::   nint    ! nint  description (local permanent variable)
    REAL(wp)                         ::   var     ! var         -                -
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   array   ! array       -                -
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   array   ! array       -                -
 
    !! * Substitutions
@@ -55 +56 @@
    !!----------------------------------------------------------------------
 CONTAINS
+
+   INTEGER FUNCTION exa_mpl_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION exa_mpl_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( array(jpi,jpj,jpk) , STAT= exa_mpl_alloc )   ! Module array                                                                
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( exa_mpl_alloc )
+      IF( exa_mpl_alloc /= 0 )   CALL ctl_warn('exa_mpl_alloc: failed to allocate arrays')
+      !
+   END FUNCTION exa_mpl_alloc
+   
 
    SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )
@@ -73 +86 @@
       !!                Give references if exist otherwise suppress these lines
       !!----------------------------------------------------------------------
-      USE toto_module      ! description od the module
+      USE toto_module      ! description of the module
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   zztab => wrk_2d_5                     ! 2D workspace
+      USE wrk_nemo, ONLY:   zwx => wrk_3d_12 , zwy => wrk_3d_13   ! 3D workspace
       !!
       INTEGER , INTENT(in   )                     ::   kt      ! short description 
@@ -84 +100 @@
       REAL(wp) ::   zmlmin, zbbrau   ! temporary scalars     (DOCTOR : start with z)
       REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration
-      REAL(wp), DIMENSION(jpi,jpk) ::   ztoto   ! 2D workspace
       !!--------------------------------------------------------------------
+
+      IF( wrk_in_use(3, 12,13) .OR. wrk_in_use(2, 5 ) THEN
+         CALL ctl_stop('exa_mpl: requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
 
       IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only)
@@ -118 +137 @@
       CALL mpplnk2( avmu, 'U', 1. )              ! Lateral boundary conditions (unchanged sign)
       !
+      IF( wrk_not_released(3, 12,13) .OR. wrk_not_released(2, 5 ) THEN
+         CALL ctl_stop('exa_mpl: failed to release workspace arrays')   ;   RETURN
+      ENDIF
+      !
    END SUBROUTINE exa_mpl
 
@@ -156 +179 @@
       ENDIF
       !
-      !                                          ! Parameter control
+      !                              ! allocate exa_mpl arrays      
+      IF( exa_mpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_init : unable to allocate arrays' )
+      !                              ! Parameter control
       IF( ln_opt      )   CALL ctl_stop( 'exa_mpl_init: this work and option xxx are incompatible'   )
       IF( nn_opt == 2 )   CALL ctl_warn( 'exa_mpl_init: this work and option yyy may cause problems' )