Skip to content

Commit

Permalink
Merge pull request #30 from aerorahul/feature/overload
Browse files Browse the repository at this point in the history 
Preparation for S2S cmake: CMakeLists and OpenMP
  • Loading branch information
@pjpegion
pjpegion authored Oct 7, 2020
2 parents ffdd19b + 0d35aa2 commit 6eac845
Show file tree
Hide file tree
Showing 2 changed files with 72 additions and 72 deletions.
101 changes: 52 additions & 49 deletions CMakeLists.txt
View file
Original file line number Diff line number Diff line change
@@ -1,61 +1,64 @@
if(32BIT)
remove_definitions(-DOVERLOAD_R4)
remove_definitions(-DOVERLOAD_R8)
message ("Force 64 bits in stochastic_physics")
if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel")
message ("Force 64 bits in stochastic_physics")
if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel")
if(REPRO)
string (REPLACE "-i4 -real-size 32" "-i4 -real-size 64" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}")
string (REPLACE "-i4 -real-size 32" "-i4 -real-size 64" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}")
else()
string (REPLACE "-i4 -real-size 32" "-i4 -real-size 64 -no-prec-div -no-prec-sqrt" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}")
string (REPLACE "-i4 -real-size 32" "-i4 -real-size 64 -no-prec-div -no-prec-sqrt" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}")
endif()
elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU")
elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8")
endif()
endif()
endif()

