Changeset 13226 for NEMO/trunk/src/OCE/ZDF

Timestamp:

2020-07-02T16:24:31+02:00 (4 years ago)

Author:

orioltp

Message:

Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk

Location:

NEMO/trunk/src/OCE/ZDF

Files:

• zdfddm.F90 (modified) (1 diff)
• zdfosm.F90 (modified) (4 diffs)
• zdfphy.F90 (modified) (1 diff)
• zdftke.F90 (modified) (1 diff)

NEMO/trunk/src/OCE/ZDF/zdfddm.F90

@@ -77 +77 @@
       REAL(wp) ::   zaw, zbw, zrw   ! local scalars
       REAL(wp) ::   zdt, zds
-      REAL(wp) ::   zinr, zrr       !   -      -
-      REAL(wp) ::   zavft, zavfs    !   -      -
+      REAL(wp) ::   zinr            !   -      -
+      REAL(dp) ::         zrr       !   -      -
+      REAL(wp) ::   zavft           !   -      -
+      REAL(dp) ::          zavfs    !   -      -
       REAL(wp) ::   zavdt, zavds    !   -      -
       REAL(wp), DIMENSION(jpi,jpj) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3

NEMO/trunk/src/OCE/ZDF/zdfosm.F90

@@ -1218 +1218 @@
 
        ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids
-       CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1. )
+       CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp )
 
        ! GN 25/8: need to change tmask --> wmask
@@ -1227 +1227 @@
      END_3D
       ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid  (sign unchanged), needed to caclulate gham[uv] on u and v grids
-     CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1. , p_avm, 'W', 1.,   &
-      &                  ghamu, 'W', 1. , ghamv, 'W', 1. )
+     CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp,   &
+      &                  ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp )
        DO_3D_00_00( 2, jpkm1 )
             ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) &
@@ -1241 +1241 @@
         ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged)
         ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign unchanged)
-        CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1. , ghams, 'W', 1.,   &
-         &                  ghamu, 'U', 1. , ghamv, 'V', 1. )
+        CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1.0_wp , ghams, 'W', 1.0_wp,   &
+         &                  ghamu, 'U', 1.0_wp , ghamv, 'V', 1.0_wp )
 
        IF(ln_dia_osm) THEN
@@ -1282 +1282 @@
       END IF
       ! Lateral boundary conditions on p_avt  (sign unchanged)
-      CALL lbc_lnk( 'zdfosm', p_avt(:,:,:), 'W', 1. )
+      CALL lbc_lnk( 'zdfosm', p_avt(:,:,:), 'W', 1.0_wp )
       !
    END SUBROUTINE zdf_osm

NEMO/trunk/src/OCE/ZDF/zdfphy.F90

@@ -302 +302 @@
       !                                         !* Lateral boundary conditions (sign unchanged)
       IF( l_zdfsh2 ) THEN
-         CALL lbc_lnk_multi( 'zdfphy', avm_k, 'W', 1. , avt_k, 'W', 1.,   &
-            &                avm  , 'W', 1. , avt  , 'W', 1. , avs , 'W', 1. )
+         CALL lbc_lnk_multi( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   &
+            &                avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp )
       ELSE
-         CALL lbc_lnk_multi( 'zdfphy', avm  , 'W', 1. , avt  , 'W', 1. , avs , 'W', 1. )
+         CALL lbc_lnk_multi( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp )
       ENDIF
       !
       IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases)
-         IF( ln_isfcav ) THEN   ;  CALL lbc_lnk_multi( 'zdfphy', rCdU_top, 'T', 1. , rCdU_bot, 'T', 1. )   ! top & bot drag
-         ELSE                   ;  CALL lbc_lnk      ( 'zdfphy', rCdU_bot, 'T', 1. )                       ! bottom drag only
+         IF( ln_isfcav ) THEN   ;  CALL lbc_lnk_multi( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag
+         ELSE                   ;  CALL lbc_lnk      ( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                       ! bottom drag only
          ENDIF
       ENDIF

NEMO/trunk/src/OCE/ZDF/zdftke.F90

@@ -310 +310 @@
          DO_3D_00_00( 2, jpkm1 )
             !                             ! local Richardson number
-            zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear )
+            IF (rn2b(ji,jj,jk) <= 0.0_wp) then
+                zri = 0.0_wp
+            ELSE
+                zri = rn2b(ji,jj,jk) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear )
+            ENDIF
             !                             ! inverse of Prandtl number
             apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  )