Changeset 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceitd.F90

Timestamp:

2020-05-14T21:46:00+02:00 (4 years ago)

Author:

smueller

Message:

Synchronizing with ^{/NEMO/trunk@12925 (ticket #2170)}

Location:

NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

Files:

• . (modified) (1 prop)
• src/ICE/iceitd.F90 (modified) (9 diffs)

NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

@@ -6 +6 @@
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@HEAD         sette

@@ -6 +6 @@
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@HEAD         sette

NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceitd.F90

@@ -48 +48 @@
    REAL(wp), DIMENSION(0:100) ::   rn_catbnd    ! ice categories bounds
    !
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -96 +98 @@
       !
       npti = 0   ;   nptidx(:) = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF ( at_i(ji,jj) > epsi10 ) THEN
-               npti = npti + 1
-               nptidx( npti ) = (jj - 1) * jpi + ji
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF ( at_i(ji,jj) > epsi10 ) THEN
+            npti = npti + 1
+            nptidx( npti ) = (jj - 1) * jpi + ji
+         ENDIF
+      END_2D
       
       !-----------------------------------------------------------------------------------------------
@@ -211 +211 @@
                CALL itd_glinear( zhb0(1:npti)  , zhb1(1:npti)  , h_ib_1d(1:npti)  , a_i_1d(1:npti)  ,  &   ! in
                   &              g0  (1:npti,1), g1  (1:npti,1), hL     (1:npti,1), hR    (1:npti,1)   )   ! out
-                  !
+               !
                ! Area lost due to melting of thin ice
                DO ji = 1, npti
@@ -218 +218 @@
                      !
                      zdh0 =  h_i_1d(ji) - h_ib_1d(ji)                
-                     IF( zdh0 < 0.0 ) THEN      !remove area from category 1
+                     IF( zdh0 < 0.0 ) THEN      ! remove area from category 1
                         zdh0 = MIN( -zdh0, hi_max(1) )
                         !Integrate g(1) from 0 to dh0 to estimate area melted
@@ -226 +226 @@
                            zx1    = zetamax
                            zx2    = 0.5 * zetamax * zetamax 
-                           zda0   = g1(ji,1) * zx2 + g0(ji,1) * zx1                        ! ice area removed
+                           zda0   = g1(ji,1) * zx2 + g0(ji,1) * zx1                ! ice area removed
                            zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i                
-                           zda0   = MIN( zda0, zdamax )                                                  ! ice area lost due to melting 
-                           !     of thin ice (zdamax > 0)
+                           zda0   = MIN( zda0, zdamax )                            ! ice area lost due to melting of thin ice (zdamax > 0)
                            ! Remove area, conserving volume
                            h_i_1d(ji) = h_i_1d(ji) * a_i_1d(ji) / ( a_i_1d(ji) - zda0 )
@@ -349 +348 @@
       DO ji = 1, npti
          !
-         IF( paice(ji) > epsi10  .AND. phice(ji) > 0._wp )  THEN
+         IF( paice(ji) > epsi10  .AND. phice(ji) > epsi10 )  THEN
             !
             ! Initialize hL and hR
@@ -598 +597 @@
          !                    !---------------------------------------
          npti = 0   ;   nptidx(:) = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN
-                  npti = npti + 1
-                  nptidx( npti ) = (jj - 1) * jpi + ji                  
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN
+               npti = npti + 1
+               nptidx( npti ) = (jj - 1) * jpi + ji                  
+            ENDIF
+         END_2D
          !
 !!clem   CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) )
@@ -639 +636 @@
          !                    !-----------------------------------------
          npti = 0 ; nptidx(:) = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN
-                  npti = npti + 1
-                  nptidx( npti ) = (jj - 1) * jpi + ji                  
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN
+               npti = npti + 1
+               nptidx( npti ) = (jj - 1) * jpi + ji                  
+            ENDIF
+         END_2D
          !
          CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok
@@ -687 +682 @@
       !!------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )      ! Namelist namitd in reference namelist : Parameters for ice
       READ  ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namitd in reference namelist' )
-      REWIND( numnam_ice_cfg )      ! Namelist namitd in configuration namelist : Parameters for ice
       READ  ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namitd in configuration namelist' )

@@ -6 +6 @@
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@HEAD         sette