Changeset 13374 for NEMO/branches/2020/tickets_icb_1900/src/OCE/ICB/icbutl.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/icbutl.F90 (modified) (5 diffs)

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

@@ -164 +164 @@
       REAL(wp), DIMENSION(4) :: zmskF, zmskU, zmskV, zmskT ! mask
       REAL(wp), DIMENSION(4) :: zwTp, zmskTp, zwTm, zmskTm
+      REAL(wp), DIMENSION(4,jpk) :: zw1d
       INTEGER                :: iiT, iiU, iiV, iiF, ijT, ijU, ijV, ijF ! bottom left corner
       INTEGER                :: iiTp, iiTm, ijTp, ijTm
@@ -225 +226 @@
       ! 3d interpolation
       IF ( PRESENT(puoce) .AND. PRESENT(pvoce) ) THEN
-         puoce(:) = icb_utl_bilin_h( uoce_e , iiU, ijU, zwU )
-         pvoce(:) = icb_utl_bilin_h( voce_e , iiV, ijV, zwV )
+         ! no need to mask as 0 is a valid data for land
+         zw1d(1,:) = zwU(1) ; zw1d(2,:) = zwU(2) ; zw1d(3,:) = zwU(3) ; zw1d(4,:) = zwU(4) ;
+         puoce(:) = icb_utl_bilin_h( uoce_e , iiU, ijU, zw1d )
+
+         zw1d(1,:) = zwV(1) ; zw1d(2,:) = zwV(2) ; zw1d(3,:) = zwV(3) ; zw1d(4,:) = zwV(4) ;
+         pvoce(:) = icb_utl_bilin_h( voce_e , iiV, ijV, zw1d )
       END IF
-      IF ( PRESENT(ptoce) ) ptoce(:) = icb_utl_bilin_h( toce_e , iiT, ijT, zwT * zmskT )
+
+      IF ( PRESENT(ptoce) ) THEN
+         ! for temperature we need to mask the weight properly
+         ! no need of extra halo as it is a T point variable
+         zw1d(1,:) = tmask(iiT  ,ijT  ,:) * zwT(1) * zmskT(1)
+         zw1d(2,:) = tmask(iiT+1,ijT  ,:) * zwT(2) * zmskT(2)
+         zw1d(3,:) = tmask(iiT  ,ijT+1,:) * zwT(3) * zmskT(3)
+         zw1d(4,:) = tmask(iiT+1,ijT+1,:) * zwT(4) * zmskT(4)
+         ptoce(:) = icb_utl_bilin_h( toce_e , iiT, ijT, zw1d )
+      END IF
+      !
       IF ( PRESENT(pe3t)  ) pe3t(:)  = e3t_e(iiT,ijT,:)    ! as in Nacho tarball need to be fix once we are able to reproduce Nacho results
       !
@@ -300 +315 @@
          IF ( ierr > 0 ) THEN
             WRITE(numout,*) 'bottom left corner T point out of bound'
-            WRITE(numout,*) kii, mig( 1 ), mig(jpi)
-            WRITE(numout,*) kij, mjg( 1 ), mjg(jpj)
+            WRITE(numout,*) pi, kii, mig( 1 ), mig(jpi)
+            WRITE(numout,*) pj, kij, mjg( 1 ), mjg(jpj)
+            WRITE(numout,*) pmsk
             CALL ctl_stop('STOP','icb_utl_bilin_h: an icebergs coordinates is out of valid range (out of bound error)')
          END IF
@@ -381 +397 @@
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(0:jpi+1,0:jpj+1, jpk), INTENT(in) ::   pfld      ! field to be interpolated
-      REAL(wp), DIMENSION(4)                   , INTENT(in) ::   pw        ! weight
+      REAL(wp), DIMENSION(4,jpk)               , INTENT(in) ::   pw        ! weight
       INTEGER ,                                  INTENT(in) ::   pii, pij  ! bottom left corner
       REAL(wp), DIMENSION(jpk) :: icb_utl_bilin_3d_h
       !
       REAL(wp), DIMENSION(4,jpk) :: zdat ! input data
+      INTEGER :: jk
       !!----------------------------------------------------------------------
       !
@@ -395 +412 @@
       !
       ! compute interpolated value
-      icb_utl_bilin_3d_h(:) = ( zdat(1,:)*pw(1) + zdat(2,:)*pw(2) + zdat(3,:)*pw(3) + zdat(4,:)*pw(4) ) / MAX(1.e-20, pw(1)+pw(2)+pw(3)+pw(4)) 
+      DO jk=1,jpk
+         icb_utl_bilin_3d_h(jk) =   ( zdat(1,jk)*pw(1,jk) + zdat(2,jk)*pw(2,jk) + zdat(3,jk)*pw(3,jk) + zdat(4,jk)*pw(4,jk) ) &
+            &                     /   MAX(1.e-20, pw(1,jk)+pw(2,jk)+pw(3,jk)+pw(4,jk)) 
+      END DO
       !
    END FUNCTION icb_utl_bilin_3d_h