Changeset 13257 for NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfcpl.F90

Timestamp:

2020-07-07T11:00:57+02:00 (4 years ago)

Author:

orioltp

Message:

Updated with trunk at r13245 and small change allocating variables in icb_oce.F90.

File:

• NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfcpl.F90 (modified) (9 diffs)

NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfcpl.F90

@@ -15 +15 @@
    USE isfutils, ONLY : debug
    USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine
+#if ! defined key_qco
    USE domvvl  , ONLY: dom_vvl_zgr      ! vertical scale factor interpolation
+#else
+   USE domqco   , ONLY: dom_qco_zgr      ! vertical scale factor interpolation
+#endif
    USE domngb  , ONLY: dom_ngb          ! find the closest grid point from a given lon/lat position
    !
@@ -43 +47 @@
    !! * Substitutions
 #  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -112 +117 @@
       vv   (:,:,:,Kbb)   = vv   (:,:,:,Kmm)
       ssh (:,:,Kbb)     = ssh (:,:,Kmm)
+#if ! defined key_qco
       e3t(:,:,:,Kbb)   = e3t(:,:,:,Kmm)
- 
+#endif 
       ! prepare writing restart
       IF( lwxios ) THEN
@@ -135 +141 @@
       INTEGER, INTENT(in) :: Kmm    ! ocean time level index
       !!----------------------------------------------------------------------
+      INTEGER :: jk                               ! loop index
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw  ! e3t , e3u, e3v !!st patch to use substitution
+      !!----------------------------------------------------------------------
+      !
+      DO jk = 1, jpk
+         ze3t(:,:,jk) = e3t(:,:,jk,Kmm)
+         ze3u(:,:,jk) = e3u(:,:,jk,Kmm)
+         ze3v(:,:,jk) = e3v(:,:,jk,Kmm)
+         !
+         zgdepw(:,:,jk) = gdepw(:,:,jk,Kmm)
+      END DO 
       !
       IF( lwxios ) CALL iom_swap( cwxios_context )
       CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask , ldxios = lwxios )
       CALL iom_rstput( kt, nitrst, numrow, 'ssmask' , ssmask, ldxios = lwxios )
-      CALL iom_rstput( kt, nitrst, numrow, 'e3t_n'  , e3t(:,:,:,Kmm) , ldxios = lwxios )
-      CALL iom_rstput( kt, nitrst, numrow, 'e3u_n'  , e3u(:,:,:,Kmm) , ldxios = lwxios )
-      CALL iom_rstput( kt, nitrst, numrow, 'e3v_n'  , e3v(:,:,:,Kmm) , ldxios = lwxios )
-      CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw(:,:,:,Kmm) , ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, 'e3t_n'  , ze3t , ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, 'e3u_n'  , ze3u , ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, 'e3v_n'  , ze3v , ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', zgdepw , ldxios = lwxios )
       IF( lwxios ) CALL iom_swap( cxios_context )
       !
@@ -209 +226 @@
       IF(lwp) write(numout,*) 'isfcpl_ssh : recompute scale factor from ssh (new wet cell,Kmm)'
       IF(lwp) write(numout,*) '~~~~~~~~~~~'
+#if ! defined key_qco
       DO jk = 1, jpk
-         e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) &
-             &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
-             &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk))
+         e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + (ht_0(:,:) + ssh(:,:,Kmm)) * r1_ht_0(:,:) )
       END DO
       e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
       CALL dom_vvl_zgr(Kbb, Kmm, Kaa)
+#else
+      CALL dom_qco_zgr(Kbb, Kmm, Kaa)
+#endif
       !
    END SUBROUTINE isfcpl_ssh
@@ -400 +419 @@
          ! 1.1: get volume flux before coupling (>0 out)
          DO_2D_00_00
-            zqvolb(ji,jj,jk) =  (   e2u(ji,jj) * ze3u_b(ji,jj,jk) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj  ) * ze3u_b(ji-1,jj  ,jk) * uu(ji-1,jj  ,jk,Kmm)    &
-               &                  + e1v(ji,jj) * ze3v_b(ji,jj,jk) * vv(ji,jj,jk,Kmm) - e1v(ji  ,jj-1) * ze3v_b(ji  ,jj-1,jk) * vv(ji  ,jj-1,jk,Kmm)  ) &
+            zqvolb(ji,jj,jk) =    &
+               &  (   e2u(ji  ,jj  ) * ze3u_b(ji  ,jj  ,jk) * uu(ji  ,jj  ,jk,Kmm)      &
+               &    - e2u(ji-1,jj  ) * ze3u_b(ji-1,jj  ,jk) * uu(ji-1,jj  ,jk,Kmm)      &
+               &    + e1v(ji  ,jj  ) * ze3v_b(ji  ,jj  ,jk) * vv(ji  ,jj  ,jk,Kmm)      &
+               &    - e1v(ji  ,jj-1) * ze3v_b(ji  ,jj-1,jk) * vv(ji  ,jj-1,jk,Kmm)  )   &
                &                * ztmask_b(ji,jj,jk)
          END_2D
@@ -412 +434 @@
          ! compute volume flux divergence after coupling
          DO_2D_00_00
-            zqvoln(ji,jj,jk) = (   e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj  ) * e3u(ji-1,jj  ,jk,Kmm) * uu(ji-1,jj  ,jk,Kmm)    &
-               &                 + e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) - e1v(ji  ,jj-1) * e3v(ji  ,jj-1,jk,Kmm) * vv(ji  ,jj-1,jk,Kmm)  ) &
+            zqvoln(ji,jj,jk) =   &
+               &  (   e2u(ji  ,jj  ) * e3u(ji  ,jj  ,jk,Kmm) * uu(ji  ,jj  ,jk,Kmm)    &
+               &    - e2u(ji-1,jj  ) * e3u(ji-1,jj  ,jk,Kmm) * uu(ji-1,jj  ,jk,Kmm)    &
+               &    + e1v(ji  ,jj  ) * e3v(ji  ,jj  ,jk,Kmm) * vv(ji  ,jj  ,jk,Kmm)    &
+               &    - e1v(ji  ,jj-1) * e3v(ji  ,jj-1,jk,Kmm) * vv(ji  ,jj-1,jk,Kmm)  ) &
                &               * tmask(ji,jj,jk)
          END_2D
@@ -523 +548 @@
 
                ! volume diff
-               zdvol = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) - ze3t_b(ji,jj,jk) * ztmask_b(ji,jj,jk)
+               zdvol =   e3t  (ji,jj,jk,Kmm) *  tmask  (ji,jj,jk)   &
+                  &   - ze3t_b(ji,jj,jk    ) * ztmask_b(ji,jj,jk)
 
                ! heat diff
@@ -555 +581 @@
             DO ji = nldi,nlei
                jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ;
-               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp)
+               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN 
+                  nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp)
+               ENDIF
             ENDDO
          ENDDO