Changeset 3294 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.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/limthd_lac.F90 (modified) (4 diffs)

trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

@@ -26 +26 @@
    USE limtab           ! LIM 2D <==> 1D
    USE limcons          ! LIM conservation
-   USE wrk_nemo         ! workspace manager
    USE in_out_manager   ! I/O manager
    USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
 
    IMPLICIT NONE
@@ -77 +77 @@
       !!               update ht_s_b, ht_i_b and tbif_1d(:,:)      
       !!------------------------------------------------------------------------
-      USE wrk_nemo, ONLY :   vt_i_init => wrk_2d_1 , vt_i_final => wrk_2d_4 , et_i_init => wrk_2d_7
-      USE wrk_nemo, ONLY :   vt_s_init => wrk_2d_2 , vt_s_final => wrk_2d_5 , et_s_init => wrk_2d_8
-      USE wrk_nemo, ONLY :   zvrel     => wrk_2d_3 , et_i_final => wrk_2d_6 
-      !
       INTEGER ::   ji,jj,jk,jl,jm   ! dummy loop indices
       INTEGER ::   layer, nbpac     ! local integers 
@@ -90 +86 @@
       CHARACTER (len = 15) :: fieldid
       !
-      INTEGER, DIMENSION(jpij) ::   zcatac    !  indexes of categories where new ice grows
-
-      REAL(wp), DIMENSION(jpij,jpl) ::   zhice_old   ! previous ice thickness
-      REAL(wp), DIMENSION(jpij,jpl) ::   zdummy      ! dummy thickness of new ice 
-      REAL(wp), DIMENSION(jpij,jpl) ::   zdhicbot    ! thickness of new ice which is accreted vertically
-      REAL(wp), DIMENSION(jpij,jpl) ::   zv_old      ! old volume of ice in category jl
-      REAL(wp), DIMENSION(jpij,jpl) ::   za_old      ! old area of ice in category jl
-      REAL(wp), DIMENSION(jpij,jpl) ::   za_i_ac     ! 1-D version of a_i
-      REAL(wp), DIMENSION(jpij,jpl) ::   zv_i_ac     ! 1-D version of v_i
-      REAL(wp), DIMENSION(jpij,jpl) ::   zoa_i_ac    ! 1-D version of oa_i
-      REAL(wp), DIMENSION(jpij,jpl) ::   zsmv_i_ac   ! 1-D version of smv_i
-
-      REAL(wp), DIMENSION(jpij,jkmax  ,jpl) ::   ze_i_ac   !: 1-D version of e_i
-      REAL(wp), DIMENSION(jpij,jkmax+1,jpl) ::   zqm0      ! old layer-system heat content
-      REAL(wp), DIMENSION(jpij,jkmax+1,jpl) ::   zthick0   ! old ice thickness
-
-      REAL(wp), POINTER, DIMENSION(:) ::   zv_newice, zh_newice, zs_newice, zdv_res, zat_i_ac , zdh_frazb, zqbgow
-      REAL(wp), POINTER, DIMENSION(:) ::   za_newice, ze_newice, zo_newice, zda_res, zat_i_lev, zvrel_ac , zdhex
-      REAL(wp), POINTER, DIMENSION(:) ::   zswinew
+      INTEGER , POINTER, DIMENSION(:) ::   zcatac      ! indexes of categories where new ice grows
+      REAL(wp), POINTER, DIMENSION(:) ::   zswinew     ! switch for new ice or not
+
+      REAL(wp), POINTER, DIMENSION(:) ::   zv_newice   ! volume of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   za_newice   ! fractional area of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   zh_newice   ! thickness of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   ze_newice   ! heat content of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   zs_newice   ! salinity of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   zo_newice   ! age of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   zdv_res     ! residual volume in case of excessive heat budget
+      REAL(wp), POINTER, DIMENSION(:) ::   zda_res     ! residual area in case of excessive heat budget
+      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_ac    ! total ice fraction    
+      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_lev   ! total ice fraction for level ice only (type 1)   
+      REAL(wp), POINTER, DIMENSION(:) ::   zdh_frazb   ! accretion of frazil ice at the ice bottom
+      REAL(wp), POINTER, DIMENSION(:) ::   zvrel_ac    ! relative ice / frazil velocity (1D vector)
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zhice_old   ! previous ice thickness
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdummy      ! dummy thickness of new ice 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdhicbot    ! thickness of new ice which is accreted vertically
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_old      ! old volume of ice in category jl
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za_old      ! old area of ice in category jl
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_ac     ! 1-D version of a_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_ac     ! 1-D version of v_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_ac    ! 1-D version of oa_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_ac   ! 1-D version of smv_i
+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_ac   !: 1-D version of e_i
+
+      REAL(wp), POINTER, DIMENSION(:) ::   zqbgow    ! heat budget of the open water (negative)
+      REAL(wp), POINTER, DIMENSION(:) ::   zdhex     ! excessively thick accreted sea ice (hlead-hice)
+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqm0      ! old layer-system heat content
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zthick0   ! old ice thickness
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final   ! ice volume summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   !  snow volume summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:) ::   et_i_init, et_i_final   !  ice energy summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:) ::   et_s_init               !  snow energy summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity
       !!-----------------------------------------------------------------------!
 
