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

trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

@@ -6 +6 @@
    !! History :  LIM  ! 2008-03 (M. Vancoppenolle)  LIM-3 from LIM-2 code
    !!            3.2  ! 2009-06 (F. Dupont)  correct a error in the North fold b. c.
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
    !!--------------------------------------------------------------------
 #if defined key_lim3
@@ -14 +15 @@
    !!   lim_adv_y  : advection of sea ice on y axis
    !!----------------------------------------------------------------------
-   USE dom_oce
-   USE dom_ice
-   USE ice
-   USE lbclnk
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
+   USE dom_oce          ! ocean domain
+   USE dom_ice          ! LIM-3 domain
+   USE ice              ! LIM-3 variables
+   USE lbclnk           ! lateral boundary condition - MPP exchanges
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
+   USE lib_mpp          ! MPP library
 
    IMPLICIT NONE
@@ -27 +29 @@
    PUBLIC   lim_adv_y   ! called by lim_trp
 
-   REAL(wp)  ::   epsi20 = 1.e-20   ! constant values
-   REAL(wp)  ::   rzero  = 0.e0     !    -       -
-   REAL(wp)  ::   rone   = 1.e0     !    -       -
+   REAL(wp)  ::   epsi20 = 1.e-20_wp   ! constant values
+   REAL(wp)  ::   rzero  = 0._wp       !    -       -
+   REAL(wp)  ::   rone   = 1._wp       !    -       -
 
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! 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)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -55 +56 @@
       !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681.
       !!--------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   zf0  => wrk_2d_11 , zfx   => wrk_2d_12 , zfy    => wrk_2d_13 , zbet => wrk_2d_14   ! 2D workspace
+      USE wrk_nemo, ONLY:   zfm  => wrk_2d_15 , zfxx  => wrk_2d_16 , zfyy   => wrk_2d_17 , zfxy => wrk_2d_18   !  -      -
+      USE wrk_nemo, ONLY:   zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21                       !  -      -
+      !
       REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step
       REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0)
@@ -64 +70 @@
       !! 
       INTEGER  ::   ji, jj                               ! dummy loop indices
-      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars
-      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         -
-      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         -
-      REAL(wp), DIMENSION(jpi,jpj) ::   zf0, zfx , zfy , zbet   ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj) ::   zfm, zfxx, zfyy, zfxy   !  -      -
-      REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q     !  -      -
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! local scalars
+      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      -
+      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      -
       !---------------------------------------------------------------------
+
+      IF( wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN
+         CALL ctl_stop('lim_adv_x: requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
 
       ! Limitation of moments.                                           
@@ -216 +223 @@
          CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_x: psxy :')
       ENDIF
+      !
+      IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) )    &
+          CALL ctl_stop('lim_adv_x : failed to release workspace arrays')
       !
    END SUBROUTINE lim_adv_x
@@ -234 +244 @@
       !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681.
       !!---------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   zf0  => wrk_2d_11 , zfx   => wrk_2d_12 , zfy    => wrk_2d_13 , zbet => wrk_2d_14   ! 2D workspace
+      USE wrk_nemo, ONLY:   zfm  => wrk_2d_15 , zfxx  => wrk_2d_16 , zfyy   => wrk_2d_17 , zfxy => wrk_2d_18   !  -      -
+      USE wrk_nemo, ONLY:   zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21                       !  -      -
+      !
       REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step
       REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0)
@@ -246 +261 @@
       REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         -
       REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         -
-      REAL(wp), DIMENSION(jpi,jpj) ::   zf0, zfx , zfy , zbet   ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj) ::   zfm, zfxx, zfyy, zfxy   !  -      -
-      REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q     !  -      -
       !---------------------------------------------------------------------
+
+      IF( wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN
+         CALL ctl_stop('lim_adv_y : requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
 
       ! Limitation of moments.
@@ -397 +413 @@
       ENDIF
       !
+      IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) )    &
+         CALL ctl_stop('lim_adv_y: failed to release workspace arrays')
+      !
    END SUBROUTINE lim_adv_y
-
 
 #else