New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14219 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynhpg.F90 – NEMO

Ignore:
Timestamp:
2020-12-18T18:52:57+01:00 (4 years ago)
Author:
mcastril
Message:

Add Mixed Precision support by Oriol Tintó

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynhpg.F90

    r14200 r14219  
    8181#  include "do_loop_substitute.h90" 
    8282#  include "domzgr_substitute.h90" 
     83#  include "single_precision_substitute.h90" 
    8384 
    8485   !!---------------------------------------------------------------------- 
     
    101102      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    102103      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    103       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    104       ! 
    105       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
     104      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     105      ! 
     106      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
    106107      !!---------------------------------------------------------------------- 
    107108      ! 
     
    130131      ENDIF 
    131132      ! 
    132       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' hpg  - Ua: ', mask1=umask,   & 
    133          &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     133      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Krhs)), clinfo1=' hpg  - Ua: ', mask1=umask,   & 
     134         &                                  tab3d_2=CASTWP(pvv(:,:,:,Krhs)), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    134135      ! 
    135136      IF( ln_timing )   CALL timing_stop('dyn_hpg') 
     
    262263      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    263264      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    264       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     265      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    265266      ! 
    266267      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
     
    313314      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    314315      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    315       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     316      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    316317      !! 
    317318      INTEGER  ::   ji, jj, jk                       ! dummy loop indices 
     
    405406      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    406407      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    407       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     408      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    408409      !! 
    409410      INTEGER  ::   ji, jj, jk, jii, jjj           ! dummy loop indices 
     
    542543      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    543544      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    544       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     545      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    545546      !! 
    546547      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
     
    631632      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    632633      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    633       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     634      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    634635      !! 
    635636      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     
    793794      END_3D 
    794795 
    795       CALL lbc_lnk_multi( 'dynhpg', zdrhox, 'U', 1., zdzx, 'U', 1., zdrhoy, 'V', 1., zdzy, 'V', 1. )  
     796      CALL lbc_lnk_multi( 'dynhpg', zdrhox, 'U', 1._wp, zdzx, 'U', 1._wp, zdrhoy, 'V', 1._wp, zdzy, 'V', 1._wp )  
    796797 
    797798      !------------------------------------------------------------------------- 
     
    963964      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    964965      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    965       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     966      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    966967      !! 
    967968      INTEGER  ::   ji, jj, jk, jkk                 ! dummy loop indices 
     
    990991      zcoef0 = - grav 
    991992      znad = 1._wp 
    992       IF( ln_linssh )   znad = 1._wp 
    993       ! 
    994       ! --------------- 
    995       !  Surface pressure gradient to be removed 
    996       ! --------------- 
    997       DO_2D( 0, 0, 0, 0 ) 
    998          zpgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 
    999          zpgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 
    1000       END_2D 
    1001       ! 
     993      IF( ln_linssh )   znad = 0._wp 
     994 
    1002995      IF( ln_wd_il ) THEN 
    1003996         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     
    10571050       ELSEIF( jk < jpkm1 ) THEN 
    10581051          DO jkk = jk+1, jpk 
    1059              zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   & 
    1060                 &                      gde3w(ji,jj,jkk-2), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2)) 
     1052             zrhh(ji,jj,jkk) = interp1(CASTWP(gde3w(ji,jj,jkk  )), CASTWP(gde3w(ji,jj,jkk-1)),   & 
     1053                &                      CASTWP(gde3w(ji,jj,jkk-2)), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2)) 
     1054 
    10611055          END DO 
    10621056       ENDIF 
Note: See TracChangeset for help on using the changeset viewer.