-      IF(  wrk_in_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) .OR.   &
-         & wrk_in_use(2, 1,2,3,4,5,6,7,8)                        ) THEN
-         CALL ctl_stop('lim_thd_lac : requestead workspace arrays unavailable.')   ;   RETURN
-      END IF
-      ! Set-up pointers to sub-arrays of workspace arrays
-      zv_newice =>  wrk_1d_1 (1:jpij)   ! volume of accreted ice
-      za_newice =>  wrk_1d_2 (1:jpij)   ! fractional area of accreted ice
-      zh_newice =>  wrk_1d_3 (1:jpij)   ! thickness of accreted ice
-      ze_newice =>  wrk_1d_4 (1:jpij)   ! heat content of accreted ice
-      zs_newice =>  wrk_1d_5 (1:jpij)   ! salinity of accreted ice
-      zo_newice =>  wrk_1d_6 (1:jpij)   ! age of accreted ice
-      zdv_res   =>  wrk_1d_7 (1:jpij)   ! residual volume in case of excessive heat budget
-      zda_res   =>  wrk_1d_8 (1:jpij)   ! residual area in case of excessive heat budget
-      zat_i_ac  =>  wrk_1d_9 (1:jpij)   ! total ice fraction
-      zat_i_lev =>  wrk_1d_10(1:jpij)   ! total ice fraction for level ice only (type 1)   
-      zdh_frazb =>  wrk_1d_11(1:jpij)   ! accretion of frazil ice at the ice bottom
-      zvrel_ac  =>  wrk_1d_12(1:jpij)   ! relative ice / frazil velocity (1D vector)
-      zqbgow    =>  wrk_1d_13(1:jpij)   ! heat budget of the open water (negative)
-      zdhex     =>  wrk_1d_14(1:jpij)   ! excessively thick accreted sea ice (hlead-hice)
-      zswinew   =>  wrk_1d_15(1:jpij)   ! switch for new ice or not
-
-
+      CALL wrk_alloc( jpij, zcatac )   ! integer
+      CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
+      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex )
+      CALL wrk_alloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac )
+      CALL wrk_alloc( jpij,jkmax,jpl, ze_i_ac )
+      CALL wrk_alloc( jpij,jkmax+1,jpl, zqm0, zthick0 )
+      CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel )
 
       et_i_init(:,:) = 0._wp
@@ -691 +692 @@
       ENDIF
       !
-      IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) .OR.     &
-          wrk_not_released(2, 1,2,3,4,5,6,7,8)                       )   &
-          CALL ctl_stop( 'lim_thd_lac : failed to release workspace arrays' )
+      CALL wrk_dealloc( jpij, zcatac )   ! integer
+      CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
+      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex )
+      CALL wrk_dealloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac )
+      CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_ac )
+      CALL wrk_dealloc( jpij,jkmax+1,jpl, zqm0, zthick0 )
+      CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel )
       !
    END SUBROUTINE lim_thd_lac