Changeset 13374 for NEMO/branches/2020/tickets_icb_1900/src/OCE/ICB/icbdyn.F90

Timestamp:

2020-08-03T15:48:40+02:00 (4 years ago)

Author:

mathiot

Message:

ticket #1900: fix issue about mask management in icb_utl_bilin_3d_h; add option to ground icb if icb bottom lvl hit oce bottom lvl

File:

• NEMO/branches/2020/tickets_icb_1900/src/OCE/ICB/icbdyn.F90 (modified) (8 diffs)

NEMO/branches/2020/tickets_icb_1900/src/OCE/ICB/icbdyn.F90

@@ -98 +98 @@
          zyj2 = zyj1 + zdt_2 * zv1          ;   zvvel2 = zvvel1 + zdt_2 * zay1
          !
-         CALL icb_ground( zxi2, zxi1, zu1,   &
-            &             zyj2, zyj1, zv1, ll_bounced )
+         CALL icb_ground( berg, zxi2, zxi1, zu1,   &
+            &                   zyj2, zyj1, zv1, ll_bounced )
 
          !                                         !**   A2 = A(X2,V2)
@@ -114 +114 @@
          zyj3  = zyj1  + zdt_2 * zv2   ;   zvvel3 = zvvel1 + zdt_2 * zay2
          !
-         CALL icb_ground( zxi3, zxi1, zu3,   &
-            &                zyj3, zyj1, zv3, ll_bounced )
+         CALL icb_ground( berg, zxi3, zxi1, zu3,   &
+            &                   zyj3, zyj1, zv3, ll_bounced )
 
          !                                         !**   A3 = A(X3,V3)
@@ -130 +130 @@
          zyj4 = zyj1 + zdt * zv3   ;   zvvel4 = zvvel1 + zdt * zay3
 
-         CALL icb_ground( zxi4, zxi1, zu4,   &
-            &             zyj4, zyj1, zv4, ll_bounced )
+         CALL icb_ground( berg, zxi4, zxi1, zu4,   &
+            &                   zyj4, zyj1, zv4, ll_bounced )
 
          !                                         !**   A4 = A(X4,V4)
@@ -149 +149 @@
          zvvel_n = pt%vvel + zdt_6 * (  zay1 + 2.*(zay2 + zay3) + zay4 )
 
-         CALL icb_ground( zxi_n, zxi1, zuvel_n,   &
-            &             zyj_n, zyj1, zvvel_n, ll_bounced )
+         CALL icb_ground( berg, zxi_n, zxi1, zuvel_n,   &
+            &                   zyj_n, zyj1, zvvel_n, ll_bounced )
 
          pt%uvel = zuvel_n                        !** save in berg structure
@@ -164 +164 @@
 
 
-   SUBROUTINE icb_ground( pi, pi0, pu,   &
-      &                   pj, pj0, pv, ld_bounced )
+   SUBROUTINE icb_ground( berg, pi, pi0, pu,   &
+      &                         pj, pj0, pv, ld_bounced )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE icb_ground  ***
@@ -174 +174 @@
       !!                NB two possibilities available one of which is hard-coded here
       !!----------------------------------------------------------------------
+      TYPE(iceberg ), POINTER, INTENT(in   ) ::   berg             ! berg
+      !
       REAL(wp), INTENT(inout) ::   pi , pj      ! current iceberg position
       REAL(wp), INTENT(in   ) ::   pi0, pj0     ! previous iceberg position
@@ -181 +183 @@
       INTEGER  ::   ii, ii0
       INTEGER  ::   ij, ij0
+      INTEGER  ::   ikb
       INTEGER  ::   ibounce_method
+      !
+      REAL(wp) :: zD 
+      REAL(wp), DIMENSION(jpk) :: ze3t
       !!----------------------------------------------------------------------
       !
@@ -198 +204 @@
       !
       ! assume icb is grounded if tmask(ii,ij,1) or tmask(ii,ij,ikb), depending of the option is not 0
-      !IF ( ln_icb_ground ) THEN
-      !   ! interpol needed data
-      !   CALL icb_utl_interp( pxi, pyj, pe3t=ze3t )   ! 3d velocities
-      !  
-      !   !compute bottom level
-      !   CALL icb_utl_getkb( ikb, ze3t, zD )
-      !
-      !   IF(  tmask(ii,ij,ikb)  /=   0._wp  )   RETURN           ! berg reach a new t-cell, but an ocean one
-      !ELSE
-      IF(  tmask(ii,ij,1)  /=   0._wp  )   RETURN           ! berg reach a new t-cell, but an ocean one
-      !END IF
+      IF ( ln_M2016 .AND. ln_icb_grd ) THEN
+         !
+         ! draught (keel depth)
+         zD = rho_berg_1_oce * berg%current_point%thickness
+         !
+         ! interpol needed data
+         CALL icb_utl_interp( pi, pj, pe3t=ze3t )
+         ! 
+         !compute bottom level
+         CALL icb_utl_getkb( ikb, ze3t, zD )
+         !
+         ! berg reach a new t-cell, but an ocean one
+         IF(  tmask(ii,ij,ikb) /= 0._wp .AND. tmask(ii,ij,1) /= 0._wp ) RETURN
+         !
+      ELSE
+         IF(  tmask(ii,ij,1)  /=   0._wp  )   RETURN           ! berg reach a new t-cell, but an ocean one
+      END IF
       !
       ! From here, berg have reach land: treat grounding/bouncing