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

trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

@@ -5 +5 @@
    !!======================================================================
    !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code
+   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -23 +24 @@
    USE in_out_manager   ! I/O manager
    USE lbclnk           ! lateral boundary condition - MPP exchanges
+   USE lib_mpp          ! MPP library
 
    IMPLICIT NONE
@@ -45 +47 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -60 +62 @@
       !!                or from arbitrary sea-ice conditions
       !!-------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4
+      USE wrk_nemo, ONLY:   zidto => wrk_2d_1   ! ice indicator
+      !
       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
       REAL(wp) ::   zeps6, zeps, ztmelts, epsi06   ! local scalars
-      REAL(wp) ::  zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs 
-      REAL(wp), DIMENSION(jpm)     ::   zgfactorn, zhin 
-      REAL(wp), DIMENSION(jpm)     ::   zgfactors, zhis
-      REAL(wp), DIMENSION(jpi,jpj) ::   zidto      ! ice indicator
-      !--------------------------------------------------------------------
+      REAL(wp) ::   zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs 
+      REAL(wp), POINTER, DIMENSION(:) ::   zgfactorn, zhin 
+      REAL(wp), POINTER, DIMENSION(:) ::   zgfactors, zhis
+      !--------------------------------------------------------------------
+
+      IF(  wrk_in_use(1, 1,2)  ) THEN
+         CALL ctl_stop( 'lim_istate: requested workspace arrays unavailable' )   ;   RETURN
+      ENDIF
+      zgfactorn => wrk_1d_1(1:jpm)   ;   zhin => wrk_1d_3(1:jpm)   ! Set-up pointers to sub-arrays of workspaces
+      zgfactors => wrk_1d_2(1:jpm)   ;   zhis => wrk_1d_4(1:jpm)
 
       !--------------------------------------------------------------------
@@ -506 +517 @@
       CALL lbc_lnk( fsbbq  , 'T', 1. )
       !
+      IF( wrk_not_released(1, 1,2) )   CALL ctl_stop('lim_istate : failed to release workspace arrays')
+      !
    END SUBROUTINE lim_istate