Changeset 8371 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM

Timestamp:

2017-07-25T17:41:16+02:00 (7 years ago)

Author:

clem

Message:

minor updates

Location:

branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3

Files:

• limthd.F90 (modified) (7 diffs)
• limthd_da.F90 (modified) (1 diff)
• thd_ice.F90 (modified) (2 diffs)

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

@@ -205 +205 @@
       END DO
 
-      !------------------------------------------------------------------------------!
-      ! Thermodynamic computation (only on grid points covered by ice)
-      !------------------------------------------------------------------------------!
-
-      DO jl = 1, jpl      !loop over ice categories
+      !-------------------------------------------------------------------------------------------!
+      ! Thermodynamic computation (only on grid points covered by ice) => loop over ice categories
+      !-------------------------------------------------------------------------------------------!
+      DO jl = 1, jpl
 
          ! select ice covered grid points
@@ -237 +236 @@
          IF( nidx > 0 ) THEN  ! If there is no ice, do nothing.
             !                                                                
-            s_i_new   (:) = 0._wp ; dh_s_tot (:) = 0._wp            ! --- some init --- !
-            dh_i_surf (:) = 0._wp ; dh_i_bott(:) = 0._wp
-            dh_snowice(:) = 0._wp ; dh_i_sub (:) = 0._wp
+            s_i_new   (1:nidx) = 0._wp ; dh_s_tot (1:nidx) = 0._wp  ! --- some init --- !
+            dh_i_surf (1:nidx) = 0._wp ; dh_i_bott(1:nidx) = 0._wp
+            dh_snowice(1:nidx) = 0._wp ; dh_i_sub (1:nidx) = 0._wp
 
                               CALL lim_thd_1d2d( jl, 1 )            ! --- Move to 1D arrays --- !
@@ -275 +274 @@
             ENDDO
             !
+            ! Change thickness to volume
+            v_i_1d(1:nidx)   = ht_i_1d(1:nidx) * a_i_1d(1:nidx)
+            v_s_1d(1:nidx)   = ht_s_1d(1:nidx) * a_i_1d(1:nidx)
+            smv_i_1d(1:nidx) = sm_i_1d(1:nidx) * v_i_1d(1:nidx)
+            !
                               CALL lim_thd_1d2d( jl, 2 )            ! --- Move to 2D arrays --- !
             !
@@ -281 +285 @@
          !
       END DO
-
-      ! Change thickness to volume
-      at_i(:,:)    = SUM( a_i(:,:,:), dim=3 )
-      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:)
-      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
-      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
-      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat)
+      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
+
+      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting)
       DO jl  = 1, jpl
          DO jj = 1, jpj
@@ -299 +297 @@
       END DO
 
+      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
       CALL lim_var_zapsmall
 
-      ! control checks
       IF( ln_limctl )    CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' )   ! control print
       !
-
       !------------------------------------------------!
       !  Transport ice between thickness categories
       !------------------------------------------------!
-      ! Given thermodynamic growth rates, transport ice between thickness categories.
       IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
@@ -322 +319 @@
       IF( ln_limdO )     CALL lim_thd_lac
       
-      ! conservation test
       IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-      ! Control print
-      IF( ln_ctl )       CALL lim_prt3D( 'limthd' )
+      IF( ln_ctl )       CALL lim_prt3D( 'limthd' )  ! Control print
       !
       CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric )
@@ -555 +550 @@
          CALL tab_1d_2d( nidx, idxice(1:nidx), diag_fc_bo_1d(1:nidx), diag_fc_bo        )
          CALL tab_1d_2d( nidx, idxice(1:nidx), diag_fc_su_1d(1:nidx), diag_fc_su        )
+         ! extensive variables
+         CALL tab_1d_2d( nidx, idxice(1:nidx), v_i_1d  (1:nidx), v_i  (:,:,jl) )
+         CALL tab_1d_2d( nidx, idxice(1:nidx), v_s_1d  (1:nidx), v_s  (:,:,jl) )
+         CALL tab_1d_2d( nidx, idxice(1:nidx), smv_i_1d(1:nidx), smv_i(:,:,jl) )
       END SELECT
       !

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

@@ -135 +135 @@
             wfx_lam_1d(ji) =  wfx_lam_1d(ji) + zda * r1_rdtice * ( rhoic * ht_i_1d(ji) + rhosn * ht_s_1d(ji) )
             
-            !! adjust e_i ???
-!!            e_i_1d(ji,1:nlay_i) = e_i_1d(ji,1:nlay_i) * ( 1._wp - zda / a_i_1d(ji) )
-!!            e_s_1d(ji,1)        = e_s_1d(ji,1)        * ( 1._wp - zda / a_i_1d(ji) )
-            
             ! new concentration
             a_i_1d(ji) = a_i_1d(ji) - zda

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

@@ -110 +110 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_1d       !: Ice bulk salinity [ppt]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new       !: Salinity of new ice at the bottom
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d        !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_ip_1d        !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d       !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_ip_1d       !:
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_i_1d        !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_s_1d        !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   smv_i_1d      !:
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d   !: corresponding to the 2D var  t_s
@@ -195 +197 @@
          &      dh_s_tot (jpij) , dh_i_surf (jpij) , dh_i_sub(jpij) ,                                  &    
          &      dh_i_bott(jpij) , dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new(jpij) , &
-         &      a_ip_1d  (jpij) , v_ip_1d   (jpij) , v_i_1d  (jpij) , STAT=ierr(ii) )
+         &      a_ip_1d  (jpij) , v_ip_1d   (jpij) , v_i_1d  (jpij) , v_s_1d (jpij) , smv_i_1d(jpij) , STAT=ierr(ii) )
       !
       ii = ii + 1