Changeset 3148 for branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

Timestamp:

2011-11-17T17:28:07+01:00 (12 years ago)

Author:

smasson

Message:

dev_NEMO_MERGE_2011: new dynamical allocation in LIM3

File:

• branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90 (modified) (4 diffs)

branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

@@ -21 +21 @@
    USE par_ice          ! LIM parameters
    USE thd_ice          ! LIM thermodynamics
-   USE wrk_nemo         ! workspace manager
    USE in_out_manager   ! I/O manager
    USE lib_mpp          ! MPP library
+   USE wrk_nemo_2       ! work arrays
 
    IMPLICIT NONE
@@ -76 +76 @@
       INTEGER  ::   i_ice_switch   ! ice thickness above a certain treshold or not
       INTEGER  ::   iter
-      INTEGER  ::   num_iter_max, numce_dh
-
-      REAL(wp) ::   meance_dh
+
       REAL(wp) ::   zzfmass_i, zihgnew                     ! local scalar
       REAL(wp) ::   zzfmass_s, zhsnew, ztmelts             ! local scalar
@@ -93 +91 @@
       REAL(wp) ::   ztform       ! bottom formation temperature
       !
-      REAL(wp), POINTER, DIMENSION(:) ::   zh_i, ztfs  , zqfont_su, zqprec  , zhgnew
-      REAL(wp), POINTER, DIMENSION(:) ::   zh_s, zhsold, zqfont_bo, z_f_surf, zfmass_i
-      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel, zdh_s_sub  , zfdt_init , zqt_i, zqt_dummy, zdq_i
-      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_pre, zfsalt_melt, zfdt_final, zqt_s, zfbase   , zinnermelt
-      !
-      REAL(wp), DIMENSION(jpij,jkmax) ::   zdeltah
-      REAL(wp), DIMENSION(jpij,jkmax) ::   zqt_i_lay   ! total ice heat content
+      REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness
+      REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness
+      REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! melting point
+      REAL(wp), POINTER, DIMENSION(:) ::   zhsold      ! old snow thickness
+      REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow
+      REAL(wp), POINTER, DIMENSION(:) ::   zqfont_su   ! incoming, remaining surface energy
+      REAL(wp), POINTER, DIMENSION(:) ::   zqfont_bo   ! incoming, bottom energy
+      REAL(wp), POINTER, DIMENSION(:) ::   z_f_surf    ! surface heat for ablation
+      REAL(wp), POINTER, DIMENSION(:) ::   zhgnew      ! new ice thickness
+      REAL(wp), POINTER, DIMENSION(:) ::   zfmass_i    ! 
+
+      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel     ! snow melt 
+      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_pre     ! snow precipitation 
+      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_sub     ! snow sublimation
+      REAL(wp), POINTER, DIMENSION(:) ::   zfsalt_melt   ! salt flux due to ice melt
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah
+
+      ! Pathological cases
+      REAL(wp), POINTER, DIMENSION(:) ::   zfdt_init   ! total incoming heat for ice melt
+      REAL(wp), POINTER, DIMENSION(:) ::   zfdt_final  ! total remaing heat for ice melt
+      REAL(wp), POINTER, DIMENSION(:) ::   zqt_i       ! total ice heat content
+      REAL(wp), POINTER, DIMENSION(:) ::   zqt_s       ! total snow heat content
+      REAL(wp), POINTER, DIMENSION(:) ::   zqt_dummy   ! dummy heat content
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zqt_i_lay   ! total ice heat content
+
+      ! Heat conservation 
+      INTEGER  ::   num_iter_max, numce_dh
+      REAL(wp) ::   meance_dh
+      REAL(wp), POINTER, DIMENSION(:) ::   zinnermelt
+      REAL(wp), POINTER, DIMENSION(:) ::   zfbase, zdq_i
       !!------------------------------------------------------------------
 
-      IF( wrk_in_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22) ) THEN
-         CALL ctl_stop('lim_thd_dh: requestead workspace arrays unavailable')   ;   RETURN
-      ENDIF
-      ! Set-up pointers to sub-arrays of workspace arrays
-      zh_i        => wrk_1d_1 (1:jpij)   ! ice layer thickness
-      zh_s        => wrk_1d_2 (1:jpij)   ! snow layer thickness
-      ztfs        => wrk_1d_3 (1:jpij)   ! melting point
-      zhsold      => wrk_1d_4 (1:jpij)   ! old snow thickness
-      zqprec      => wrk_1d_5 (1:jpij)   ! energy of fallen snow
-      zqfont_su   => wrk_1d_6 (1:jpij)   ! incoming, remaining surface energy
-      zqfont_bo   => wrk_1d_7 (1:jpij)   ! incoming, bottom energy
-      z_f_surf    => wrk_1d_8 (1:jpij)   ! surface heat for ablation
-      zhgnew      => wrk_1d_9 (1:jpij)   ! new ice thickness
-      zfmass_i    => wrk_1d_10(1:jpij)   ! 
-      !
-      zdh_s_mel   => wrk_1d_11(1:jpij)   ! snow melt 
-      zdh_s_pre   => wrk_1d_12(1:jpij)   ! snow precipitation 
-      zdh_s_sub   => wrk_1d_13(1:jpij)   ! snow sublimation
-      zfsalt_melt => wrk_1d_14(1:jpij)   ! salt flux due to ice melt
-      !
-      !                              ! Pathological cases
-      zfdt_init   => wrk_1d_15(1:jpij)   ! total incoming heat for ice melt
-      zfdt_final  => wrk_1d_16(1:jpij)   ! total remaing heat for ice melt
-      zqt_i       => wrk_1d_17(1:jpij)   ! total ice heat content
-      zqt_s       => wrk_1d_18(1:jpij)   ! total snow heat content
-      zqt_dummy   => wrk_1d_19(1:jpij)   ! dummy heat content
-           
-      zfbase      => wrk_1d_20(1:jpij)        
-      zdq_i       => wrk_1d_21(1:jpij) 
-      zinnermelt  => wrk_1d_22(1:jpij) 
+      CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i )
+      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfsalt_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy )
+      CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i )
+      CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay )
 
       zfsalt_melt(:)  = 0._wp
@@ -699 +696 @@
       END DO !ji
       !
-      IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22) )   &
-          CALL ctl_stop('lim_thd_dh : failed to release workspace arrays')
+      CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i )
+      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfsalt_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy )
+      CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i )
+      CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay )
       !
    END SUBROUTINE lim_thd_dh