Changeset 8787 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icevar.F90

Timestamp:

2017-11-22T15:38:33+01:00 (6 years ago)

Author:

clem

Message:

for BDY purposes, add the possibility to have a number of categories at the lateral boundaries different than the number of categories in the regional domain

File:

• branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icevar.F90 (modified) (6 diffs)

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

@@ -44 +44 @@
    !!   ice_var_salprof1d : salinity profile in the ice 1D
    !!   ice_var_zapsmall  : remove very small area and volume
-   !!   ice_var_itd       : convert 1-cat to multiple cat
+   !!   ice_var_itd       : convert 1-cat to jpl-cat
+   !!   ice_var_itd2      : convert N-cat to jpl-cat
    !!   ice_var_bv        : brine volume
    !!----------------------------------------------------------------------
@@ -67 +68 @@
    PUBLIC   ice_var_zapsmall
    PUBLIC   ice_var_itd
+   PUBLIC   ice_var_itd2
    PUBLIC   ice_var_bv           
 
@@ -549 +551 @@
       !!-------------------------------------------------------------------
       INTEGER  :: ji, jk, jl             ! dummy loop indices
-      INTEGER  :: ijpij, i_fill, jl0  
+      INTEGER  :: ndim, i_fill, jl0  
       REAL(wp) :: zarg, zV, zconv, zdh, zdv
       REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables
@@ -562 +564 @@
       ! then we check whether the distribution fullfills
       ! volume and area conservation, positivity and ice categories bounds
-      ijpij = SIZE( zhti , 1 )
-      zh_i(1:ijpij,1:jpl) = 0._wp
-      zh_s(1:ijpij,1:jpl) = 0._wp
-      za_i (1:ijpij,1:jpl) = 0._wp
-
-      DO ji = 1, ijpij
+      ndim = SIZE( zhti , 1 )
+      zh_i(1:ndim,1:jpl) = 0._wp
+      zh_s(1:ndim,1:jpl) = 0._wp
+      za_i(1:ndim,1:jpl) = 0._wp
+
+      DO ji = 1, ndim
          
          IF( zhti(ji) > 0._wp ) THEN
@@ -649 +651 @@
       ! Add Snow in each category where za_i is not 0
       DO jl = 1, jpl
-         DO ji = 1, ijpij
+         DO ji = 1, ndim
             IF( za_i(ji,jl) > 0._wp ) THEN
                zh_s(ji,jl) = zh_i(ji,jl) * ( zhts(ji) / zhti(ji) )
@@ -662 +664 @@
       END DO
       !
