Changeset 8373 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

Timestamp:

2017-07-25T19:44:54+02:00 (7 years ago)

Author:

clem

Message:

remove most of wrk_alloc

File:

• branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90 (modified) (9 diffs)

branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

@@ -85 +85 @@
       REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean
 
-      REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow                       (J.m-3)
-      REAL(wp), POINTER, DIMENSION(:) ::   zq_su       ! heat for surface ablation                   (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zq_bo       ! heat for bottom ablation                    (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2)
-
-      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(:,:) ::   zdeltah
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness
-      INTEGER , POINTER, DIMENSION(:,:) ::   icount    ! number of layers vanished by melting 
-
-      REAL(wp), POINTER, DIMENSION(:) ::   zeh_i       ! total ice heat content  (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zsnw        ! distribution of snow after wind blowing
+      REAL(wp), DIMENSION(jpij) ::   zqprec      ! energy of fallen snow                       (J.m-3)
+      REAL(wp), DIMENSION(jpij) ::   zq_su       ! heat for surface ablation                   (J.m-2)
+      REAL(wp), DIMENSION(jpij) ::   zq_bo       ! heat for bottom ablation                    (J.m-2)
+      REAL(wp), DIMENSION(jpij) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2)
+      REAL(wp), DIMENSION(jpij) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2)
+      REAL(wp), DIMENSION(jpij) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2)
+
+      REAL(wp), DIMENSION(jpij) ::   zdh_s_mel   ! snow melt 
+      REAL(wp), DIMENSION(jpij) ::   zdh_s_pre   ! snow precipitation 
+      REAL(wp), DIMENSION(jpij) ::   zdh_s_sub   ! snow sublimation
+
+      REAL(wp), DIMENSION(jpij,nlay_i) ::   zdeltah
+      REAL(wp), DIMENSION(jpij,nlay_i) ::   zh_i      ! ice layer thickness
+      INTEGER , DIMENSION(jpij,nlay_i) ::   icount    ! number of layers vanished by melting 
+
+      REAL(wp), DIMENSION(jpij) ::   zeh_i       ! total ice heat content  (J.m-2)
+      REAL(wp), DIMENSION(jpij) ::   zsnw        ! distribution of snow after wind blowing
 
       REAL(wp) :: zswitch_sal
@@ -107 +107 @@
       ! Heat conservation 
       INTEGER  ::   num_iter_max
-
       !!------------------------------------------------------------------
 
       ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values)
       SELECT CASE( nn_icesal )                  ! varying salinity or not
-         CASE( 1, 3 ) ;   zswitch_sal = 0       ! prescribed salinity profile
-         CASE( 2 )    ;   zswitch_sal = 1       ! varying salinity profile
+         CASE( 1, 3 ) ;   zswitch_sal = 0._wp   ! prescribed salinity profile
+         CASE( 2 )    ;   zswitch_sal = 1._wp   ! varying salinity profile
       END SELECT
 
-      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )
-      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zeh_i )
-      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i )
-      CALL wrk_alloc( jpij, nlay_i, icount )
-       
-      zqprec   (:) = 0._wp ; zq_su    (:) = 0._wp ; zq_bo    (:) = 0._wp ; zf_tt(:) = 0._wp
-      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp ; zevap_rema(:) = 0._wp ;
-      zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zeh_i(:) = 0._wp
-
-      zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp       
-      icount (:,:) = 0
-
-      ! Initialize enthalpy at nlay_i+1
-      DO ji = 1, nidx
-         e_i_1d(ji,nlay_i+1) = 0._wp
+      DO ji = 1, nidx
+         icount (ji,:) = 0
+         zdh_s_mel(ji) = 0._wp
+         e_i_1d(ji,nlay_i+1) = 0._wp ! Initialize enthalpy at nlay_i+1
       END DO
 
       ! initialize layer thicknesses and enthalpies
-      h_i_old (:,0:nlay_i+1) = 0._wp
-      eh_i_old(:,0:nlay_i+1) = 0._wp
+      h_i_old (1:nidx,0:nlay_i+1) = 0._wp
+      eh_i_old(1:nidx,0:nlay_i+1) = 0._wp
       DO jk = 1, nlay_i
          DO ji = 1, nidx
@@ -204 +192 @@
       CALL lim_thd_snwblow( 1. - at_i_1d(1:nidx), zsnw(1:nidx) ) ! snow distribution over ice after wind blowing
 
-      zdeltah(:,:) = 0._wp
+      zdeltah(1:nidx,:) = 0._wp
       DO ji = 1, nidx
          !-----------
@@ -239 +227 @@
 
       ! If heat still available (zq_su > 0), then melt more snow
-      zdeltah(:,:) = 0._wp
+      zdeltah(1:nidx,:) = 0._wp
       DO jk = 1, nlay_s
          DO ji = 1, nidx
@@ -263 +251 @@
       ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
       ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean)
-      zdeltah(:,:) = 0._wp
+      zdeltah(1:nidx,:) = 0._wp
       DO ji = 1, nidx
          zdh_s_sub(ji)  = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice )
@@ -303 +291 @@
       ! 3.4 Surface ice ablation 
       !--------------------------
-      zdeltah(:,:) = 0._wp ! important
+      zdeltah(1:nidx,:) = 0._wp ! important
       DO jk = 1, nlay_i
          DO ji = 1, nidx
@@ -498 +486 @@
       ! 4.2 Basal melt
       !----------------
-      zdeltah(:,:) = 0._wp ! important
+      zdeltah(1:nidx,:) = 0._wp ! important
       DO jk = nlay_i, 1, -1
          DO ji = 1, nidx
@@ -583 +571 @@
       ! If heat still available for melting and snow remains, then melt more snow
       !-------------------------------------------
-      zdeltah(:,:) = 0._wp ! important
+      zdeltah(1:nidx,:) = 0._wp ! important
       DO ji = 1, nidx
          zq_rema(ji)     = zq_su(ji) + zq_bo(ji) 
@@ -668 +656 @@
       DO ji = 1, nidx
          IF( ht_i_1d(ji) == 0._wp )   a_i_1d(ji) = 0._wp
-      END DO
-         
-      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )
-      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zeh_i )
-      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i )
-      CALL wrk_dealloc( jpij, nlay_i, icount )
-      !
+      END DO         
       !
    END SUBROUTINE lim_thd_dh