diff --git a/CMakeLists.txt b/CMakeLists.txt index 9f010c9..ae14a65 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,5 +1,14 @@ -if(32BIT) - message ("Force 64 bits in stochastic_physics") +if(CCPP_32BIT) + message(STATUS "Compile stochastic_physics with 32-bit precision to match CCPP slow physics.") + add_definitions(-DCCPP_32BIT) + if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -real-size 32") + elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fno-default-real-8 -fdefault-double-8") + endif() +else() + message(STATUS "Compile stochastic_physics with 64-bit precision to match CCPP slow physics.") + remove_definitions(-DCCPP_32BIT) if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -real-size 64") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") diff --git a/cellular_automata_global.F90 b/cellular_automata_global.F90 index 2f3f236..2f0ea39 100644 --- a/cellular_automata_global.F90 +++ b/cellular_automata_global.F90 @@ -11,7 +11,7 @@ subroutine cellular_automata_global(kstep,restart,first_time_step,ca1_cpl,ca2_cp nca,ncells,nlives,nfracseed,nseed,iseed_ca, mytile, & ca_smooth,nspinup,blocksize,nsmooth,ca_amplitude,mpiroot,mpicomm) -use kinddef, only: kind_dbl_prec +use kinddef, only: kind_dbl_prec, kind_phys use update_ca, only: update_cells_global,define_ca_domain use halo_exchange, only: atmosphere_scalar_field_halo use random_numbers, only: random_01_CB @@ -33,10 +33,10 @@ subroutine cellular_automata_global(kstep,restart,first_time_step,ca1_cpl,ca2_cp integer, intent(in) :: kstep,ncells,nca,nlives,nseed,nspinup,nsmooth,mpiroot,mpicomm integer(kind=kind_dbl_prec), intent(in) :: iseed_ca integer, intent(in) :: mytile -real(kind=kind_dbl_prec), intent(in) :: nfracseed,ca_amplitude +real(kind=kind_phys), intent(in) :: nfracseed,ca_amplitude logical, intent(in) :: ca_smooth,first_time_step, restart integer, intent(in) :: nblks,isc,iec,jsc,jec,npx,npy,nlev,blocksize -real(kind=kind_dbl_prec), intent(out) :: ca1_cpl(:,:),ca2_cpl(:,:),ca3_cpl(:,:) +real(kind=kind_phys), intent(out) :: ca1_cpl(:,:),ca2_cpl(:,:),ca3_cpl(:,:) type(domain2D), intent(inout) :: domain_in type(block_control_type) :: Atm_block integer :: nlon, nlat, isize,jsize,nf,nn @@ -50,8 +50,8 @@ subroutine cellular_automata_global(kstep,restart,first_time_step,ca1_cpl,ca2_cp integer(8) :: count, count_rate, count_max, count_trunc,nx_full integer(8) :: iscale = 10000000000 integer, allocatable :: iini_g(:,:,:),ilives_g(:,:) -real(kind=kind_dbl_prec), allocatable :: field_out(:,:,:), field_smooth(:,:) -real(kind=kind_dbl_prec), allocatable :: CA(:,:),CA1(:,:),CA2(:,:),CA3(:,:),CAprime(:,:) +real(kind=kind_phys), allocatable :: field_out(:,:,:), field_smooth(:,:) +real(kind=kind_phys), allocatable :: CA(:,:),CA1(:,:),CA2(:,:),CA3(:,:),CAprime(:,:) real*8 , allocatable :: noise(:,:,:) real*8 :: psum,CAmean,sq_diff,CAstdv,inv9 real*8 :: Detmax,Detmin diff --git a/get_stochy_pattern.F90 b/get_stochy_pattern.F90 index 1fd00be..1d247c0 100644 --- a/get_stochy_pattern.F90 +++ b/get_stochy_pattern.F90 @@ -1,6 +1,6 @@ !>@brief The module 'get_stochy_pattern_mod' contains the subroutines to retrieve the random pattern in the cubed-sphere grid module get_stochy_pattern_mod - use kinddef, only : kind_dbl_prec, kind_evod + use kinddef use spectral_transforms, only : len_trie_ls, & len_trio_ls, ls_dim, stochy_la2ga, & coslat_a, latg, levs, lonf, skeblevs,& @@ -102,19 +102,19 @@ subroutine get_random_pattern_vector(rpattern,npatterns,& type(stochy_internal_state), intent(in) :: gis_stochy type(random_pattern), intent(inout) :: rpattern(npatterns) - real(kind=kind_evod), dimension(len_trie_ls,2) :: vrtspec_e,divspec_e - real(kind=kind_evod), dimension(len_trio_ls,2) :: vrtspec_o,divspec_o + real(kind=kind_dbl_prec), dimension(len_trie_ls,2) :: vrtspec_e,divspec_e + real(kind=kind_dbl_prec), dimension(len_trio_ls,2) :: vrtspec_o,divspec_o integer:: npatterns real(kind=kind_dbl_prec) :: upattern_3d(gis_stochy%nx,gis_stochy%ny,levs) real(kind=kind_dbl_prec) :: vpattern_3d(gis_stochy%nx,gis_stochy%ny,levs) real(kind=kind_dbl_prec) :: pattern_1d(gis_stochy%nx) integer i,j,lat,n,nn,k - real(kind_dbl_prec), dimension(lonf,gis_stochy%lats_node_a,1):: wrk2du,wrk2dv + real(kind_phys), dimension(lonf,gis_stochy%lats_node_a,1):: wrk2du,wrk2dv ! logical lprint - real, allocatable, dimension(:,:) :: workgu,workgv + real(kind_dbl_prec), allocatable, dimension(:,:) :: workgu,workgv integer kmsk0(lonf,gis_stochy%lats_node_a) kmsk0 = 0 allocate(workgu(lonf,latg)) @@ -566,7 +566,7 @@ subroutine write_pattern(rpattern,outlun,lev,np,varid1,varid2,slice_of_3d,iret) integer, intent(in) :: np,varid1,varid2 logical, intent(in) :: slice_of_3d integer, intent(out) :: iret - real(kind_dbl_prec), allocatable :: pattern2d(:) + real(kind_phys), allocatable :: pattern2d(:) integer nm,nn,arrlen,isize,ierr integer,allocatable :: isave(:) include 'netcdf.inc' @@ -623,8 +623,8 @@ subroutine vrtdivspect_to_uvgrid(& real(kind=kind_dbl_prec), intent(in) :: trio_di(len_trio_ls,2) real(kind=kind_dbl_prec), intent(in) :: trie_ze(len_trie_ls,2) real(kind=kind_dbl_prec), intent(in) :: trio_ze(len_trio_ls,2) - real(kind=kind_dbl_prec), intent(out) :: uug(lonf,gis_stochy%lats_node_a) - real(kind=kind_dbl_prec), intent(out) :: vvg(lonf,gis_stochy%lats_node_a) + real(kind=kind_phys), intent(out) :: uug(lonf,gis_stochy%lats_node_a) + real(kind=kind_phys), intent(out) :: vvg(lonf,gis_stochy%lats_node_a) ! local vars real(kind=kind_dbl_prec) trie_ls(len_trie_ls,2,2) real(kind=kind_dbl_prec) trio_ls(len_trio_ls,2,2) @@ -632,7 +632,7 @@ subroutine vrtdivspect_to_uvgrid(& real(kind=kind_dbl_prec) for_gr_a_2(lonf,2,gis_stochy%lats_dim_a) integer i,k integer lan,lat - real (kind=kind_dbl_prec) tx1 + real (kind=kind_phys) tx1 call dezouv_stochy(trie_di(:,:), trio_ze(:,:), & trie_ls(:,:,1), trio_ls(:,:,2), gis_stochy%epsedn,gis_stochy%epsodn, & diff --git a/halo_exchange.fv3.F90 b/halo_exchange.fv3.F90 index d3d1463..765d855 100644 --- a/halo_exchange.fv3.F90 +++ b/halo_exchange.fv3.F90 @@ -7,6 +7,8 @@ module halo_exchange use mpp_domains_mod, only: domain2d, mpp_update_domains use mpp_domains_mod, only: mpp_update_domains +use kinddef, only: kind_phys + implicit none private @@ -34,14 +36,14 @@ subroutine atmosphere_scalar_field_halo (data, halo, isize, jsize, ksize, & ! data_p - optional input field in packed format (ix,k) !-------------------------------------------------------------------- !--- interface variables --- - real*8, dimension(1:isize,1:jsize,ksize), intent(inout) :: data !< output array to return the field with halo (i,j,k) + real(kind_phys), dimension(1:isize,1:jsize,ksize), intent(inout) :: data !< output array to return the field with halo (i,j,k) !< optionally input for field already in (i,j,k) form !< sized to include the halo of the field (+ 2*halo) integer, intent(in) :: halo !< size of the halo (must be less than 3) integer, intent(in) :: isize !< horizontal resolution in i-dir with haloes integer, intent(in) :: jsize !< horizontal resolution in j-dir with haloes integer, intent(in) :: ksize !< vertical resolution - real*8, dimension(:,:), optional, intent(in) :: data_p !< optional input field in packed format (ix,k) + real(kind_phys), dimension(:,:), optional, intent(in) :: data_p !< optional input field in packed format (ix,k) integer, intent(in) :: isc, iec, jsc, jec, npx, npy type(domain2d), intent(inout) :: domain_for_coupler !--- local variables --- diff --git a/kinddef.F90 b/kinddef.F90 index 43cd3d4..f427925 100644 --- a/kinddef.F90 +++ b/kinddef.F90 @@ -4,17 +4,19 @@ module kinddef private - public :: kind_evod, kind_phys + public :: kind_phys public :: kind_dbl_prec, kind_qdt_prec - public :: kind_io4, kind_io8 + public :: kind_io8 - integer, parameter :: kind_io4 = 4 - - ! DH* TODO - stochastic physics / CA should be using only one of these - integer, parameter :: kind_evod = 8 + ! kind_phys must match CCPP Physics kind_phys +#ifdef CCPP_32BIT + integer, parameter :: kind_phys = 4 +#else integer, parameter :: kind_phys = 8 +#endif + integer, parameter :: kind_dbl_prec = 8 - integer, parameter :: kind_io8 = 8 + integer, parameter :: kind_io8 = kind_dbl_prec #ifdef NO_QUAD_PRECISION integer, parameter :: kind_qdt_prec = 8 diff --git a/lndp_apply_perts.F90 b/lndp_apply_perts.F90 index 91022f4..705ef01 100644 --- a/lndp_apply_perts.F90 +++ b/lndp_apply_perts.F90 @@ -1,6 +1,6 @@ module lndp_apply_perts_mod - use kinddef, only : kind_dbl_prec + use kinddef, only : kind_dbl_prec, kind_phys use stochy_namelist_def implicit none @@ -62,27 +62,27 @@ subroutine lndp_apply_perts(blksz, lsm, lsm_noah, lsm_ruc, lsm_noahmp, iopt_dveg integer, intent(in) :: n_var_lndp, lsoil, kdt, iopt_dveg integer, intent(in) :: lsm, lsm_noah, lsm_ruc, lsm_noahmp character(len=3), intent(in) :: lndp_var_list(:) - real(kind=kind_dbl_prec), intent(in) :: lndp_prt_list(:) - real(kind=kind_dbl_prec), intent(in) :: dtf - real(kind=kind_dbl_prec), intent(in) :: sfc_wts(:,:,:) - real(kind=kind_dbl_prec), intent(in) :: xlon(:,:) - real(kind=kind_dbl_prec), intent(in) :: xlat(:,:) + real(kind=kind_phys), intent(in) :: lndp_prt_list(:) + real(kind=kind_phys), intent(in) :: dtf + real(kind=kind_phys), intent(in) :: sfc_wts(:,:,:) + real(kind=kind_phys), intent(in) :: xlon(:,:) + real(kind=kind_phys), intent(in) :: xlat(:,:) logical, intent(in) :: param_update_flag ! true = parameters have just been updated by global_cycle integer, intent(in) :: stype(:,:) - real(kind=kind_dbl_prec), intent(in) :: smcmax(:) - real(kind=kind_dbl_prec), intent(in) :: smcmin(:) + real(kind=kind_phys), intent(in) :: smcmax(:) + real(kind=kind_phys), intent(in) :: smcmin(:) ! intent(inout) - real(kind=kind_dbl_prec), intent(inout) :: smc(:,:,:) - real(kind=kind_dbl_prec), intent(inout) :: slc(:,:,:) - real(kind=kind_dbl_prec), intent(inout) :: stc(:,:,:) - real(kind=kind_dbl_prec), intent(inout) :: vfrac(:,:) - real(kind=kind_dbl_prec), intent(inout) :: snoalb(:,:) - real(kind=kind_dbl_prec), intent(inout) :: alnsf(:,:) - real(kind=kind_dbl_prec), intent(inout) :: alnwf(:,:) - real(kind=kind_dbl_prec), intent(inout) :: semis(:,:) - real(kind=kind_dbl_prec), intent(inout) :: zorll(:,:) + real(kind=kind_phys), intent(inout) :: smc(:,:,:) + real(kind=kind_phys), intent(inout) :: slc(:,:,:) + real(kind=kind_phys), intent(inout) :: stc(:,:,:) + real(kind=kind_phys), intent(inout) :: vfrac(:,:) + real(kind=kind_phys), intent(inout) :: snoalb(:,:) + real(kind=kind_phys), intent(inout) :: alnsf(:,:) + real(kind=kind_phys), intent(inout) :: alnwf(:,:) + real(kind=kind_phys), intent(inout) :: semis(:,:) + real(kind=kind_phys), intent(inout) :: zorll(:,:) ! intent(out) integer, intent(out) :: ierr @@ -93,20 +93,20 @@ subroutine lndp_apply_perts(blksz, lsm, lsm_noah, lsm_ruc, lsm_noahmp, iopt_dveg integer :: this_im, v, k logical :: print_flag, do_pert_state, do_pert_param - real(kind=kind_dbl_prec) :: p, min_bound, max_bound, pert - real(kind=kind_dbl_prec) :: tmp_smc - real(kind=kind_dbl_prec) :: conv_hr2tstep, tfactor_state, tfactor_param - real(kind=kind_dbl_prec), dimension(lsoil) :: zslayer, smc_vertscale, stc_vertscale + real(kind=kind_phys) :: p, min_bound, max_bound, pert + real(kind=kind_phys) :: tmp_smc + real(kind=kind_phys) :: conv_hr2tstep, tfactor_state, tfactor_param + real(kind=kind_phys), dimension(lsoil) :: zslayer, smc_vertscale, stc_vertscale ! decrease in applied pert with depth !-- Noah lsm - real(kind=kind_dbl_prec), dimension(4), parameter :: smc_vertscale_noah = (/1.0,0.5,0.25,0.125/) - real(kind=kind_dbl_prec), dimension(4), parameter :: stc_vertscale_noah = (/1.0,0.5,0.25,0.125/) - real(kind=kind_dbl_prec), dimension(4), parameter :: zs_noah = (/0.1, 0.3, 0.6, 1.0/) + real(kind=kind_phys), dimension(4), parameter :: smc_vertscale_noah = (/1.0,0.5,0.25,0.125/) + real(kind=kind_phys), dimension(4), parameter :: stc_vertscale_noah = (/1.0,0.5,0.25,0.125/) + real(kind=kind_phys), dimension(4), parameter :: zs_noah = (/0.1, 0.3, 0.6, 1.0/) !-- RUC lsm - real(kind=kind_dbl_prec), dimension(9), parameter :: smc_vertscale_ruc = (/1.0,0.9,0.8,0.6,0.4,0.2,0.1,0.05,0./) - real(kind=kind_dbl_prec), dimension(9), parameter :: stc_vertscale_ruc = (/1.0,0.9,0.8,0.6,0.4,0.2,0.1,0.05,0./) - real(kind=kind_dbl_prec), dimension(9), parameter :: zs_ruc = (/0.05, 0.15, 0.20, 0.20, 0.40, 0.60, 0.60, 0.80, 1.00/) + real(kind=kind_phys), dimension(9), parameter :: smc_vertscale_ruc = (/1.0,0.9,0.8,0.6,0.4,0.2,0.1,0.05,0./) + real(kind=kind_phys), dimension(9), parameter :: stc_vertscale_ruc = (/1.0,0.9,0.8,0.6,0.4,0.2,0.1,0.05,0./) + real(kind=kind_phys), dimension(9), parameter :: zs_ruc = (/0.05, 0.15, 0.20, 0.20, 0.40, 0.60, 0.60, 0.80, 1.00/) ierr = 0 @@ -330,22 +330,22 @@ subroutine apply_pert(vname,pert,print_flag, state,ierr,p,vmin, vmax) ! intent in logical, intent(in) :: print_flag - real(kind=kind_dbl_prec), intent(in) :: pert + real(kind=kind_phys), intent(in) :: pert character(len=*), intent(in) :: vname ! name of variable being perturbed - real(kind=kind_dbl_prec), optional, intent(in) :: p ! flat-top paramater, 0 = no flat-top + real(kind=kind_phys), optional, intent(in) :: p ! flat-top paramater, 0 = no flat-top ! flat-top function is used for bounded variables ! to reduce the magnitude of perturbations near boundaries. - real(kind=kind_dbl_prec), optional, intent(in) :: vmin, vmax ! min,max bounds of variable being perturbed + real(kind=kind_phys), optional, intent(in) :: vmin, vmax ! min,max bounds of variable being perturbed ! intent (inout) - real(kind=kind_dbl_prec), intent(inout) :: state + real(kind=kind_phys), intent(inout) :: state ! intent out integer :: ierr !local - real(kind=kind_dbl_prec) :: z + real(kind=kind_phys) :: z if ( print_flag ) then write(*,*) 'LNDP - applying lndp to ',vname, ', initial value', state @@ -385,8 +385,8 @@ subroutine set_printing_nb_i(blksz,xlon,xlat,print_i,print_nb) ! intent (in) integer, intent(in) :: blksz(:) - real(kind=kind_dbl_prec), intent(in) :: xlon(:,:) - real(kind=kind_dbl_prec), intent(in) :: xlat(:,:) + real(kind=kind_phys), intent(in) :: xlon(:,:) + real(kind=kind_phys), intent(in) :: xlat(:,:) ! intent (out) diff --git a/mersenne_twister.F90 b/mersenne_twister.F90 index 9ab6103..c537681 100644 --- a/mersenne_twister.F90 +++ b/mersenne_twister.F90 @@ -160,6 +160,7 @@ ! !$$$ module mersenne_twister + use kinddef, only: kind_dbl_prec private ! Public declarations public random_stat @@ -188,7 +189,7 @@ module mersenne_twister integer:: mti=n+1 integer:: mt(0:n-1) integer:: iset - real:: gset + real(kind_dbl_prec):: gset end type ! Saved data type(random_stat),save:: sstat @@ -296,8 +297,8 @@ subroutine random_setseed_t(inseed,stat) !> This function generates random numbers in functional mode. function random_number_f() result(harvest) implicit none - real:: harvest - real h(1) + real(kind_dbl_prec):: harvest + real(kind_dbl_prec) :: h(1) if(sstat%mti.eq.n+1) call random_setseed_t(iseed,sstat) call random_number_t(h,sstat) harvest=h(1) @@ -306,7 +307,7 @@ function random_number_f() result(harvest) !> This subroutine generates random numbers in interactive mode. subroutine random_number_i(harvest,inseed) implicit none - real,intent(out):: harvest(:) + real(kind_dbl_prec),intent(out):: harvest(:) integer,intent(in):: inseed type(random_stat) stat call random_setseed_t(inseed,stat) @@ -316,7 +317,7 @@ subroutine random_number_i(harvest,inseed) !> This subroutine generates random numbers in saved mode; overloads Fortran 90 standard. subroutine random_number_s(harvest) implicit none - real,intent(out):: harvest(:) + real(kind_dbl_prec),intent(out):: harvest(:) if(sstat%mti.eq.n+1) call random_setseed_t(iseed,sstat) call random_number_t(harvest,sstat) end subroutine @@ -324,7 +325,7 @@ subroutine random_number_s(harvest) !> This subroutine generates random numbers in thread-safe mode. subroutine random_number_t(harvest,stat) implicit none - real,intent(out):: harvest(:) + real(kind_dbl_prec),intent(out):: harvest(:) type(random_stat),intent(inout):: stat integer j,kk,y integer tshftu,tshfts,tshftt,tshftl @@ -352,9 +353,9 @@ subroutine random_number_t(harvest,stat) y=ieor(y,iand(tshftt(y),tmaskc)) y=ieor(y,tshftl(y)) if(y.lt.0) then - harvest(j)=(real(y)+2.0**32)/(2.0**32-1.0) + harvest(j)=(real(y,kind_dbl_prec)+2.0_kind_dbl_prec**32)/(2.0_kind_dbl_prec**32-1.0_kind_dbl_prec) else - harvest(j)=real(y)/(2.0**32-1.0) + harvest(j)=real(y,kind_dbl_prec)/(2.0_kind_dbl_prec**32-1.0_kind_dbl_prec) endif stat%mti=stat%mti+1 enddo @@ -363,8 +364,8 @@ subroutine random_number_t(harvest,stat) !> This subrouitne generates Gaussian random numbers in functional mode. function random_gauss_f() result(harvest) implicit none - real:: harvest - real h(1) + real(kind_dbl_prec):: harvest + real(kind_dbl_prec) :: h(1) if(sstat%mti.eq.n+1) call random_setseed_t(iseed,sstat) call random_gauss_t(h,sstat) harvest=h(1) @@ -373,7 +374,7 @@ function random_gauss_f() result(harvest) !> This subrouitne generates Gaussian random numbers in interactive mode. subroutine random_gauss_i(harvest,inseed) implicit none - real,intent(out):: harvest(:) + real(kind_dbl_prec),intent(out):: harvest(:) integer,intent(in):: inseed type(random_stat) stat call random_setseed_t(inseed,stat) @@ -383,7 +384,7 @@ subroutine random_gauss_i(harvest,inseed) !> This subroutine generates Gaussian random numbers in saved mode. subroutine random_gauss_s(harvest) implicit none - real,intent(out):: harvest(:) + real(kind_dbl_prec),intent(out):: harvest(:) if(sstat%mti.eq.n+1) call random_setseed_t(iseed,sstat) call random_gauss_t(harvest,sstat) end subroutine @@ -391,10 +392,10 @@ subroutine random_gauss_s(harvest) !> This subroutine generates Gaussian random numbers in thread-safe mode. subroutine random_gauss_t(harvest,stat) implicit none - real,intent(out):: harvest(:) + real(kind_dbl_prec),intent(out):: harvest(:) type(random_stat),intent(inout):: stat integer mx,my,mz,j - real r2(2),r,g1,g2 + real(kind_dbl_prec) :: r2(2),r,g1,g2 mz=size(harvest) if(mz.le.0) return mx=0 @@ -429,14 +430,14 @@ subroutine random_gauss_t(harvest,stat) contains !> This subroutine contains numerical Recipes algorithm to generate Gaussian random numbers. subroutine rgauss(r1,r2,r,g1,g2) - real,intent(in):: r1,r2 - real,intent(out):: r,g1,g2 - real v1,v2,fac - v1=2.*r1-1. - v2=2.*r2-1. + real(kind_dbl_prec),intent(in):: r1,r2 + real(kind_dbl_prec),intent(out):: r,g1,g2 + real(kind_dbl_prec) :: v1,v2,fac + v1=2.*r1-1._kind_dbl_prec + v2=2.*r2-1._kind_dbl_prec r=v1**2+v2**2 if(r.lt.1.) then - fac=sqrt(-2.*log(r)/r) + fac=sqrt(-2._kind_dbl_prec*log(r)/r) g1=v1*fac g2=v2*fac endif @@ -482,7 +483,7 @@ subroutine random_index_t(imax,iharvest,stat) type(random_stat),intent(inout):: stat integer,parameter:: mh=n integer i1,i2,mz - real h(mh) + real(kind_dbl_prec) :: h(mh) mz=size(iharvest) do i1=1,mz,mh i2=min((i1-1)+mh,mz) diff --git a/spectral_transforms.F90 b/spectral_transforms.F90 index 59eeb9a..4b54292 100644 --- a/spectral_transforms.F90 +++ b/spectral_transforms.F90 @@ -20,7 +20,7 @@ module spectral_transforms ! integer, public, allocatable :: lat1s_a(:), lon_dims_a(:) - real, public, allocatable, dimension(:) :: colrad_a, wgt_a, rcs2_a, & + real(kind_dbl_prec), public, allocatable, dimension(:) :: colrad_a, wgt_a, rcs2_a, & sinlat_a, coslat_a @@ -268,7 +268,7 @@ SUBROUTINE dcrft_stochy(init,x,ldx,y,ldy,n,nvars, table,n1,wrk,n2) implicit none integer ,intent(in) :: ldx,ldy,n,nvars integer init,n1,n2,i,j - real x(ldx,nvars),y(ldy,nvars),table(44002),wrk + real(kind_dbl_prec) x(ldx,nvars),y(ldy,nvars),table(44002),wrk IF (init.ne.0) THEN CALL rffti_stochy(n,table) @@ -297,8 +297,8 @@ SUBROUTINE RFFTB_STOCHY (N,R,WSAVE) implicit none - real, intent(inout) :: R(:) - real, intent(inout) :: WSAVE(44002) + real(kind_dbl_prec), intent(inout) :: R(:) + real(kind_dbl_prec), intent(inout) :: WSAVE(44002) integer :: N @@ -311,7 +311,7 @@ SUBROUTINE RFFTI_STOCHY (N,WSAVE) implicit none - REAL, intent(inout) :: WSAVE(44002) + REAL(kind_dbl_prec), intent(inout) :: WSAVE(44002) integer :: N IF (N .EQ. 1) RETURN @@ -325,10 +325,10 @@ SUBROUTINE RFFTB1_STOCHY (N,C,CH,WA,RFAC) implicit none integer, intent(in) :: N - real, intent(inout) :: CH(44002) - real, intent(inout) :: C(:) - real, intent(inout) :: WA(:) - real, intent(inout) :: RFAC(:) + real(kind_dbl_prec), intent(inout) :: CH(44002) + real(kind_dbl_prec), intent(inout) :: C(:) + real(kind_dbl_prec), intent(inout) :: WA(:) + real(kind_dbl_prec), intent(inout) :: RFAC(:) integer :: NF,NA,L1,IW,IP,L2,IDO,IDL1,IX2,IX3,IX4 integer :: K1,I @@ -397,14 +397,14 @@ SUBROUTINE RFFTI1_STOCHY (N,WA,RFAC) implicit none integer, intent(in) :: N - REAL, intent(inout) :: WA(:) - REAL, intent(inout) :: RFAC(:) + REAL(kind_dbl_prec), intent(inout) :: WA(:) + REAL(kind_dbl_prec), intent(inout) :: RFAC(:) integer :: NTRYH(4) integer :: NL,NF, I, J, NQ,NR,LD,FI,IS,ID,L1,L2,IP integer :: NTRY, NFM1, K1,II, IB, IDO, IPM, IC - REAL, parameter :: TPI=6.28318530717959 - real :: ARG,ARGLD,ARGH, TI2,TI4 + REAL(kind_dbl_prec), parameter :: TPI=6.28318530717959 + real(kind_dbl_prec) :: ARG,ARGLD,ARGH, TI2,TI4 DATA NTRYH(:) /4,2,3,5/ @@ -480,12 +480,12 @@ SUBROUTINE RADB2_STOCHY (IDO,L1,CC,CH,WA1) integer, intent(in) :: IDO integer, intent(in) :: L1 - real, intent(inout) :: CC(IDO,2,L1) - real, intent(inout) :: CH(IDO,L1,2) - real, intent(inout) :: WA1(:) + real(kind_dbl_prec), intent(inout) :: CC(IDO,2,L1) + real(kind_dbl_prec), intent(inout) :: CH(IDO,L1,2) + real(kind_dbl_prec), intent(inout) :: WA1(:) integer :: K,I,IC,IDP2 - real :: TR2,TI2 + real(kind_dbl_prec) :: TR2,TI2 DO 101 K=1,L1 CH(1,K,1) = CC(1,1,K)+CC(IDO,2,K) CH(1,K,2) = CC(1,1,K)-CC(IDO,2,K) @@ -524,16 +524,16 @@ SUBROUTINE RADB3_STOCHY (IDO,L1,CC,CH,WA1,WA2) implicit none integer, intent(in) :: IDO,L1 - real, intent(inout) :: CC(IDO,3,L1) - real, intent(inout) :: CH(IDO,L1,3) - real, intent(inout) :: WA1(:) - real, intent(inout) :: WA2(:) + real(kind_dbl_prec), intent(inout) :: CC(IDO,3,L1) + real(kind_dbl_prec), intent(inout) :: CH(IDO,L1,3) + real(kind_dbl_prec), intent(inout) :: WA1(:) + real(kind_dbl_prec), intent(inout) :: WA2(:) - REAL, parameter :: TAUR= -.5 - REAL, parameter :: TAUI=.866025403784439 + REAL(kind_dbl_prec), parameter :: TAUR= -.5 + REAL(kind_dbl_prec), parameter :: TAUI=.866025403784439 integer :: I,K,IDP2,IC - real :: TR2,CR2,TI1,CI2,CR3,CI3,DR2,DR3,DI2,DI3 - real :: TI2,TI4 + real(kind_dbl_prec) :: TR2,CR2,TI1,CI2,CR3,CI3,DR2,DR3,DI2,DI3 + real(kind_dbl_prec) :: TI2,TI4 DO 101 K=1,L1 @@ -577,16 +577,16 @@ SUBROUTINE RADB4_STOCHY (IDO,L1,CC,CH,WA1,WA2,WA3) implicit none integer, intent(in) :: IDO,L1 - real, intent(inout) :: CC(IDO,4,L1) - real, intent(inout) :: CH(IDO,L1,4) - real, intent(inout) :: WA1(:) - real, intent(inout) :: WA2(:) - real, intent(inout) :: WA3(:) + real(kind_dbl_prec), intent(inout) :: CC(IDO,4,L1) + real(kind_dbl_prec), intent(inout) :: CH(IDO,L1,4) + real(kind_dbl_prec), intent(inout) :: WA1(:) + real(kind_dbl_prec), intent(inout) :: WA2(:) + real(kind_dbl_prec), intent(inout) :: WA3(:) - REAL, parameter :: SQRT2=1.414213562373095 + REAL(kind_dbl_prec), parameter :: SQRT2=1.414213562373095 integer :: I,K,IDP2,IC - real :: TR1,TR2,TR3,TR4,TI1,TI2,TI3,TI4 - real :: CI2,CI3,CI4,CR2,CR3,CR4 + real(kind_dbl_prec) :: TR1,TR2,TR3,TR4,TI1,TI2,TI3,TI4 + real(kind_dbl_prec) :: CI2,CI3,CI4,CR2,CR3,CR4 DO 101 K=1,L1 TR1 = CC(1,1,K)-CC(IDO,4,K) TR2 = CC(1,1,K)+CC(IDO,4,K) @@ -650,11 +650,19 @@ SUBROUTINE RADB4_STOCHY (IDO,L1,CC,CH,WA1,WA2,WA3) SUBROUTINE RADB5_STOCHY (IDO,L1,CC,CH,WA1,WA2,WA3,WA4) - DIMENSION CC(IDO,5,L1), CH(IDO,L1,5), WA1(*), WA2(*), WA3(*), WA4(*) - REAL, parameter :: TR11=0.309016994374947 - REAL, parameter :: TI11= 0.951056516295154 - REAL, parameter :: TR12=-0.809016994374947 - REAL, parameter :: TI12=0.587785252292473 + implicit none + integer, intent(in) :: L1, IDO + REAL(kind_dbl_prec) :: CC(IDO,5,L1), CH(IDO,L1,5), WA1(*), WA2(*), WA3(*), WA4(*) + REAL(kind_dbl_prec), parameter :: TR11=0.309016994374947 + REAL(kind_dbl_prec), parameter :: TI11= 0.951056516295154 + REAL(kind_dbl_prec), parameter :: TR12=-0.809016994374947 + REAL(kind_dbl_prec), parameter :: TI12=0.587785252292473 + integer :: k,IDP2,I,IC + real(kind_dbl_prec) :: & + TI5,TI4,TR2,TR3,CR2,CR3,CI5,CI4, & + TI2,TI3,TR5,TR4, & + CI2,CI3,CR5,CR4, & + DR3,DR4,DI3,DI4,DR5,DR2,DI5,DI2 DO 101 K=1,L1 TI5 = CC(1,3,K)+CC(1,3,K) TI4 = CC(1,5,K)+CC(1,5,K) @@ -714,11 +722,12 @@ SUBROUTINE RADB5_STOCHY (IDO,L1,CC,CH,WA1,WA2,WA3,WA4) RETURN END - SUBROUTINE RADBG_STOCHY (IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA) - DIMENSION CH(IDO,L1,IP), CC(IDO,IP,L1), C1(IDO,L1,IP), C2(IDL1,IP), & + implicit real(kind=kind_dbl_prec) (A-H) + implicit real(kind=kind_dbl_prec) (O-Z) + REAL(kind_dbl_prec) :: CH(IDO,L1,IP), CC(IDO,IP,L1), C1(IDO,L1,IP), C2(IDL1,IP), & CH2(IDL1,IP) , WA(*) - REAL, parameter :: TPI=6.28318530717959 + REAL(kind_dbl_prec), parameter :: TPI=6.28318530717959 ARG = TPI/FLOAT(IP) DCP = COS(ARG) DSP = SIN(ARG) @@ -912,7 +921,7 @@ subroutine dozeuv_stochy(dod,zev,uod,vev,epsedn,epsodn, snnp1ev,snnp1od,ls_node) real(kind_dbl_prec) cons0 !constant integer indlsev,jbasev integer indlsod,jbasod - real(kind_evod) rerth + real(kind_dbl_prec) rerth include 'function2' @@ -1096,7 +1105,7 @@ subroutine dezouv_stochy(dev,zod,uev,vod,epsedn,epsodn,snnp1ev,snnp1od,ls_node) integer indlsev,jbasev integer indlsod,jbasod - real(kind_evod) rerth + real(kind_dbl_prec) rerth include 'function2' !...................................................................... @@ -1802,7 +1811,7 @@ subroutine gozrineo_a_stochy(gis_stochy, num_lat) real(kind=kind_dbl_prec) cons0 !constant real(kind=kind_dbl_prec) cons2 !constant - real rerth + real(kind_dbl_prec) rerth integer indlsev,jbasev integer indlsod,jbasod diff --git a/stochastic_physics.F90 b/stochastic_physics.F90 index f76b3d3..7d95dac 100644 --- a/stochastic_physics.F90 +++ b/stochastic_physics.F90 @@ -2,7 +2,7 @@ !! the stochastic physics random pattern generators module stochastic_physics -use kinddef, only : kind_dbl_prec +use kinddef, only : kind_phys, kind_dbl_prec implicit none @@ -42,27 +42,27 @@ subroutine init_stochastic_physics(levs, blksz, dtp, sppt_amp, input_nml_file_in integer, intent(in) :: levs, nlunit, nthreads, mpiroot, mpicomm integer, intent(in) :: blksz(:) -real(kind=kind_dbl_prec), intent(in) :: dtp -real(kind=kind_dbl_prec), intent(out) :: sppt_amp +real(kind=kind_phys), intent(in) :: dtp +real(kind=kind_phys), intent(out) :: sppt_amp character(len=*), intent(in) :: input_nml_file_in(:) character(len=*), intent(in) :: fn_nml -real(kind=kind_dbl_prec), intent(in) :: xlon(:,:) -real(kind=kind_dbl_prec), intent(in) :: xlat(:,:) +real(kind=kind_phys), intent(in) :: xlon(:,:) +real(kind=kind_phys), intent(in) :: xlat(:,:) logical, intent(in) :: do_sppt_in, do_shum_in, do_skeb_in ,do_spp_in integer, intent(in) :: lndp_type_in, n_var_lndp_in integer, intent(in) :: n_var_spp_in -real(kind=kind_dbl_prec), intent(in) :: ak(:), bk(:) +real(kind=kind_phys), intent(in) :: ak(:), bk(:) logical, intent(out) :: use_zmtnblck_out integer, intent(out) :: skeb_npass_out character(len=3), dimension(:), intent(out) :: lndp_var_list_out -real(kind=kind_dbl_prec), dimension(:), intent(out) :: lndp_prt_list_out +real(kind=kind_phys), dimension(:), intent(out) :: lndp_prt_list_out character(len=3), dimension(:), intent(out) :: spp_var_list_out -real(kind=kind_dbl_prec), dimension(:), intent(out) :: spp_prt_list_out -real(kind=kind_dbl_prec), dimension(:), intent(out) :: spp_stddev_cutoff_out +real(kind=kind_phys), dimension(:), intent(out) :: spp_prt_list_out +real(kind=kind_phys), dimension(:), intent(out) :: spp_stddev_cutoff_out ! Local variables -real(kind=kind_dbl_prec), parameter :: con_pi =4.0d0*atan(1.0d0) +real(kind=kind_phys), parameter :: con_pi =4.0d0*atan(1.0d0) integer :: nblks,len real*8 :: PRSI(levs),PRSL(levs),dx real, allocatable :: skeb_vloc(:) @@ -275,7 +275,7 @@ subroutine init_stochastic_physics_ocn(delt,geoLonT,geoLatT,nx,ny,nz,pert_epbl_i logical,intent(in) :: pert_epbl_in,do_sppt_in integer,intent(in) :: mpiroot, mpicomm integer, intent(out) :: iret -real(kind=kind_dbl_prec), parameter :: con_pi =4.0d0*atan(1.0d0) +real(kind=kind_phys), parameter :: con_pi =4.0d0*atan(1.0d0) real :: dx integer :: k,latghf,km @@ -349,17 +349,17 @@ subroutine run_stochastic_physics(levs, kdt, fhour, blksz, sppt_wts, shum_wts, s ! Interface variables integer, intent(in) :: levs, kdt -real(kind=kind_dbl_prec), intent(in) :: fhour +real(kind=kind_phys), intent(in) :: fhour integer, intent(in) :: blksz(:) -real(kind=kind_dbl_prec), intent(inout) :: sppt_wts(:,:,:) -real(kind=kind_dbl_prec), intent(inout) :: shum_wts(:,:,:) -real(kind=kind_dbl_prec), intent(inout) :: skebu_wts(:,:,:) -real(kind=kind_dbl_prec), intent(inout) :: skebv_wts(:,:,:) -real(kind=kind_dbl_prec), intent(inout) :: sfc_wts(:,:,:) -real(kind=kind_dbl_prec), intent(inout) :: spp_wts(:,:,:,:) +real(kind=kind_phys), intent(inout) :: sppt_wts(:,:,:) +real(kind=kind_phys), intent(inout) :: shum_wts(:,:,:) +real(kind=kind_phys), intent(inout) :: skebu_wts(:,:,:) +real(kind=kind_phys), intent(inout) :: skebv_wts(:,:,:) +real(kind=kind_phys), intent(inout) :: sfc_wts(:,:,:) +real(kind=kind_phys), intent(inout) :: spp_wts(:,:,:,:) integer, intent(in) :: nthreads -real,allocatable :: tmp_wts(:,:),tmpu_wts(:,:,:),tmpv_wts(:,:,:),tmpl_wts(:,:,:),tmp_spp_wts(:,:,:) +real(kind_dbl_prec),allocatable :: tmp_wts(:,:),tmpu_wts(:,:,:),tmpv_wts(:,:,:),tmpl_wts(:,:,:),tmp_spp_wts(:,:,:) !D-grid integer :: k,v integer j,ierr,i @@ -476,7 +476,7 @@ subroutine run_stochastic_physics_ocn(sppt_wts,t_rp1,t_rp2) implicit none !type(ocean_grid_type), intent(in) :: G real, intent(inout) :: sppt_wts(:,:),t_rp1(:,:),t_rp2(:,:) -real, allocatable :: tmp_wts(:,:) +real(kind_dbl_prec), allocatable :: tmp_wts(:,:) if (pert_epbl .OR. do_ocnsppt) then allocate(tmp_wts(gis_stochy_ocn%nx,gis_stochy_ocn%ny)) if (pert_epbl) then diff --git a/stochy_data_mod.F90 b/stochy_data_mod.F90 index 837587e..8eb4aaf 100644 --- a/stochy_data_mod.F90 +++ b/stochy_data_mod.F90 @@ -16,6 +16,8 @@ module stochy_data_mod use mersenne_twister, only : random_seed use compns_stochy_mod, only : compns_stochy + use kinddef, only: kind_phys + implicit none private public :: init_stochdata,init_stochdata_ocn @@ -31,12 +33,12 @@ module stochy_data_mod integer, public :: nspp =0 ! this is the number of different patterns (determined by the tau/lscale input) real*8, public,allocatable :: sl(:) - real(kind=kind_dbl_prec),public, allocatable :: vfact_sppt(:),vfact_shum(:),vfact_skeb(:),vfact_spp(:) - real(kind=kind_dbl_prec),public, allocatable :: skeb_vwts(:,:) + real(kind=kind_phys),public, allocatable :: vfact_sppt(:),vfact_shum(:),vfact_skeb(:),vfact_spp(:) + real(kind=kind_phys),public, allocatable :: skeb_vwts(:,:) integer ,public, allocatable :: skeb_vpts(:,:) real(kind=kind_dbl_prec),public, allocatable :: gg_lats(:),gg_lons(:) real(kind=kind_dbl_prec),public :: wlon,rnlat,rad2deg - real(kind=kind_dbl_prec),public, allocatable :: skebu_save(:,:,:),skebv_save(:,:,:) + real(kind=kind_phys),public, allocatable :: skebu_save(:,:,:),skebv_save(:,:,:) integer,public :: INTTYP type(stochy_internal_state),public :: gis_stochy,gis_stochy_ocn @@ -53,7 +55,7 @@ subroutine init_stochdata(nlevs,delt,input_nml_file,fn_nml,nlunit,iret) integer, intent(in) :: nlunit,nlevs character(len=*), intent(in) :: input_nml_file(:) character(len=64), intent(in) :: fn_nml - real, intent(in) :: delt + real(kind_phys), intent(in) :: delt integer, intent(out) :: iret real :: ones(5) @@ -62,7 +64,7 @@ subroutine init_stochdata(nlevs,delt,input_nml_file,fn_nml,nlunit,iret) integer :: locl,indev,indod,indlsod,indlsev integer :: l,jbasev,jbasod integer :: jcapin,varid1,varid2 - real(kind_dbl_prec),allocatable :: noise_e(:,:),noise_o(:,:) + real(kind_phys),allocatable :: noise_e(:,:),noise_o(:,:) include 'function_indlsod' include 'function_indlsev' include 'netcdf.inc' @@ -72,7 +74,7 @@ subroutine init_stochdata(nlevs,delt,input_nml_file,fn_nml,nlunit,iret) iret=0 ! read in namelist - call compns_stochy (mype,size(input_nml_file,1),input_nml_file(:),fn_nml,nlunit,delt,iret) + call compns_stochy (mype,size(input_nml_file,1),input_nml_file(:),fn_nml,nlunit,real(delt,kind=kind_phys),iret) if (iret/=0) return ! need to make sure that non-zero irets are being trapped. if ( (.NOT. do_sppt) .AND. (.NOT. do_shum) .AND. (.NOT. do_skeb) .AND. (lndp_type==0) .AND. (.NOT. do_spp)) return @@ -376,7 +378,7 @@ subroutine init_stochdata(nlevs,delt,input_nml_file,fn_nml,nlunit,iret) endif endif ones = 1. - call patterngenerator_init(lndp_lscale(1:nlndp),delt,lndp_tau(1:nlndp),ones(1:nlndp),iseed_lndp,rpattern_sfc, & + call patterngenerator_init(lndp_lscale(1:nlndp),real(delt,kind_phys),lndp_tau(1:nlndp),ones(1:nlndp),iseed_lndp,rpattern_sfc, & lonf,latg,jcap,gis_stochy%ls_node,nlndp,n_var_lndp,0,new_lscale) do n=1,nlndp if (is_rootpe()) print *, 'Initialize random pattern for LNDP PERTS' @@ -431,7 +433,7 @@ subroutine init_stochdata(nlevs,delt,input_nml_file,fn_nml,nlunit,iret) endif endif ones = 1. - call patterngenerator_init(spp_lscale(1:nspp),delt,spp_tau(1:nspp),ones(1:nspp),iseed_spp,rpattern_spp, & + call patterngenerator_init(spp_lscale(1:nspp),real(delt,kind_phys),spp_tau(1:nspp),ones(1:nspp),iseed_spp,rpattern_spp, & lonf,latg,jcap,gis_stochy%ls_node,nspp,n_var_spp,0,new_lscale) do n=1,nspp if (is_rootpe()) print *, 'Initialize random pattern for SPP PERTS' @@ -485,7 +487,7 @@ subroutine init_stochdata_ocn(nlevs,delt,iret) integer :: l,jbasev,jbasod integer :: indev,indod,indlsod,indlsev,varid1,varid2,varid3,varid4,ierr - real(kind_dbl_prec),allocatable :: noise_e(:,:),noise_o(:,:) + real(kind_phys),allocatable :: noise_e(:,:),noise_o(:,:) include 'function_indlsod' include 'function_indlsev' include 'netcdf.inc' @@ -700,8 +702,8 @@ subroutine read_pattern(rpattern,jcapin,lunptn,k,np,varid1,varid2,slice_of_3d,ir type(random_pattern), intent(inout) :: rpattern integer, intent(in) :: lunptn,np,varid1,varid2,jcapin logical, intent(in) :: slice_of_3d - real(kind_dbl_prec),allocatable :: pattern2d(:),pattern2din(:) - real(kind_dbl_prec) :: stdevin,varin + real(kind_phys),allocatable :: pattern2d(:),pattern2din(:) + real(kind_phys) :: stdevin,varin integer nm,nn,iret,ierr,isize,k,ndimspec2 integer, allocatable :: isave(:) include 'netcdf.inc' diff --git a/stochy_internal_state_mod.F90 b/stochy_internal_state_mod.F90 index cbd8c44..6d2c41b 100644 --- a/stochy_internal_state_mod.F90 +++ b/stochy_internal_state_mod.F90 @@ -21,7 +21,7 @@ module stochy_internal_state_mod !------ ! use spectral_layout_mod - + use kinddef implicit none private @@ -45,24 +45,24 @@ module stochy_internal_state_mod integer ,allocatable :: global_lats_h (:) integer :: xhalo,yhalo - real,allocatable :: epse (:) - real,allocatable :: epso (:) - real,allocatable :: epsedn(:) - real,allocatable :: epsodn(:) - real,allocatable :: kenorm_e(:) - real,allocatable :: kenorm_o(:) + real(kind_dbl_prec),allocatable :: epse (:) + real(kind_dbl_prec),allocatable :: epso (:) + real(kind_dbl_prec),allocatable :: epsedn(:) + real(kind_dbl_prec),allocatable :: epsodn(:) + real(kind_dbl_prec),allocatable :: kenorm_e(:) + real(kind_dbl_prec),allocatable :: kenorm_o(:) - real,allocatable :: snnp1ev(:) - real,allocatable :: snnp1od(:) + real(kind_dbl_prec),allocatable :: snnp1ev(:) + real(kind_dbl_prec),allocatable :: snnp1od(:) - real,allocatable :: plnev_a(:,:) - real,allocatable :: plnod_a(:,:) - real,allocatable :: plnew_a(:,:) - real,allocatable :: plnow_a(:,:) + real(kind_dbl_prec),allocatable :: plnev_a(:,:) + real(kind_dbl_prec),allocatable :: plnod_a(:,:) + real(kind_dbl_prec),allocatable :: plnew_a(:,:) + real(kind_dbl_prec),allocatable :: plnow_a(:,:) - real,allocatable :: trie_ls(:,:,:) - real,allocatable :: trio_ls(:,:,:) + real(kind_dbl_prec),allocatable :: trie_ls(:,:,:) + real(kind_dbl_prec),allocatable :: trio_ls(:,:,:) integer lotls integer nlunit @@ -71,7 +71,7 @@ module stochy_internal_state_mod integer lan,lat integer nx,ny,nz integer, allocatable :: len(:) - real, allocatable :: parent_lons(:,:),parent_lats(:,:) + real(kind_dbl_prec), allocatable :: parent_lons(:,:),parent_lats(:,:) ! diff --git a/stochy_namelist_def.F90 b/stochy_namelist_def.F90 index 1afc5d0..a6f8728 100644 --- a/stochy_namelist_def.F90 +++ b/stochy_namelist_def.F90 @@ -18,35 +18,35 @@ module stochy_namelist_def integer skeb_varspect_opt,skeb_npass logical sppt_sfclimit - real(kind=kind_dbl_prec) :: skeb_sigtop1,skeb_sigtop2, & + real(kind=kind_phys) :: skeb_sigtop1,skeb_sigtop2, & sppt_sigtop1,sppt_sigtop2,shum_sigefold, & skeb_vdof - real(kind=kind_dbl_prec) skeb_diss_smooth,epblint,ocnspptint,spptint,shumint,skebint,skebnorm - real(kind=kind_dbl_prec), dimension(5) :: skeb,skeb_lscale,skeb_tau - real(kind=kind_dbl_prec), dimension(5) :: sppt,sppt_lscale,sppt_tau - real(kind=kind_dbl_prec), dimension(5) :: shum,shum_lscale,shum_tau - real(kind=kind_dbl_prec), dimension(5) :: epbl,epbl_lscale,epbl_tau - real(kind=kind_dbl_prec), dimension(5) :: ocnsppt,ocnsppt_lscale,ocnsppt_tau + real(kind=kind_phys) skeb_diss_smooth,epblint,ocnspptint,spptint,shumint,skebint,skebnorm + real(kind=kind_phys), dimension(5) :: skeb,skeb_lscale,skeb_tau + real(kind=kind_phys), dimension(5) :: sppt,sppt_lscale,sppt_tau + real(kind=kind_phys), dimension(5) :: shum,shum_lscale,shum_tau + real(kind=kind_phys), dimension(5) :: epbl,epbl_lscale,epbl_tau + real(kind=kind_phys), dimension(5) :: ocnsppt,ocnsppt_lscale,ocnsppt_tau integer,dimension(5) ::skeb_vfilt - integer(kind=kind_dbl_prec),dimension(5) ::iseed_sppt,iseed_shum,iseed_skeb,iseed_epbl,iseed_ocnsppt,iseed_epbl2 + integer(kind=8),dimension(5) ::iseed_sppt,iseed_shum,iseed_skeb,iseed_epbl,iseed_ocnsppt,iseed_epbl2 logical stochini,sppt_logit,new_lscale logical use_zmtnblck logical do_shum,do_sppt,do_skeb,pert_epbl,do_ocnsppt,do_spp - real(kind=kind_dbl_prec), dimension(5) :: lndp_lscale,lndp_tau + real(kind=kind_phys), dimension(5) :: lndp_lscale,lndp_tau integer n_var_lndp - integer(kind=kind_dbl_prec),dimension(5) ::iseed_lndp + integer(kind=8),dimension(5) ::iseed_lndp integer lndp_type integer lndp_model_type character(len=3), dimension(max_n_var_lndp) :: lndp_var_list - real(kind=kind_dbl_prec), dimension(max_n_var_lndp) :: lndp_prt_list + real(kind=kind_phys), dimension(max_n_var_lndp) :: lndp_prt_list - real(kind=kind_dbl_prec), dimension(max_n_var_spp) :: spp_lscale & + real(kind=kind_phys), dimension(max_n_var_spp) :: spp_lscale & & , spp_tau,spp_stddev_cutoff & & , spp_sigtop1, spp_sigtop2 integer n_var_spp integer(8),dimension(max_n_var_spp) ::iseed_spp character(len=3), dimension(max_n_var_spp) :: spp_var_list - real(kind=kind_dbl_prec), dimension(max_n_var_spp) :: spp_prt_list + real(kind=kind_phys), dimension(max_n_var_spp) :: spp_prt_list end module stochy_namelist_def diff --git a/stochy_patterngenerator.F90 b/stochy_patterngenerator.F90 index 7060765..c1d2ffb 100644 --- a/stochy_patterngenerator.F90 +++ b/stochy_patterngenerator.F90 @@ -24,12 +24,12 @@ module stochy_patterngenerator_mod !>@details A seperate instance of this type is needed for each pattern type,public :: random_pattern ! start type define ! ----------------------------------------------- - real(kind_dbl_prec), public :: lengthscale ! length scale in m - real(kind_dbl_prec), public :: tau - real(kind_dbl_prec), public :: dt - real(kind_dbl_prec), public :: phi - real(kind_dbl_prec), public :: stdev - real(kind_evod), allocatable, dimension(:), public :: varspectrum, varspectrum1d, lap + real(kind_phys), public :: lengthscale ! length scale in m + real(kind_phys), public :: tau + real(kind_phys), public :: dt + real(kind_phys), public :: phi + real(kind_phys), public :: stdev + real(kind_dbl_prec), allocatable, dimension(:), public :: varspectrum, varspectrum1d, lap integer, allocatable, dimension(:), public ::& degree,order,idx_e,idx_o integer, allocatable, dimension(:,:), public :: idx @@ -51,7 +51,7 @@ subroutine patterngenerator_init(lscale, delt, tscale, stdev, iseed, rpattern,& nlon, nlat, jcap, ls_nodes, npatterns,& nlevs, varspect_opt,new_lscale) !\callgraph - real(kind_dbl_prec), intent(in),dimension(npatterns) :: lscale,tscale,stdev + real(kind_phys), intent(in),dimension(npatterns) :: lscale,tscale,stdev real, intent(in) :: delt integer, intent(in) :: nlon,nlat,jcap,npatterns,varspect_opt integer, intent(in) :: ls_nodes(ls_dim,3),nlevs @@ -200,8 +200,8 @@ end subroutine patterngenerator_destroy subroutine computevarspec(rpattern,dataspec,var) !\callgraph ! compute globally integrated variance from spectral coefficients - complex(kind_evod), intent(in) :: dataspec(ndimspec) - real(kind_evod), intent(out) :: var + complex(kind_dbl_prec), intent(in) :: dataspec(ndimspec) + real(kind_dbl_prec), intent(out) :: var type(random_pattern), intent(in) :: rpattern integer n var = 0. @@ -220,8 +220,8 @@ end subroutine computevarspec subroutine computevarspec_r(rpattern,dataspec,var) !\callgraph ! compute globally integrated variance from spectral coefficients - real(kind_dbl_prec), intent(in) :: dataspec(2*ndimspec) - real(kind_dbl_prec), intent(out) :: var + real(kind_phys), intent(in) :: dataspec(2*ndimspec) + real(kind_phys), intent(out) :: var type(random_pattern), intent(in) :: rpattern integer n var = 0. @@ -239,11 +239,11 @@ end subroutine computevarspec_r !! variance from real spectral c subroutine getnoise(rpattern,noise_e,noise_o) !\callgraph - real(kind_dbl_prec), intent(out) :: noise_e(len_trie_ls,2) - real(kind_dbl_prec), intent(out) :: noise_o(len_trio_ls,2) + real(kind_phys), intent(out) :: noise_e(len_trie_ls,2) + real(kind_phys), intent(out) :: noise_o(len_trio_ls,2) ! generate white noise with unit variance in spectral space type(random_pattern), intent(inout) :: rpattern - real :: noise(2*ndimspec) + real(kind_dbl_prec) :: noise(2*ndimspec) integer nm,nn call random_gauss(noise,rpattern%rstate) noise(1) = 0.; noise(ndimspec+1) = 0. @@ -278,8 +278,8 @@ subroutine patterngenerator_advance(rpattern,k,skeb_first_call) ! advance 1st-order autoregressive process with ! specified autocorrelation (phi) and variance spectrum (spectrum) - real(kind_dbl_prec) :: noise_e(len_trie_ls,2) - real(kind_dbl_prec) :: noise_o(len_trio_ls,2) + real(kind_phys) :: noise_e(len_trie_ls,2) + real(kind_phys) :: noise_o(len_trio_ls,2) type(random_pattern), intent(inout) :: rpattern logical, intent(in) :: skeb_first_call integer j,l,n,nn,nm,k,k2 @@ -317,8 +317,8 @@ subroutine setvarspect(rpattern,varspect_opt,new_lscale) integer, intent(in) :: varspect_opt logical, intent(in) :: new_lscale integer :: n - complex(kind_evod) noise(ndimspec) - real(kind_evod) var,rerth,inv_rerth_sq + complex(kind_dbl_prec) noise(ndimspec) + real(kind_dbl_prec) var,rerth,inv_rerth_sq rerth =6.3712e+6 ! radius of earth (m) inv_rerth_sq=1.0/(rerth**2) ! 1d variance spectrum (as a function of total wavenumber) @@ -364,8 +364,8 @@ end subroutine setvarspect !! restarting from a higher-resolution pattern subroutine chgres_pattern(pattern2din,pattern2dout,ntruncin,ntruncout) !\callgraph - real(kind_dbl_prec), intent(in) :: pattern2din((ntruncin+1)*(ntruncin+2)) - real(kind_dbl_prec), intent(out) :: pattern2dout((ntruncout+1)*(ntruncout+2)) + real(kind_phys), intent(in) :: pattern2din((ntruncin+1)*(ntruncin+2)) + real(kind_phys), intent(out) :: pattern2dout((ntruncout+1)*(ntruncout+2)) integer, intent(in) :: ntruncin,ntruncout integer :: m,n,nm,ndimsspecin,ndimsspecout integer,allocatable, dimension(:,:):: idxin diff --git a/update_ca.F90 b/update_ca.F90 index 485a89b..46cd751 100644 --- a/update_ca.F90 +++ b/update_ca.F90 @@ -3,7 +3,7 @@ module update_ca !read and write restart routines, to restart fields !on the ncellsxncells CA grid -use kinddef, only: kind_dbl_prec +use kinddef use halo_exchange, only: atmosphere_scalar_field_halo use random_numbers, only: random_01_CB use mpi_wrapper, only: mype,mp_reduce_min,mp_reduce_max @@ -284,13 +284,13 @@ subroutine update_cells_sgs(kstep,initialize_ca,iseed_ca,first_flag,restart,firs implicit none integer, intent(in) :: kstep,nxc,nyc,nlon,nlat,nxch,nych,nca,isc,iec,jsc,jec,npx,npy -integer(kind=kind_dbl_prec), intent(in) :: iseed_ca +integer(8), intent(in) :: iseed_ca integer, intent(in) :: iini(nxc,nyc,nca),initialize_ca,ilives_in(nxc,nyc,nca) integer, intent(in) :: mytile -real, intent(out) :: CA(nlon,nlat) +real(kind_phys), intent(out) :: CA(nlon,nlat) integer, intent(out) :: ca_plumes(nlon,nlat) integer, intent(in) :: nlives,nseed, nspinup, nf,ncells -real, intent(in) :: nfracseed +real(kind_phys), intent(in) :: nfracseed logical, intent(in) :: nca_plumes,restart,first_flag,first_time_step integer, allocatable :: V(:),L(:),B(:) integer, allocatable :: AG(:,:) @@ -578,7 +578,7 @@ subroutine update_cells_global(kstep,first_time_step,iseed_ca,restart,nca,nxc,ny integer, intent(in) :: kstep,nxc,nyc,nlon,nlat,nxch,nych,nca,isc,iec,jsc,jec,npx,npy integer, intent(in) :: iini_g(nxc,nyc,nca), ilives_g(nxc,nyc) -integer(kind=kind_dbl_prec), intent(in) :: iseed_ca +integer(8), intent(in) :: iseed_ca real, intent(out) :: CA(nlon,nlat) logical, intent(in) :: first_time_step logical, intent(in) :: restart