Changeset 4869 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

Timestamp:

2014-11-18T16:43:44+01:00 (10 years ago)

Author:

clem

Message:

LIM3: removing useless ice types

File:

• trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90 (modified) (12 diffs)

trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

@@ -6 +6 @@
    !! History :   -   !          (W. H. Lipscomb and E.C. Hunke) CICE (c) original code
    !!            3.0  ! 2005-12  (M. Vancoppenolle) adaptation to LIM-3
-   !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age and types
+   !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age
    !!             -   ! 2007-04  (M. Vancoppenolle) Mass conservation checked
    !!----------------------------------------------------------------------
@@ -66 +66 @@
       INTEGER, INTENT(in) ::   kt   ! time step index
       !
-      INTEGER ::   ji,jj, jk, jl, ja, jm, jbnd1, jbnd2   ! ice types    dummy loop index         
+      INTEGER ::   ji, jj, jk, jl   ! dummy loop index         
       !
       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
@@ -86 +86 @@
       ! Given thermodynamic growth rates, transport ice between
       ! thickness categories.
-      DO jm = 1, jpm
-         jbnd1 = ice_cat_bounds(jm,1)
-         jbnd2 = ice_cat_bounds(jm,2)
-         IF( ice_ncat_types(jm) > 1 )   CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt )
-      END DO
+      IF( jpl > 1 )   CALL lim_itd_th_rem( 1, jpl, kt )
       !
       CALL lim_var_glo2eqv    ! only for info
@@ -123 +119 @@
             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ')
             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ')
-            DO ja = 1, nlay_i
+            DO jk = 1, nlay_i
                CALL prt_ctl_info(' ')
-               CALL prt_ctl_info(' - Layer : ', ivar1=ja)
+               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
                CALL prt_ctl_info('   ~~~~~~~')
-               CALL prt_ctl(tab2d_1=t_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : t_i      : ')
-               CALL prt_ctl(tab2d_1=e_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : e_i      : ')
+               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ')
+               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ')
             END DO
          END DO
@@ -140 +136 @@
    !
 
-   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, ntyp, kt )
+   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt )
       !!------------------------------------------------------------------
       !!                ***  ROUTINE lim_itd_th_rem ***
@@ -153 +149 @@
       INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point
       INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied
-      INTEGER , INTENT (in) ::   ntyp    ! Number of the type used
       INTEGER , INTENT (in) ::   kt      ! Ocean time step 
       !
@@ -218 +213 @@
          WRITE(numout,*) ' klbnd :       ', klbnd
          WRITE(numout,*) ' kubnd :       ', kubnd
-         WRITE(numout,*) ' ntyp  :       ', ntyp 
       ENDIF
 
@@ -321 +315 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zhb0(ji,jj) = hi_max_typ(0,ntyp) ! 0eme
-            zhb1(ji,jj) = hi_max_typ(1,ntyp) ! 1er
+            zhb0(ji,jj) = hi_max(0) ! 0eme
+            zhb1(ji,jj) = hi_max(1) ! 1er
 
             zhbnew(ji,jj,klbnd-1) = 0._wp
@@ -382 +376 @@
             ELSE ! if ice accretion
                ! ji, a_i > epsi10; zdh0 > 0
-               IF ( ntyp .EQ. 1 ) zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 
+               zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 
                ! zhbnew was 0, and is shifted to the right to account for thin ice
                ! growth in openwater (F0 = f1)
-               IF ( ntyp .NE. 1 ) zhbnew(ii,ij,0) = 0 
-               ! in other types there is
-               ! no open water growth (F0 = 0)
             ENDIF ! zdh0 
 
@@ -839 +830 @@
    
 
-   SUBROUTINE lim_itd_th_reb( klbnd, kubnd, ntyp )
+   SUBROUTINE lim_itd_th_reb( klbnd, kubnd )
       !!------------------------------------------------------------------
       !!                ***  ROUTINE lim_itd_th_reb ***
@@ -849 +840 @@
       INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point
       INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied
-      INTEGER , INTENT (in) ::   ntyp    ! number of the ice type involved in the rebinning process
       !
       INTEGER ::   ji,jj, jl   ! dummy loop indices
@@ -889 +879 @@
 
       !------------------------------------------------------------------------------
-      ! 2) Make sure thickness of cat klbnd is at least hi_max_typ(klbnd)
+      ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd)
       !------------------------------------------------------------------------------
       DO jj = 1, jpj 
          DO ji = 1, jpi 
             IF( a_i(ji,jj,klbnd) > epsi10 ) THEN
-               IF( ht_i(ji,jj,klbnd) <= hi_max_typ(0,ntyp) .AND. hi_max_typ(0,ntyp) > 0._wp ) THEN
-                  a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max_typ(0,ntyp) 
-                  ht_i(ji,jj,klbnd) = hi_max_typ(0,ntyp)
+               IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN
+                  a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max(0) 
+                  ht_i(ji,jj,klbnd) = hi_max(0)
                ENDIF
             ENDIF