Changeset 3294 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

Timestamp:

2012-01-28T17:44:18+01:00 (12 years ago)

Author:

rblod

Message:

Merge of 3.4beta into the trunk

File:

• trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90 (modified) (5 diffs)

trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

@@ -24 +24 @@
    USE lbclnk           ! Lateral Boundary Condition / MPP link
    USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
    USE in_out_manager   ! I/O manager
    USE prtctl           ! Print control
@@ -39 +40 @@
 
    PUBLIC   lim_rhg        ! routine called by lim_dyn (or lim_dyn_2)
-   PUBLIC   lim_rhg_alloc  ! routine called by nemo_alloc in nemogcm.F90
 
    REAL(wp) ::   rzero   = 0._wp   ! constant values
    REAL(wp) ::   rone    = 1._wp   ! constant values
       
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zpresh           ! temporary array for ice strength
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zpreshc          ! Ice strength on grid cell corners (zpreshc)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zfrld1, zfrld2   ! lead fraction on U/V points                                    
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zmass1, zmass2   ! ice/snow mass on U/V points                                    
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zc1              ! ice mass
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zusw             ! temporary weight for ice strength computation
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce1, v_oce1   ! ocean u/v component on U points                           
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce2, v_oce2   ! ocean u/v component on V points
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice2, v_ice1   ! ice u/v component on V/U point
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zdd   , zdt      ! Divergence and tension at centre of grid cells
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zds              ! Shear on northeast corner of grid cells
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   deltat, deltac   ! Delta at centre and corners of grid cells
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zs1   , zs2      ! Diagonal stress tensor components zs1 and zs2 
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zs12             ! Non-diagonal stress tensor component zs12
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr   ! Local error on velocity
-
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -72 +52 @@
    !!----------------------------------------------------------------------
 CONTAINS
-
-   FUNCTION lim_rhg_alloc()
-      !!-------------------------------------------------------------------
-      !!                 ***  FUNCTION lim_rhg_alloc  ***
-      !!-------------------------------------------------------------------
-      INTEGER :: lim_rhg_alloc   ! return value
-      INTEGER :: ierr(2)         ! local integer
-      !!-------------------------------------------------------------------
-      !
-      ierr(:) = 0
-      !
-      ALLOCATE( zpresh (jpi,jpj) , zfrld1(jpi,jpj), zmass1(jpi,jpj), zcorl1(jpi,jpj), za1ct(jpi,jpj) ,      &
-         &      zpreshc(jpi,jpj) , zfrld2(jpi,jpj), zmass2(jpi,jpj), zcorl2(jpi,jpj), za2ct(jpi,jpj) ,      &
-         &      zc1    (jpi,jpj) , u_oce1(jpi,jpj), u_oce2(jpi,jpj), u_ice2(jpi,jpj),                       &
-         &      zusw   (jpi,jpj) , v_oce1(jpi,jpj), v_oce2(jpi,jpj), v_ice1(jpi,jpj)                 ,  STAT=ierr(1) )
-         !
-      ALLOCATE( zf1(jpi,jpj) , deltat(jpi,jpj) , zu_ice(jpi,jpj) ,                     &
-         &      zf2(jpi,jpj) , deltac(jpi,jpj) , zv_ice(jpi,jpj) ,                     &
-         &      zdd(jpi,jpj) , zdt   (jpi,jpj) , zds   (jpi,jpj) ,                     &
-         &      zs1(jpi,jpj) , zs2   (jpi,jpj) , zs12  (jpi,jpj) , zresr(jpi,jpj), STAT=ierr(2) )
-         !
-      lim_rhg_alloc = MAXVAL(ierr)
-      !
-   END FUNCTION lim_rhg_alloc
-
 
    SUBROUTINE lim_rhg( k_j1, k_jpj )
@@ -169 +124 @@
       REAL(wp) ::   zindb         ! ice (1) or not (0)      
       REAL(wp) ::   zdummy        ! dummy argument
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zpresh           ! temporary array for ice strength
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zpreshc          ! Ice strength on grid cell corners (zpreshc)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zfrld1, zfrld2   ! lead fraction on U/V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmass1, zmass2   ! ice/snow mass on U/V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zc1              ! ice mass
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zusw             ! temporary weight for ice strength computation
+      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce1, v_oce1   ! ocean u/v component on U points                           
+      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2, v_oce2   ! ocean u/v component on V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   u_ice2, v_ice1   ! ice u/v component on V/U point
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses
+      
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdd   , zdt      ! Divergence and tension at centre of grid cells
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zds              ! Shear on northeast corner of grid cells
+      REAL(wp), POINTER, DIMENSION(:,:) ::   deltat, deltac   ! Delta at centre and corners of grid cells
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zs1   , zs2      ! Diagonal stress tensor components zs1 and zs2 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zs12             ! Non-diagonal stress tensor component zs12
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr   ! Local error on velocity
+      
       !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
+      CALL wrk_alloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                )
+      CALL wrk_alloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds          )
+      CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr                         )
+
 #if  defined key_lim2 && ! defined key_lim2_vp
 # if defined key_agrif
@@ -761 +743 @@
       ENDIF
       !
+      CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
+      CALL wrk_dealloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                )
+      CALL wrk_dealloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds          )
+      CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr                         )
+
    END SUBROUTINE lim_rhg