Changeset 15540 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/STO/stopar.F90
- Timestamp:
- 2021-11-26T12:27:56+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/STO/stopar.F90
r13295 r15540 40 40 INTEGER :: jpsto3d = 0 ! number of 3D stochastic parameters 41 41 42 REAL( wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: sto2d ! 2D stochastic parameters43 REAL( wp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE :: sto3d ! 3D stochastic parameters44 REAL( wp), DIMENSION(:,:), ALLOCATABLE :: sto_tmp ! temporary workspace45 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) 55 55 INTEGER, DIMENSION(:), ALLOCATABLE :: sto2d_ord ! order of autoregressive process 56 56 INTEGER, DIMENSION(:), ALLOCATABLE :: sto3d_ord ! order of autoregressive process … … 58 58 CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE :: sto2d_typ ! nature of grid point (T, U, V, W, F, I) 59 59 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 fold61 REAL( wp), DIMENSION(:), ALLOCATABLE :: sto3d_sgn ! control of the sign accross the north fold60 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 62 62 INTEGER, DIMENSION(:), ALLOCATABLE :: sto2d_flt ! number of passes of Laplacian filter 63 63 INTEGER, DIMENSION(:), ALLOCATABLE :: sto3d_flt ! number of passes of Laplacian filter 64 REAL( wp), DIMENSION(:), ALLOCATABLE :: sto2d_fac ! factor to restore std after filtering65 REAL( wp), DIMENSION(:), ALLOCATABLE :: sto3d_fac ! factor to restore std after filtering64 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 66 66 67 67 LOGICAL, PUBLIC :: ln_sto_ldf = .FALSE. ! stochastic lateral diffusion … … 113 113 114 114 !! * Substitutions 115 # include "single_precision_substitute.h90" 115 116 # include "do_loop_substitute.h90" 116 117 !!---------------------------------------------------------------------- … … 160 161 !! 161 162 INTEGER :: ji, jj, jk, jsto, jflt 162 REAL( wp) :: stomax163 REAL(dp) :: stomax 163 164 !!---------------------------------------------------------------------- 164 165 ! … … 174 175 ! Apply horizontal Laplacian filter to w 175 176 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)) ) 177 178 CALL sto_par_flt( sto2d(:,:,jsto) ) 178 179 END DO … … 197 198 198 199 ! 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)) ) 200 201 END DO 201 202 ! … … 212 213 ! Apply horizontal Laplacian filter to w 213 214 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)) ) 215 216 CALL sto_par_flt( sto3d(:,:,jk,jsto) ) 216 217 END DO … … 235 236 END DO 236 237 ! 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)) ) 238 239 END DO 239 240 ! … … 642 643 ! Apply horizontal Laplacian filter to w 643 644 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)) ) 645 646 CALL sto_par_flt( sto2d(:,:,jsto) ) 646 647 END DO … … 659 660 ! Apply horizontal Laplacian filter to w 660 661 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)) ) 662 663 CALL sto_par_flt( sto3d(:,:,jk,jsto) ) 663 664 END DO … … 832 833 !! ** Purpose : fill input array with white Gaussian noise 833 834 !!---------------------------------------------------------------------- 834 REAL( wp), DIMENSION(jpi,jpj), INTENT(out) :: psto835 REAL(dp), DIMENSION(jpi,jpj), INTENT(out) :: psto 835 836 !! 836 837 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) 838 839 839 840 DO_2D( 1, 1, 1, 1 ) … … 851 852 !! ** Purpose : apply horizontal Laplacian filter to input array 852 853 !!---------------------------------------------------------------------- 853 REAL( wp), DIMENSION(jpi,jpj), INTENT(out) :: psto854 REAL(dp), DIMENSION(jpi,jpj), INTENT(out) :: psto 854 855 !! 855 856 INTEGER :: ji, jj … … 873 874 !!---------------------------------------------------------------------- 874 875 INTEGER, INTENT(in) :: kpasses 875 REAL( wp) :: sto_par_flt_fac876 REAL(dp) :: sto_par_flt_fac 876 877 !! 877 878 INTEGER :: jpasses, ji, jj, jflti, jfltj 878 879 INTEGER, DIMENSION(-1:1,-1:1) :: pflt0 879 REAL( wp), DIMENSION(:,:), ALLOCATABLE :: pfltb880 REAL( wp), DIMENSION(:,:), ALLOCATABLE :: pflta881 REAL( wp) :: ratio880 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: pfltb 881 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: pflta 882 REAL(dp) :: ratio 882 883 883 884 pflt0(-1,-1) = 0 ; pflt0(-1,0) = 1 ; pflt0(-1,1) = 0
Note: See TracChangeset
for help on using the changeset viewer.
