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 15540 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/STO – NEMO

Ignore:
Timestamp:
2021-11-26T12:27:56+01:00 (3 years ago)
Author:
sparonuz
Message:

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

Location:
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/STO
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/STO/stopar.F90

    r13295 r15540  
    4040   INTEGER           :: jpsto3d = 0          ! number of 3D stochastic parameters 
    4141 
    42    REAL(wp), PUBLIC, DIMENSION(:,:,:),   ALLOCATABLE :: sto2d      ! 2D stochastic parameters 
    43    REAL(wp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE :: sto3d      ! 3D stochastic parameters 
    44    REAL(wp),         DIMENSION(:,:),     ALLOCATABLE :: sto_tmp    ! temporary workspace 
    45    REAL(wp),         DIMENSION(:,:),     ALLOCATABLE :: sto2d_abc  ! a, b, c parameters (for 2D arrays) 
    46    REAL(wp),         DIMENSION(:,:),     ALLOCATABLE :: sto3d_abc  ! a, b, c parameters (for 3D arrays) 
    47    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_ave  ! mean value (for 2D arrays) 
    48    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_ave  ! mean value (for 3D arrays) 
    49    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_std  ! standard deviation (for 2D arrays) 
    50    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_std  ! standard deviation (for 3D arrays) 
    51    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_lim  ! limitation factor (for 2D arrays) 
    52    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_lim  ! limitation factor (for 3D arrays) 
    53    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_tcor ! time correlation (for 2D arrays) 
    54    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_tcor ! time correlation (for 3D arrays) 
     42   REAL(dp), PUBLIC, DIMENSION(:,:,:),   ALLOCATABLE :: sto2d      ! 2D stochastic parameters 
     43   REAL(dp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE :: sto3d      ! 3D stochastic parameters 
     44   REAL(dp),         DIMENSION(:,:),     ALLOCATABLE :: sto_tmp    ! temporary workspace 
     45   REAL(dp),         DIMENSION(:,:),     ALLOCATABLE :: sto2d_abc  ! a, b, c parameters (for 2D arrays) 
     46   REAL(dp),         DIMENSION(:,:),     ALLOCATABLE :: sto3d_abc  ! a, b, c parameters (for 3D arrays) 
     47   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto2d_ave  ! mean value (for 2D arrays) 
     48   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto3d_ave  ! mean value (for 3D arrays) 
     49   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto2d_std  ! standard deviation (for 2D arrays) 
     50   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto3d_std  ! standard deviation (for 3D arrays) 
     51   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto2d_lim  ! limitation factor (for 2D arrays) 
     52   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto3d_lim  ! limitation factor (for 3D arrays) 
     53   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto2d_tcor ! time correlation (for 2D arrays) 
     54   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto3d_tcor ! time correlation (for 3D arrays) 
    5555   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto2d_ord  ! order of autoregressive process 
    5656   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto3d_ord  ! order of autoregressive process 
    … …  
    5858   CHARACTER(len=lca), DIMENSION(:),       ALLOCATABLE :: sto2d_typ  ! nature of grid point (T, U, V, W, F, I) 
    5959   CHARACTER(len=lca), DIMENSION(:),       ALLOCATABLE :: sto3d_typ  ! nature of grid point (T, U, V, W, F, I) 
    60    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_sgn  ! control of the sign accross the north fold 
    61    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_sgn  ! control of the sign accross the north fold 
     60   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto2d_sgn  ! control of the sign accross the north fold 
     61   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto3d_sgn  ! control of the sign accross the north fold 
    6262   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto2d_flt  ! number of passes of Laplacian filter 
    6363   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto3d_flt  ! number of passes of Laplacian filter 
    64    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_fac  ! factor to restore std after filtering 
    65    REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_fac  ! factor to restore std after filtering 
     64   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto2d_fac  ! factor to restore std after filtering 
     65   REAL(dp),         DIMENSION(:),       ALLOCATABLE :: sto3d_fac  ! factor to restore std after filtering 
    6666 
    6767   LOGICAL, PUBLIC :: ln_sto_ldf = .FALSE.    ! stochastic lateral diffusion 
    … …  
    113113 
    114114   !! * Substitutions 
     115#  include "single_precision_substitute.h90" 
    115116#  include "do_loop_substitute.h90" 
    116117   !!---------------------------------------------------------------------- 
    … …  
    160161      !! 
    161162      INTEGER  :: ji, jj, jk, jsto, jflt 
    162       REAL(wp) :: stomax 
     163      REAL(dp) :: stomax 
    163164      !!---------------------------------------------------------------------- 
    164165      ! 
    … …  
    174175          ! Apply horizontal Laplacian filter to w 
    175176          DO jflt = 1, sto2d_flt(jsto) 
    176             CALL lbc_lnk( 'stopar', sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) ) 
     177            CALL lbc_lnk( 'stopar', sto2d(:,:,jsto), sto2d_typ(jsto), CASTSP(sto2d_sgn(jsto)) ) 
    177178            CALL sto_par_flt( sto2d(:,:,jsto) ) 
    178179          END DO 
    … …  
    197198 
    198199        ! Lateral boundary conditions on sto2d 
    199         CALL lbc_lnk( 'stopar', sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) ) 
     200        CALL lbc_lnk( 'stopar', sto2d(:,:,jsto), sto2d_typ(jsto), CASTSP(sto2d_sgn(jsto)) ) 
    200201      END DO 
    201202      ! 
    … …  
    212213             ! Apply horizontal Laplacian filter to w 
    213214             DO jflt = 1, sto3d_flt(jsto) 
    214                CALL lbc_lnk( 'stopar', sto3d(:,:,jk,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) ) 
     215               CALL lbc_lnk( 'stopar', sto3d(:,:,jk,jsto), sto3d_typ(jsto), CASTSP(sto3d_sgn(jsto)) ) 
    215216               CALL sto_par_flt( sto3d(:,:,jk,jsto) ) 
    216217             END DO 
    … …  
    235236         END DO 
    236237         ! Lateral boundary conditions on sto3d 
    237          CALL lbc_lnk( 'stopar', sto3d(:,:,:,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) ) 
     238         CALL lbc_lnk( 'stopar', sto3d(:,:,:,jsto), sto3d_typ(jsto), CASTSP(sto3d_sgn(jsto)) ) 
    238239      END DO 
    239240      ! 
    … …  
    642643         ! Apply horizontal Laplacian filter to w 
    643644         DO jflt = 1, sto2d_flt(jsto) 
    644             CALL lbc_lnk( 'stopar', sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) ) 
     645            CALL lbc_lnk( 'stopar', sto2d(:,:,jsto), sto2d_typ(jsto), CASTSP(sto2d_sgn(jsto)) ) 
    645646            CALL sto_par_flt( sto2d(:,:,jsto) ) 
    646647         END DO 
    … …  
    659660            ! Apply horizontal Laplacian filter to w 
    660661            DO jflt = 1, sto3d_flt(jsto) 
    661                CALL lbc_lnk( 'stopar', sto3d(:,:,jk,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) ) 
     662               CALL lbc_lnk( 'stopar', sto3d(:,:,jk,jsto), sto3d_typ(jsto), CASTSP(sto3d_sgn(jsto)) ) 
    662663               CALL sto_par_flt( sto3d(:,:,jk,jsto) ) 
    663664            END DO 
    … …  
    832833      !! ** Purpose :   fill input array with white Gaussian noise 
    833834      !!---------------------------------------------------------------------- 
    834       REAL(wp), DIMENSION(jpi,jpj), INTENT(out)           ::   psto 
     835      REAL(dp), DIMENSION(jpi,jpj), INTENT(out)           ::   psto 
    835836      !! 
    836837      INTEGER  :: ji, jj 
    837       REAL(wp) :: gran   ! Gaussian random number (forced KIND=8 as in kiss_gaussian) 
     838      REAL(dp) :: gran   ! Gaussian random number (forced KIND=8 as in kiss_gaussian) 
    838839 
    839840      DO_2D( 1, 1, 1, 1 ) 
    … …  
    851852      !! ** Purpose :   apply horizontal Laplacian filter to input array 
    852853      !!---------------------------------------------------------------------- 
    853       REAL(wp), DIMENSION(jpi,jpj), INTENT(out)           ::   psto 
     854      REAL(dp), DIMENSION(jpi,jpj), INTENT(out)           ::   psto 
    854855      !! 
    855856      INTEGER  :: ji, jj 
    … …  
    873874      !!---------------------------------------------------------------------- 
    874875      INTEGER, INTENT(in) :: kpasses 
    875       REAL(wp) :: sto_par_flt_fac 
     876      REAL(dp) :: sto_par_flt_fac 
    876877      !! 
    877878      INTEGER :: jpasses, ji, jj, jflti, jfltj 
    878879      INTEGER, DIMENSION(-1:1,-1:1) :: pflt0 
    879       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pfltb 
    880       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pflta 
    881       REAL(wp) :: ratio 
     880      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: pfltb 
     881      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: pflta 
     882      REAL(dp) :: ratio 
    882883 
    883884      pflt0(-1,-1) = 0 ; pflt0(-1,0) = 1 ; pflt0(-1,1) = 0 

  • NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/STO/stopts.F90

    r14219 r15540  
    2323 
    2424   ! Public array with random tracer fluctuations 
    25    REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE :: pts_ran 
     25   REAL(dp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE :: pts_ran 
    2626 
    2727   !! * Substitutions 
    … …  
    4949      INTEGER  ::   jim1, jjm1, jkm1  ! incremented indices 
    5050      INTEGER  ::   jip1, jjp1, jkp1  !     -          - 
    51       REAL(wp) ::   zdtsim, zdtsjm, zdtskm         ! temporary scalars 
    52       REAL(wp) ::   zdtsip, zdtsjp, zdtskp, zdts   !     -        - 
     51      REAL(dp) ::   zdtsim, zdtsjm, zdtskm         ! temporary scalars 
     52      REAL(dp) ::   zdtsip, zdtsjp, zdtskp, zdts   !     -        - 
    5353      !!---------------------------------------------------------------------- 
    5454 

  • NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/STO/storng.F90

    r12649 r15540  
    5050 
    5151   ! Parameters to generate real random variates 
    52    REAL(KIND=wp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0 
     52   REAL(KIND=dp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0 
    5353 
    5454   ! Variables to store 2 Gaussian random numbers with current index (ig) 
    5555   INTEGER(KIND=i8), SAVE :: ig=1 
    56    REAL(KIND=wp), SAVE :: gran1, gran2 
     56   REAL(KIND=dp), SAVE :: gran1, gran2 
    5757 
    5858   !! * Substitutions 
    … …  
    272272      !! -------------------------------------------------------------------- 
    273273      IMPLICIT NONE 
    274       REAL(KIND=wp) :: uran 
     274      REAL(KIND=dp) :: uran 
    275275 
    276276      uran = half * ( one + REAL(kiss(),wp) / HUGE(1._wp) ) 
    … …  
    292292      !! -------------------------------------------------------------------- 
    293293      IMPLICIT NONE 
    294       REAL(KIND=wp) :: gran, u1, u2, rsq, fac 
     294      REAL(KIND=dp) :: gran, u1, u2, rsq, fac 
    295295 
    296296      IF (ig.EQ.1) THEN 
    … …  
    324324      !! -------------------------------------------------------------------- 
    325325      IMPLICIT NONE 
    326       REAL(KIND=wp), PARAMETER :: p1 = 4.5_8 
    327       REAL(KIND=wp), PARAMETER :: p2 = 2.50407739677627_8  ! 1+LOG(9/2) 
    328       REAL(KIND=wp), PARAMETER :: p3 = 1.38629436111989_8  ! LOG(4) 
    329       REAL(KIND=wp) :: gamr, k, u1, u2, b, c, d, xx, yy, zz, rr, ee 
     326      REAL(KIND=dp), PARAMETER :: p1 = 4.5_8 
     327      REAL(KIND=dp), PARAMETER :: p2 = 2.50407739677627_8  ! 1+LOG(9/2) 
     328      REAL(KIND=dp), PARAMETER :: p3 = 1.38629436111989_8  ! LOG(4) 
     329      REAL(KIND=dp) :: gamr, k, u1, u2, b, c, d, xx, yy, zz, rr, ee 
    330330      LOGICAL :: accepted 
    331331 
    … …  
    392392      INTEGER(KIND=i8), DIMENSION(:) :: a 
    393393      INTEGER(KIND=i8) :: n, k, i, j, atmp 
    394       REAL(KIND=wp) :: uran 
     394      REAL(KIND=dp) :: uran 
    395395 
    396396      ! Select the sample using the swapping method 
Note: See TracChangeset for help on using the changeset viewer.