Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.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/DOM/istate.F90 (modified) (5 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

@@ -43 +43 @@
    USE dynspg_ts       ! pressure gradient schemes
    USE traswp          ! Swap arrays                      (tra_swp routine)
-   
+   USE lib_mpp         ! MPP library
+
    IMPLICIT NONE
    PRIVATE
@@ -55 +56 @@
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -446 +446 @@
       !!                 p=integral [ rau*g dz ]
       !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   zprn => wrk_3d_1    ! 3D workspace
+
       USE dynspg          ! surface pressure gradient             (dyn_spg routine)
       USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine)
@@ -453 +456 @@
       INTEGER ::   indic             ! ???
       REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zprn     ! workspace
-      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+
+      IF(wrk_in_use(3, 1) ) THEN
+         CALL ctl_stop('istage_uvg: requested workspace array unavailable')   ;   RETURN
+      ENDIF
 
       IF(lwp) WRITE(numout,*) 
@@ -551 +557 @@
       rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value
       !
+      IF( wrk_not_released(3, 1) ) THEN
+         CALL ctl_stop('istage_uvg: failed to release workspace array')
+      ENDIF
+      !
    END SUBROUTINE istate_uvg