Changeset 2715 for trunk/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.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_2/thd_ice_2.F90 (modified) (3 diffs)

trunk/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90

@@ -12 +12 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE par_ice_2
 
    IMPLICIT NONE
    PRIVATE
+
+   PUBLIC thd_ice_alloc_2 ! Routine called by nemogcm.F90
 
    !! * Share Module variables
@@ -43 +44 @@
       cnscg                  !: ratio  rcpsn/rcpic
 
-   INTEGER , PUBLIC, DIMENSION(jpij) ::   &  !:
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !:
       npb     ,   &   !: number of points where computations has to be done
       npac            !: correspondance between the points
 
-   REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !: 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
       qldif_1d    ,     &  !: corresponding to the 2D var  qldif
       qcmif_1d    ,     &  !: corresponding to the 2D var  qcmif
@@ -80 +81 @@
       dqla_ice_1d          !:    "                  "      dqla_ice
 
-   REAL(wp), PUBLIC, DIMENSION(jpij,jplayersp1) ::   &  !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !:
       tbif_1d              !: corresponding to the 2D var  tbif
 
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+ CONTAINS
+
+   INTEGER FUNCTION thd_ice_alloc_2()
+      !!----------------------------------------------------------------------
+      USE lib_mpp        ! MPP library
+      INTEGER :: ierr(4)
+      !!----------------------------------------------------------------------
+      !
+      ierr(:) = 0
+      !
+      ALLOCATE( npb(jpij), npac(jpij),                             &
+         &      qldif_1d(jpij), qcmif_1d(jpij), thcm_1d(jpij),     &
+         &      fstbif_1d(jpij), fltbif_1d(jpij), fscbq_1d(jpij),  &
+         &      qsr_ice_1d(jpij),fr1_i0_1d(jpij), fr2_i0_1d(jpij), Stat=ierr(1))
+         !
+      ALLOCATE( qns_ice_1d(jpij), qfvbq_1d(jpij), sist_1d(jpij), tfu_1d(jpij), &
+         &      sprecip_1d(jpij), h_snow_1d(jpij),h_ice_1d(jpij),frld_1d(jpij),&
+         &      qstbif_1d(jpij),  fbif_1d(jpij),  Stat=ierr(2))
+         !
+      ALLOCATE( rdmicif_1d(jpij), rdmsnif_1d(jpij), qlbbq_1d(jpij),   &
+         &      dmgwi_1d(jpij)  , dvsbq_1d(jpij)  , rdvomif_1d(jpij), &
+         &      dvbbq_1d(jpij)  , dvlbq_1d(jpij)  , dvnbq_1d(jpij)  , &
+         &      Stat=ierr(3))
+         !
+      ALLOCATE( dqns_ice_1d(jpij) ,qla_ice_1d(jpij), dqla_ice_1d(jpij), &
+         &      tbif_1d(jpij, jplayersp1), Stat=ierr(4))
+         !
+      thd_ice_alloc_2 = MAXVAL(ierr)
+      IF( thd_ice_alloc_2 /= 0 )   CALL ctl_warn('thd_ice_alloc_2: failed to allocate arrays')
+      !
+   END FUNCTION thd_ice_alloc_2
+
+#endif
    !!======================================================================
-#endif
 END MODULE thd_ice_2