add_library(
stochastic_physics

./kinddef.F90
./mpi_wrapper.F90
./halo_exchange.fv3.F90
./plumes.f90
list(APPEND _stoch_phys_srcs
kinddef.F90
mpi_wrapper.F90
halo_exchange.fv3.F90
plumes.f90

./stochy_gg_def.f
./stochy_resol_def.f
./stochy_layout_lag.f
./four_to_grid_stochy.F
./glats_stochy.f
./sumfln_stochy.f
./gozrineo_stochy.f
./num_parthds_stochy.f
./get_ls_node_stochy.f
./get_lats_node_a_stochy.f
./setlats_a_stochy.f
./setlats_lag_stochy.f
./epslon_stochy.f
./getcon_lag_stochy.f
./pln2eo_stochy.f
./dozeuv_stochy.f
./dezouv_stochy.f
./mersenne_twister.F
stochy_gg_def.f
stochy_resol_def.f
stochy_layout_lag.f
four_to_grid_stochy.F
glats_stochy.f
sumfln_stochy.f
gozrineo_stochy.f
num_parthds_stochy.f
get_ls_node_stochy.f
get_lats_node_a_stochy.f
setlats_a_stochy.f
setlats_lag_stochy.f
epslon_stochy.f
getcon_lag_stochy.f
pln2eo_stochy.f
dozeuv_stochy.f
dezouv_stochy.f
mersenne_twister.F

./spectral_layout.F90
./getcon_spectral.F90
./stochy_namelist_def.F90
./compns_stochy.F90
./stochy_internal_state_mod.F90
./stochastic_physics.F90
./stochy_patterngenerator.F90
./stochy_data_mod.F90
./get_stochy_pattern.F90
./initialize_spectral_mod.F90
./cellular_automata_global.F90
./cellular_automata_sgs.F90
./update_ca.F90
./lndp_apply_perts.F90
spectral_layout.F90
getcon_spectral.F90
stochy_namelist_def.F90
compns_stochy.F90
stochy_internal_state_mod.F90
stochastic_physics.F90
stochy_patterngenerator.F90
stochy_data_mod.F90
get_stochy_pattern.F90
initialize_spectral_mod.F90
cellular_automata_global.F90
cellular_automata_sgs.F90
update_ca.F90
lndp_apply_perts.F90
)

target_link_libraries(stochastic_physics sp::sp_d)
target_link_libraries(stochastic_physics fms)
add_library(stochastic_physics ${_stoch_phys_srcs})
add_dependencies(stochastic_physics fms)

target_compile_definitions(stochastic_physics PRIVATE INTERNAL_FILE_NML)

target_link_libraries(stochastic_physics PUBLIC sp::sp_d)
target_link_libraries(stochastic_physics PUBLIC fms)
if(OpenMP_Fortran_FOUND)
target_link_libraries(stochastic_physics PUBLIC OpenMP::OpenMP_Fortran)
endif()
43 changes: 20 additions & 23 deletions atmosphere_stub.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -87,12 +87,9 @@ module atmosphere_stub_mod


!>@brief The subroutine 'atmosphere_init' is an API to initialize the FV3 dynamical core,
!! including the grid structures, memory, initial state (self-initialization or restart),
!! and diagnostics.
!! including the grid structures, memory, initial state (self-initialization or restart),
!! and diagnostics.
subroutine atmosphere_init_stub (Grid_box, area)
#ifdef OPENMP
use omp_lib
#endif
type(grid_box_type), intent(inout) :: Grid_box
real*8, pointer, dimension(:,:), intent(inout) :: area
!--- local variables ---
Expand Down Expand Up @@ -172,19 +169,19 @@ subroutine atmosphere_init_stub (Grid_box, area)

call timing_off('ATMOS_INIT')


end subroutine atmosphere_init_stub

! subroutine atmosphere_smooth_noise (wnoise,npass,ns_type,renorm_type)
!
!
! !--- interface variables ---
! real,intent(inout) :: wnoise(isd:ied,jsd:jed,1)
! integer, intent(in) :: npass,ns_type,renorm_type
! !--- local variables
! integer:: i,j,nloops,nlast
! real ::inflation(isc:iec,jsc:jec),inflation2
! ! scale factor for restoring inflation
! ! logic:
! ! logic:
! ! if box mean: scalar get basic scaling, vector gets 1/grid dependent scaling 0-0 ; 0 - 1
! ! if box mean2: no scaling
! ! if del2 : scalar gets grid dependent scaling,vector get basic scaling 1 0; 1 1
Expand All @@ -202,14 +199,14 @@ end subroutine atmosphere_init_stub
! inflation(i,j)=inflation2*Atm(mytile)%gridstruct%dxAV/(0.5*(Atm(mytile)%gridstruct%dx(i,j)+Atm(mytile)%gridstruct%dy(i,j)))
! enddo
! enddo
! else
! else
! if ( renorm_type.EQ.1) then ! box smooth does not need scaling for scalar
! do j=jsc,jec
! do i=isc,iec
! inflation(i,j)=inflation2
! enddo
! enddo
! else
! else
! ! box mean needs inversize grid-size scaling for vector
! do j=jsc,jec
! do i=isc,iec
Expand All @@ -221,7 +218,7 @@ end subroutine atmosphere_init_stub
! endif
! nloops=npass/3
! nlast=mod(npass,3)
! do j=1,nloops
! do j=1,nloops
! if (ns_type.EQ.1) then
! !call del2_cubed(wnoise , 0.25*Atm(mytile)%gridstruct%da_min, Atm(mytile)%gridstruct, &
! call del2_cubed(wnoise , 0.20*Atm(mytile)%gridstruct%da_min, Atm(mytile)%gridstruct, &
Expand Down Expand Up @@ -272,8 +269,8 @@ end subroutine atmosphere_init_stub
! call make_c_winds(ua, va, psi,Atm(mytile)%ng,Atm(mytile)%gridstruct,Atm(mytile)%bd,Atm(mytile)%npx,Atm(mytile)%npy)
!! populate wind perturbations right here
! do k=1,km
! Atm(mytile)%urandom_c(isc:iec+edge,jsc:jec ,k)=ua*vwts(k)
! Atm(mytile)%vrandom_c(isc:iec ,jsc:jec+edge,k)=va*vwts(k)
! Atm(mytile)%urandom_c(isc:iec+edge,jsc:jec ,k)=ua*vwts(k)
! Atm(mytile)%vrandom_c(isc:iec ,jsc:jec+edge,k)=va*vwts(k)
! enddo
! !call mpp_update_domains(Atm(mytile)%urandom_c, Atm(mytile)%domain, complete=.true.)
! !call mpp_update_domains(Atm(mytile)%vrandom_c, Atm(mytile)%domain, complete=.true.)
Expand Down Expand Up @@ -320,7 +317,7 @@ subroutine del2_cubed(q, cd, gridstruct, domain, npx, npy, km, nmax, bd)

do n=1,ntimes
nt = ntimes - n

!$OMP parallel do default(none) shared(km,q,is,ie,js,je,npx,npy, &
!$OMP nt,isd,jsd,gridstruct,bd, &
!$OMP cd) &
Expand Down Expand Up @@ -575,7 +572,7 @@ subroutine make_a_winds(ua, va, psi, ng, gridstruct, bd, npx, npy)
type(fv_grid_type), intent(IN), target :: gridstruct
! Local:
real, dimension(bd%isd:bd%ied,bd%jsd:bd%jed) :: wk
real, dimension(bd%isc:bd%iec,bd%jsc:bd%jec) :: u,v
real, dimension(bd%isc:bd%iec,bd%jsc:bd%jec) :: u,v
integer i,j

integer :: is, ie, js, je
Expand Down Expand Up @@ -614,7 +611,7 @@ subroutine make_c_winds(uc, vc, psi, ng, gridstruct, bd, npx, npy)
type(fv_grid_type), intent(IN), target :: gridstruct
! Local:
real, dimension(bd%isd:bd%ied,bd%jsd:bd%jed) :: wk
real, dimension(bd%isc:bd%iec,bd%jsc:bd%jec) :: u,v
real, dimension(bd%isc:bd%iec,bd%jsc:bd%jec) :: u,v
integer i,j

integer :: is, ie, js, je
Expand All @@ -637,8 +634,8 @@ subroutine make_c_winds(uc, vc, psi, ng, gridstruct, bd, npx, npy)

end subroutine make_c_winds

!>@brief The subroutine 'atmospehre_resolution' is an API to return the local
!! extents of the current MPI-rank or the global extents of the current
!>@brief The subroutine 'atmospehre_resolution' is an API to return the local
!! extents of the current MPI-rank or the global extents of the current
!! cubed-sphere tile.
subroutine atmosphere_resolution (i_size, j_size, global)
integer, intent(out) :: i_size, j_size
Expand All @@ -657,7 +654,7 @@ subroutine atmosphere_resolution (i_size, j_size, global)
end if
end subroutine atmosphere_resolution
!>@brief The subroutine 'atmosphere_domain' is an API to return
!! the "domain2d" variable associated with the coupling grid and the
!! the "domain2d" variable associated with the coupling grid and the
!! decomposition for the current cubed-sphere tile.
!>@detail Coupling is done using the mass/temperature grid with no halos.
subroutine atmosphere_domain ( fv_domain, layout, regional, nested, pelist )
Expand All @@ -683,10 +680,10 @@ subroutine set_atmosphere_pelist ()
end subroutine set_atmosphere_pelist


!>@brief The subroutine 'atmosphere_scalar_field_halo' is an API to return halo information
!>@brief The subroutine 'atmosphere_scalar_field_halo' is an API to return halo information
!! of the current MPI_rank for an input scalar field.
!>@detail Up to three point haloes can be returned by this API which includes special handling for
!! the cubed-sphere tile corners. Output will be in (i,j,k) while input can be in (i,j,k) or
!! the cubed-sphere tile corners. Output will be in (i,j,k) while input can be in (i,j,k) or
!! horizontally-packed form (ix,k).
subroutine atmosphere_scalar_field_halo (data, halo, isize, jsize, ksize, data_p)
!--------------------------------------------------------------------
Expand All @@ -697,7 +694,7 @@ subroutine atmosphere_scalar_field_halo (data, halo, isize, jsize, ksize, data_p
! ied - horizontal resolution in i-dir with haloes
! jed - horizontal resolution in j-dir with haloes
! ksize - vertical resolution
! data_p - optional input field in packed format (ix,k)
! 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)
Expand Down Expand Up @@ -745,7 +742,7 @@ subroutine atmosphere_scalar_field_halo (data, halo, isize, jsize, ksize, data_p
call mpp_error(FATAL, modname//' - unsupported halo size')
endif

!--- fill the halo points when at a corner of the cubed-sphere tile
!--- fill the halo points when at a corner of the cubed-sphere tile
!--- interior domain corners are handled correctly
if ( (isc==1) .or. (jsc==1) .or. (iec==npx-1) .or. (jec==npy-1) ) then
do k = 1, ksize
Expand Down

0 comments on commit 6eac845

Please sign in to comment.