Changeset 14219 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynspg_ts.F90

Timestamp:

2020-12-18T18:52:57+01:00 (4 years ago)

Author:

mcastril

Message:

Add Mixed Precision support by Oriol Tintó

File:

• NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynspg_ts.F90 (modified) (9 diffs)

NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynspg_ts.F90

@@ -75 +75 @@
    REAL(wp),SAVE :: rDt_e       ! Barotropic time step
    !
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   wgtbtp1, wgtbtp2   ! 1st & 2nd weights used in time filtering of barotropic fields
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:)   :: wgtbtp1   ! 1st 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   :: wgtbtp2   ! & 2nd weights used in time filtering of barotropic fields
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zwz                ! ff_f/h at F points
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ftnw, ftne         ! triad of coriolis parameter
@@ -88 +89 @@
 #  include "do_loop_substitute.h90"
 #  include "domzgr_substitute.h90"
+#  include "single_precision_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -144 +146 @@
       INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index
       INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation
-      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh, puu_b, pvv_b  ! SSH and barotropic velocities at main time levels
+      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation
+      REAL(dp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh                 ! SSH
+      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  puu_b, pvv_b         ! barotropic velocities at main time levels
       !
       INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices
@@ -152 +155 @@
       INTEGER  ::   noffset               ! local integers  : time offset for bdy update
       REAL(wp) ::   r1_Dt_b, z1_hu, z1_hv          ! local scalars
-      REAL(wp) ::   za0, za1, za2, za3              !   -      -
+      REAL(dp)  :: za1
+      REAL(wp) ::   za0, za2, za3              !   -      -
       REAL(wp) ::   zztmp, zldg               !   -      -
-      REAL(wp) ::   zhu_bck, zhv_bck, zhdiv         !   -      -
+      REAL(dp)  :: zhdiv
+      REAL(wp) ::   zhu_bck, zhv_bck         !   -      -
       REAL(wp) ::   zun_save, zvn_save              !   -      -
-      REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg, zssh_frc
+      REAL(dp), DIMENSION(jpi,jpj)  :: zssh_frc
+      REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg
       REAL(wp), DIMENSION(jpi,jpj) :: zv_trd, zv_frc, zv_spg
       REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhtp2_e
@@ -274 +280 @@
       !                                   !=  Add bottom stress contribution from baroclinic velocities  =!
       !                                   !  -----------------------------------------------------------  !
-      CALL dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients
+      CALL dyn_drg_init( Kbb, Kmm, CASTWP(puu), CASTWP(pvv), puu_b ,pvv_b, zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients
       !
       !                                   !=  Add atmospheric pressure forcing  =!
@@ -520 +526 @@
          END_2D
          !
+#if defined key_single
+         CALL lbc_lnk      ( 'dynspg_ts', ssha_e, 'T', 1._wp )
+         CALL lbc_lnk_multi( 'dynspg_ts', zhU, 'U', -1._wp,  zhV, 'V', -1._wp )
+#else
          CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp )
+#endif
          !
          ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T)
@@ -680 +691 @@
          ENDIF
          !                                                 ! open boundaries
-         IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e )
+         IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, CASTWP(ssha_e) )
 #if defined key_agrif                                                           
          IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jn )  ! Agrif
@@ -840 +851 @@
       LOGICAL, INTENT(in) ::   ll_fw      ! forward time splitting =.true.
       INTEGER, INTENT(inout) :: jpit      ! cycle length    
-      REAL(wp), DIMENSION(3*nn_e), INTENT(inout) ::   zwgt1, & ! Primary weights
-                                                         zwgt2    ! Secondary weights
+      REAL(dp), DIMENSION(3*nn_e), INTENT(inout) ::   zwgt1    ! Primary weights
+      REAL(wp), DIMENSION(3*nn_e), INTENT(inout) ::   zwgt2    ! Secondary weights
       
       INTEGER ::  jic, jn, ji                      ! temporary integers
-      REAL(wp) :: za1, za2
+      REAL(dp)  :: za1
+      REAL(wp) :: za2
       !!----------------------------------------------------------------------
 
@@ -1441 +1453 @@
       INTEGER ,INTENT(in   ) ::   jn                   ! index of sub time step
       LOGICAL ,INTENT(in   ) ::   ll_init              !
-      REAL(wp),INTENT(  out) ::   za0, za1, za2, za3   ! Half-step back interpolation coefficient
+      REAL(dp),INTENT(  out)  :: za1
+      REAL(wp),INTENT(  out) ::   za0, za2, za3   ! Half-step back interpolation coefficient
       !
       REAL(wp) ::   zepsilon, zgamma                   !   -      -