Changeset 14021 for NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn.F90

Timestamp:

2020-12-02T20:53:00+01:00 (3 years ago)

Author:

laurent

Message:

Caught up with trunk rev 14020...

File:

• NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn.F90 (modified) (16 diffs)

NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn.F90

@@ -2 +2 @@
    !!======================================================================
    !!                     ***  MODULE  icedyn  ***
-   !!   Sea-Ice dynamics : master routine for sea ice dynamics 
+   !!   Sea-Ice dynamics : master routine for sea ice dynamics
    !!======================================================================
    !! history :  4.0  ! 2018  (C. Rousset)  original code SI3 [aka Sea Ice cube]
@@ -29 +29 @@
    USE lbclnk         ! lateral boundary conditions (or mpp links)
    USE timing         ! Timing
+   USE fldread        ! read input fields
 
    IMPLICIT NONE
@@ -35 +36 @@
    PUBLIC   ice_dyn        ! called by icestp.F90
    PUBLIC   ice_dyn_init   ! called by icestp.F90
-   
+
    INTEGER ::              nice_dyn   ! choice of the type of dynamics
    !                                        ! associated indices:
    INTEGER, PARAMETER ::   np_dynALL     = 1   ! full ice dynamics               (rheology + advection + ridging/rafting + correction)
-   INTEGER, PARAMETER ::   np_dynRHGADV  = 2   ! pure dynamics                   (rheology + advection) 
+   INTEGER, PARAMETER ::   np_dynRHGADV  = 2   ! pure dynamics                   (rheology + advection)
    INTEGER, PARAMETER ::   np_dynADV1D   = 3   ! only advection 1D - test case from Schar & Smolarkiewicz 1996
    INTEGER, PARAMETER ::   np_dynADV2D   = 4   ! only advection 2D w prescribed vel.(rn_uvice + advection)
@@ -50 +51 @@
    REAL(wp) ::   rn_uice          !    prescribed u-vel (case np_dynADV1D & np_dynADV2D)
    REAL(wp) ::   rn_vice          !    prescribed v-vel (case np_dynADV1D & np_dynADV2D)
-   
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_icbmsk   ! structure of input grounded icebergs mask (file informations, fields read)
+
    !! * Substitutions
 #  include "do_loop_substitute.h90"
@@ -63 +66 @@
       !!-------------------------------------------------------------------
       !!               ***  ROUTINE ice_dyn  ***
-      !!               
+      !!
       !! ** Purpose :   this routine manages sea ice dynamics
       !!
@@ -81 +84 @@
       !
       ! controls
-      IF( ln_timing )   CALL timing_start('icedyn')
+      IF( ln_timing )   CALL timing_start('ice_dyn')
       !
       IF( kt == nit000 .AND. lwp ) THEN
@@ -88 +91 @@
          WRITE(numout,*)'~~~~~~~'
       ENDIF
-      !                      
+      !
       ! retrieve thickness from volume for landfast param. and UMx advection scheme
       WHERE( a_i(:,:,:) >= epsi20 )
@@ -106 +109 @@
       END WHERE
       !
+      IF( ln_landfast_L16 ) THEN
+         CALL fld_read( kt, 1, sf_icbmsk )
+         icb_mask(:,:) = sf_icbmsk(1)%fnow(:,:,1)
+      ENDIF
       !
       SELECT CASE( nice_dyn )          !-- Set which dynamics is running
@@ -111 +118 @@
       CASE ( np_dynALL )           !==  all dynamical processes  ==!
          !
-         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology  
+         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology
          CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice
-         CALL ice_dyn_rdgrft( kt )                                          ! -- ridging/rafting 
+         CALL ice_dyn_rdgrft( kt )                                          ! -- ridging/rafting
          CALL ice_cor       ( kt , 1 )                                      ! -- Corrections
          !
       CASE ( np_dynRHGADV  )       !==  no ridge/raft & no corrections ==!
          !
-         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology  
+         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology
          CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice
          CALL Hpiling                                                       ! -- simple pile-up (replaces ridging/rafting)
@@ -127 +134 @@
          ! --- monotonicity test from Schar & Smolarkiewicz 1996 --- !
          ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length
-         ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 
+         ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s
          DO_2D( 1, 1, 1, 1 )
             zcoefu = ( REAL(jpiglo+1)*0.5_wp - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5_wp - 1._wp )
@@ -149 +156 @@
       !
       !
-      ! diagnostics: divergence at T points 
+      ! diagnostics: divergence at T points
       IF( iom_use('icediv') ) THEN
          !
@@ -172 +179 @@
       !
       ! controls
-      IF( ln_timing )   CALL timing_stop ('icedyn')
+      IF( ln_timing )   CALL timing_stop ('ice_dyn')
       !
    END SUBROUTINE ice_dyn
@@ -216 +223 @@
       !! ** input   :   Namelist namdyn
       !!-------------------------------------------------------------------
-      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
+      INTEGER ::   ios, ioptio, ierror   ! Local integer output status for namelist read
+      !
+      CHARACTER(len=256) ::   cn_dir     ! Root directory for location of ice files
+      TYPE(FLD_N)        ::   sn_icbmsk  ! informations about the grounded icebergs field to be read
       !!
       NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice,  &
          &             rn_ishlat ,                                                           &
-         &             ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile
+         &             ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile, &
+         &             sn_icbmsk, cn_dir
       !!-------------------------------------------------------------------
       !
@@ -248 +259 @@
       ENDIF
       !                             !== set the choice of ice dynamics ==!
-      ioptio = 0 
+      ioptio = 0
       !      !--- full dynamics                               (rheology + advection + ridging/rafting + correction)
       IF( ln_dynALL    ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynALL       ;   ENDIF
@@ -269 +280 @@
       IF( .NOT.ln_landfast_L16 )   tau_icebfr(:,:) = 0._wp
       !
+      !                                      !--- allocate and fill structure for grounded icebergs mask
+      IF( ln_landfast_L16 ) THEN
+         ALLOCATE( sf_icbmsk(1), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'ice_dyn_init: unable to allocate sf_icbmsk structure' ) ; RETURN
+         ENDIF
+         !
+         CALL fld_fill( sf_icbmsk, (/ sn_icbmsk /), cn_dir, 'ice_dyn_init',   &
+            &                                               'landfast ice is a function of read grounded icebergs', 'icedyn' )
+         !
+         ALLOCATE( sf_icbmsk(1)%fnow(jpi,jpj,1) )
+         IF( sf_icbmsk(1)%ln_tint )   ALLOCATE( sf_icbmsk(1)%fdta(jpi,jpj,1,2) )
+         IF( TRIM(sf_icbmsk(1)%clrootname) == 'NOT USED' ) sf_icbmsk(1)%fnow(:,:,1) = 0._wp   ! not used field  (set to 0)
+      ELSE
+         icb_mask(:,:) = 0._wp
+      ENDIF
+      !                                      !--- other init
       CALL ice_dyn_rdgrft_init          ! set ice ridging/rafting parameters
       CALL ice_dyn_rhg_init             ! set ice rheology parameters
@@ -279 +307 @@
    !!   Default option         Empty module           NO SI3 sea-ice model
    !!----------------------------------------------------------------------
-#endif 
+#endif
 
    !!======================================================================