Changeset 15540 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfcpl.F90

Timestamp:

2021-11-26T12:27:56+01:00 (2 years ago)

Author:

sparonuz

Message:

Mixed precision version, tested up to 30 years on ORCA2.

File:

• NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfcpl.F90 (modified) (12 diffs)

NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfcpl.F90

@@ -39 +39 @@
       INTEGER ::   jj     ! j global
       INTEGER ::   kk     ! k level
-      REAL(wp)::   dvol   ! volume increment
-      REAL(wp)::   dsal   ! salt increment
-      REAL(wp)::   dtem   ! heat increment
-      REAL(wp)::   lon    ! lon
-      REAL(wp)::   lat    ! lat
+      REAL(dp)::   dvol   ! volume increment
+      REAL(dp)::   dsal   ! salt increment
+      REAL(dp)::   dtem   ! heat increment
+      REAL(dp)::   lon    ! lon
+      REAL(dp)::   lat    ! lat
       INTEGER ::   ngb    ! 0/1 (valid location or not (ie on halo or no neigbourg))
    END TYPE
@@ -138 +138 @@
       !!----------------------------------------------------------------------
       INTEGER :: jk                               ! loop index
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw  ! for qco substitution
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw  ! for qco substitution
       !!----------------------------------------------------------------------
       !
@@ -174 +174 @@
       INTEGER :: jip1, jim1, jjp1, jjm1
       !!
-      REAL(wp):: zsummsk
-      REAL(wp), DIMENSION(jpi,jpj) :: zdssmask, zssmask0, zssmask_b, zssh
+      REAL(dp):: zsummsk
+      REAL(dp), DIMENSION(jpi,jpj) :: zdssmask, zssmask0, zssmask_b, zssh
       !!----------------------------------------------------------------------
       !
@@ -216 +216 @@
       ssh(:,:,Kbb) = ssh(:,:,Kmm)
       !
-      IF ( ln_isfdebug ) CALL debug('isfcpl_ssh: sshn',CASTWP(ssh(:,:,Kmm)))
+      IF ( ln_isfdebug ) CALL debug('isfcpl_ssh: sshn',ssh(:,:,Kmm))
       !
       ! recompute the vertical scale factor, depth and water thickness
@@ -247 +247 @@
       INTEGER, INTENT(in) :: Kmm    ! ocean time level index
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: ztmask_b
       !REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pdepw_b                         !! depth w before
       !!
@@ -253 +253 @@
       INTEGER :: jip1, jim1, jjp1, jjm1, jkp1, jkm1
       !!
-      REAL(wp):: zsummsk
-      REAL(wp):: zdz, zdzm1, zdzp1
-      !!
-      REAL(wp), DIMENSION(jpi,jpj)          :: zdmask
-      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask0, zwmaskn
-      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask1, zwmaskb, ztmp3d
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0
+      REAL(dp):: zsummsk
+      REAL(dp):: zdz, zdzm1, zdzp1
+      !!
+      REAL(dp), DIMENSION(jpi,jpj)          :: zdmask
+      REAL(dp), DIMENSION(jpi,jpj,jpk)      :: ztmask0, zwmaskn
+      REAL(dp), DIMENSION(jpi,jpj,jpk)      :: ztmask1, zwmaskb, ztmp3d
+      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0
       !!----------------------------------------------------------------------
       !
@@ -404 +404 @@
       INTEGER :: ikb, ikt
       !!
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zqvolb, zqvoln  ! vol flux div.         before/after coupling
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3u_b, ze3v_b  ! vertical scale factor before/after coupling
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b        ! mask                  before       coupling
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: zqvolb, zqvoln  ! vol flux div.         before/after coupling
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: ze3u_b, ze3v_b  ! vertical scale factor before/after coupling
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: ztmask_b        ! mask                  before       coupling
       !!----------------------------------------------------------------------
       !
@@ -506 +506 @@
       INTEGER, DIMENSION(jpnij) :: nisfl              ! local  number of cell concerned by the wet->dry case
       !
-      REAL(wp) ::   z1_sum, z1_rdtiscpl
-      REAL(wp) ::   zdtem, zdsal, zdvol, zratio       ! tem, sal, vol increment
-      REAL(wp) ::   zlon , zlat                       ! target location
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b    ! mask before
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t_b      ! scale factor before
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zt_b      ! scale factor before
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zs_b      ! scale factor before
+      REAL(dp) ::   z1_sum, z1_rdtiscpl
+      REAL(dp) ::   zdtem, zdsal, zdvol, zratio       ! tem, sal, vol increment
+      REAL(dp) ::   zlon , zlat                       ! target location
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: ztmask_b    ! mask before
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: ze3t_b      ! scale factor before
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: zt_b      ! scale factor before
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: zs_b      ! scale factor before
       !!----------------------------------------------------------------------
 
@@ -630 +630 @@
                   ELSE IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN
                      ! spread correction amoung neigbourg wet cells (vertical direction)
-                     CALL update_isfpts(zisfpts, jisf, ji  , jj  , jk+1, zdvol, zdsal, zdtem, 1.0_wp, 0)
+                     CALL update_isfpts(zisfpts, jisf, ji  , jj  , jk+1, zdvol, zdsal, zdtem, 1.0_dp, 0)
                   ELSE
                      ! need to find where to put correction in later on
-                     CALL update_isfpts(zisfpts, jisf, ji  , jj  , jk  , zdvol, zdsal, zdtem, 1.0_wp, 1)
+                     CALL update_isfpts(zisfpts, jisf, ji  , jj  , jk  , zdvol, zdsal, zdtem, 1.0_dp, 1)
                   END IF
                END IF
@@ -721 +721 @@
       INTEGER,      INTENT(in   ), OPTIONAL :: kfind                       ! 0  target cell already found
       !                                                                    ! 1  target to be determined
-      REAL(wp),     INTENT(in   )           :: pdvol, pdsal, pdtem, pratio ! vol/sal/tem increment
+      REAL(dp),     INTENT(in   )           :: pdvol, pdsal, pdtem, pratio ! vol/sal/tem increment
       !                                                                    ! and ratio in case increment span over multiple cells.
       !!----------------------------------------------------------------------
@@ -752 +752 @@
       !!----------------------------------------------------------------------
       INTEGER , INTENT(in) :: ki, kj, kk, kfind        ! target point indices
-      REAL(wp), INTENT(in) :: plon, plat               ! target point lon/lat
-      REAL(wp), INTENT(in) :: pvolinc, pteminc,psalinc ! correction increment for vol/temp/salt
+      REAL(dp), INTENT(in) :: plon, plat               ! target point lon/lat
+      REAL(dp), INTENT(in) :: pvolinc, pteminc,psalinc ! correction increment for vol/temp/salt
       !!----------------------------------------------------------------------
       INTEGER :: jj, ji, iig, ijg
@@ -760 +760 @@
       ! define global indice of correction location
       iig = ki ; ijg = kj
-      IF ( kfind == 1 ) CALL dom_ngb( plon, plat, iig, ijg,'T', kk)
+      IF ( kfind == 1 ) CALL dom_ngb( CASTSP(plon), CASTSP(plat), iig, ijg,'T', kk)
       !
       ! fill the correction array