Changeset 5051 for branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

Timestamp:

2015-02-02T18:31:34+01:00 (9 years ago)

Author:

clem

Message:

LIM3 initialization is now called at the same time as other sbc fields

File:

• branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90 (modified) (7 diffs)

branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

@@ -49 +49 @@
 
    PUBLIC   lim_thd        ! called by limstp module
-   PUBLIC   lim_thd_init   ! called by iceini module
+   PUBLIC   lim_thd_init   ! called by sbc_lim_init
 
    !! * Substitutions
@@ -92 +92 @@
       !
       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-      REAL(wp) :: zda
       !
       REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns
@@ -363 +362 @@
             !--------------------------------
 
+            !--------------------------------------!
+            ! --- Ice/Snow Temperature profile --- !
+            !--------------------------------------!
+            CALL lim_thd_dif( 1, nbpb )
+
             !---------------------------------!
-            ! Ice/Snow Temperature profile    !
-            !---------------------------------!
-            CALL lim_thd_dif( 1, nbpb )
-
-            !---------------------------------!
-            ! Ice/Snow thicnkess              !
+            ! --- Ice/Snow thickness ---      !
             !---------------------------------!
             CALL lim_thd_dh( 1, nbpb )    
@@ -377 +376 @@
                                             
             !---------------------------------!
-            ! --- Ice salinity --- !
+            ! --- Ice salinity ---            !
             !---------------------------------!
             CALL lim_thd_sal( 1, nbpb )    
 
             !---------------------------------!
-            ! --- temperature update --- !
+            ! --- temperature update ---      !
             !---------------------------------!
             CALL lim_thd_temp( 1, nbpb )
+
+            !------------------------------------!
+            ! --- lateral melting if monocat --- !
+            !------------------------------------!
+            IF ( ( ( nn_monocat == 1 ) .OR. ( nn_monocat == 4 ) ) .AND. ( jpl == 1 ) ) THEN
+               CALL lim_thd_lam( 1, nbpb )
+            END IF
 
             !--------------------------------
@@ -435 +441 @@
               CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj )
               CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb)   , jpi, jpj )
-
-            IF ( ( ( nn_monocat .EQ. 1 ) .OR. ( nn_monocat .EQ. 4 ) ) .AND. ( jpl == 1 ) ) THEN
-              CALL tab_1d_2d( nbpb, dh_i_melt(:,:,jl) , npb, dh_i_melt_1d(1:nbpb) , jpi, jpj )
-            ENDIF
+              CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj )
+
+!clem            IF ( ( ( nn_monocat == 1 ) .OR. ( nn_monocat == 4 ) ) .AND. ( jpl == 1 ) ) THEN
+!clem              CALL tab_1d_2d( nbpb, dh_i_melt(:,:,jl) , npb, dh_i_melt_1d(1:nbpb) , jpi, jpj )
+!clem            ENDIF
             !
               CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj)
@@ -477 +483 @@
       !----------------------------------
       CALL lim_var_eqv2glo
-
-      !----------------------------------
-      ! 5.X) Lateral melting
-      !----------------------------------
-      IF ( ( ( nn_monocat .EQ. 1 ) .OR. ( nn_monocat .EQ. 4 ) ) .AND. ( jpl == 1 ) ) THEN
-
-         WRITE(numout,*) ' Lateral melting ON '
-
-         ! select points where lateral melting occurs
-         jl = 1
-
-         nbplm = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( ( dh_i_melt(ji,jj,jl)                  .LT.-epsi10 ) .AND.    &
-     &              ( ht_i(ji,jj,jl) - dh_i_melt(ji,jj,jl) .GT. epsi10 ) .AND.    & 
-     &              ( ht_i(ji,jj,jl)                       .GT. epsi10 ) ) THEN     
-                  nbplm   = nbplm  + 1
-                  nplm(nbplm) = (jj - 1) * jpi + ji
-               ENDIF
-            END DO
-         END DO
-
-         IF( nbplm > 0 ) THEN  ! If there is no net melting, do nothing
-
-            ! Move to 1D arrays
-            !-------------------------
-
-            CALL tab_2d_1d( nbplm, a_i_1d      (1:nbplm), a_i(:,:,jl)       , jpi, jpj, nplm(1:nbplm) )
-            CALL tab_2d_1d( nbplm, ht_i_1d     (1:nbplm), ht_i(:,:,jl)      , jpi, jpj, nplm(1:nbplm) )
-            CALL tab_2d_1d( nbplm, dh_i_melt_1d(1:nbplm), dh_i_melt(:,:,jl) , jpi, jpj, nplm(1:nbplm) )
-
-            ! Compute lateral melting (dA = A/2h dh )
-            DO ji = 1, nbplm
-               zda        = a_i_1d(ji) * dh_i_melt_1d(ji) / ( 2._wp * ht_i_1d(ji) )
-               a_i_1d(ji) = a_i_1d(ji) + zda
-            END DO
-
-            ! Move back to 2D arrays
-            !-------------------------
-            CALL tab_1d_2d( nbplm, a_i (:,:,jl)  , nplm, a_i_1d     (1:nbplm)   , jpi, jpj )
-            at_i(:,:) = a_i(:,:,jl)
-
-         ENDIF
-
-      ENDIF
 
       !--------------------------------------------
@@ -602 +562 @@
    END SUBROUTINE lim_thd_temp
 
+   SUBROUTINE lim_thd_lam( kideb, kiut )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_lam *** 
+      !!                 
+      !! ** Purpose :   Lateral melting in case monocategory
+      !!                          ( dA = A/2h dh )
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop
+      INTEGER             ::   ji            ! dummy loop indices
+
+      WRITE(numout,*) ' Lateral melting ON '
+      DO ji = kideb, kiut
+         IF( ht_i_1d(ji) > epsi10 .AND. dh_i_melt_1d(ji) < 0._wp ) THEN     
+            a_i_1d(ji) = MAX( 0._wp, a_i_1d(ji) + a_i_1d(ji) * dh_i_melt_1d(ji) / ( 2._wp * ht_i_1d(ji) ) ) 
+         END IF
+      END DO
+      at_i_1d(:) = a_i_1d(:)
+      
+   END SUBROUTINE lim_thd_lam
+
    SUBROUTINE lim_thd_init
       !!-----------------------------------------------------------------------