-    END SUBROUTINE ice_var_itd
-
-
-    SUBROUTINE ice_var_bv
+   END SUBROUTINE ice_var_itd
+
+   SUBROUTINE ice_var_itd2( zhti, zhts, zati, zh_i, zh_s, za_i )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_var_itd2   ***
+      !!
+      !! ** Purpose :  converting N-cat ice to jpl ice categories
+      !!
+      !!                  ice thickness distribution follows a gaussian law
+      !!               around the concentration of the most likely ice thickness
+      !!                           (similar as iceistate.F90)
+      !!
+      !! ** Method:   Iterative procedure
+      !!                
+      !!               1) Fill ice cat that correspond to input thicknesses
+      !!                  Find the lowest(jlmin) and highest(jlmax) cat that are filled
+      !!
+      !!               2) Expand the filling to the cat jlmin-1 and jlmax+1
+      !!                   by removing 25% ice area from jlmin and jlmax (resp.) 
+      !!              
+      !!               3) Expand the filling to the empty cat between jlmin and jlmax 
+      !!                   by a) removing 25% ice area from the lower cat (ascendant loop jlmin=>jlmax)
+      !!                      b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin)
+      !!
+      !! ** Arguments : zhti: N-cat ice thickness
+      !!                zhts: N-cat snow depth
+      !!                zati: N-cat ice concentration
+      !!
+      !! ** Output    : jpl-cat 
+      !!
+      !!  (Example of application: BDY forcings when inputs have N-cat /= jpl)  
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jl, jl1, jl2             ! dummy loop indices
+      INTEGER  ::   ndim, ncat  
+      INTEGER, PARAMETER ::   ztrans = 0.25_wp
+      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables
+      INTEGER , DIMENSION(:,:), ALLOCATABLE   ::   jlfil, jlfil2
+      INTEGER , DIMENSION(:)  , ALLOCATABLE   ::   jlmax, jlmin
+      !!-------------------------------------------------------------------
+      !
+      ndim = SIZE( zhti, 1 )
+      ncat = SIZE( zhti, 2 )
+
+      ! allocate arrays
+      ALLOCATE( jlfil(ndim,jpl), jlfil2(ndim,jpl) ) 
+      ALLOCATE( jlmin(ndim), jlmax(ndim) )
+
+      ! --- initialize output fields to 0 --- !
+      zh_i(1:ndim,1:jpl) = 0._wp
+      zh_s(1:ndim,1:jpl) = 0._wp
+      za_i(1:ndim,1:jpl) = 0._wp
+      !
+      ! --- fill the categories --- !
+      !     find where cat-input = cat-output and fill cat-output fields  
+      jlmax(:) = 0
+      jlmin(:) = 999
+      jlfil(:,:) = 0
+      DO jl1 = 1, jpl
+         DO jl2 = 1, ncat
+            DO ji = 1, ndim
+               IF( hi_max(jl1-1) <= zhti(ji,jl2) .AND. hi_max(jl1) > zhti(ji,jl2) ) THEN
+                  ! fill the right category
+                  zh_i(ji,jl1) = zhti(ji,jl2)
+                  zh_s(ji,jl1) = zhts(ji,jl2)
+                  za_i(ji,jl1) = zati(ji,jl2)
+                  ! record categories that are filled
+                  jlmax(ji) = MAX( jlmax(ji), jl1 )
+                  jlmin(ji) = MIN( jlmin(ji), jl1 )
+                  jlfil(ji,jl1) = jl1
+               ENDIF
+            END DO
+         END DO
+      END DO
+      !
+      ! --- fill the gaps between categories --- !  
+      !     transfer from categories filled at the previous step to the empty ones in between
+      DO ji = 1, ndim
+         jl1 = jlmin(ji)
+         jl2 = jlmax(ji)
+         IF( jl1 > 1 ) THEN
+            ! fill the lower cat (jl1-1)
+            za_i(ji,jl1-1) = ztrans * za_i(ji,jl1)
+            zh_i(ji,jl1-1) = hi_mean(jl1-1)
+            ! remove from cat jl1
+            za_i(ji,jl1  ) = ( 1._wp - ztrans ) * za_i(ji,jl1)
+         ENDIF
+         IF( jl2 < jpl ) THEN
+            ! fill the upper cat (jl2+1)
+            za_i(ji,jl2+1) = ztrans * za_i(ji,jl2)
+            zh_i(ji,jl2+1) = hi_mean(jl2+1)
+            ! remove from cat jl2
+            za_i(ji,jl2  ) = ( 1._wp - ztrans ) * za_i(ji,jl2)
+         ENDIF
+      END DO
+     
+      jlfil2(:,:) = jlfil(:,:) 
+      ! fill categories from low to high
+      DO jl = 2, jpl-1
+         DO ji = 1, ndim
+            IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN
+               ! fill high
+               za_i(ji,jl) = ztrans * za_i(ji,jl-1)
+               zh_i(ji,jl) = hi_mean(jl)
+               jlfil(ji,jl) = jl
+               ! remove low
+               za_i(ji,jl-1) = ( 1._wp - ztrans ) * za_i(ji,jl-1)
+            ENDIF
+         END DO
+      END DO
+
+      ! fill categories from high to low
+      DO jl = jpl-1, 2, -1
+         DO ji = 1, ndim
+            IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN
+               ! fill low
+               za_i(ji,jl) = za_i(ji,jl) + ztrans * za_i(ji,jl+1)
+               zh_i(ji,jl) = hi_mean(jl) 
+               jlfil2(ji,jl) = jl
+               ! remove high
+               za_i(ji,jl+1) = ( 1._wp - ztrans ) * za_i(ji,jl+1)
+            ENDIF
+         END DO
+      END DO
+      
+      ! deallocate arrays
+      DEALLOCATE( jlfil, jlfil2 )
+      DEALLOCATE( jlmin, jlmax )
+
+   END SUBROUTINE ice_var_itd2
+
+
+   SUBROUTINE ice_var_bv
       !!-------------------------------------------------------------------
       !!                ***  ROUTINE ice_var_bv ***