Skip to content
Merged
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,6 @@ add_library(fv3atm
cpl/module_cap_cpl.F90
io/FV3GFS_io.F90
io/module_write_netcdf.F90
io/module_write_netcdf_parallel.F90
io/module_fv3_io_def.F90
io/module_write_internal_state.F90
io/module_wrt_grid_comp.F90
Expand Down
123 changes: 33 additions & 90 deletions atmos_model.F90
Original file line number Diff line number Diff line change
Expand Up @@ -74,7 +74,7 @@ module atmos_model_mod
use atmosphere_mod, only: atmosphere_scalar_field_halo
use atmosphere_mod, only: atmosphere_get_bottom_layer
use atmosphere_mod, only: set_atmosphere_pelist
use atmosphere_mod, only: Atm, mygrid
use atmosphere_mod, only: Atm, mygrid, get_nth_domain_info
use block_control_mod, only: block_control_type, define_blocks_packed
use DYCORE_typedefs, only: DYCORE_data_type, DYCORE_diag_type

Expand Down Expand Up @@ -113,6 +113,7 @@ module atmos_model_mod
public atmos_model_exchange_phase_1, atmos_model_exchange_phase_2
public atmos_model_restart
public get_atmos_model_ungridded_dim
public atmos_model_get_nth_domain_info
public addLsmask2grid
public setup_exportdata
!-----------------------------------------------------------------------
Expand All @@ -125,6 +126,8 @@ module atmos_model_mod
integer :: layout(2) ! computer task laytout
logical :: regional ! true if domain is regional
logical :: nested ! true if there is a nest
integer :: ngrids !
integer :: mygrid !
integer :: mlon, mlat
integer :: iau_offset ! iau running window length
logical :: pe ! current pe.
Expand Down Expand Up @@ -165,7 +168,6 @@ module atmos_model_mod
! DYCORE containers
!-------------------
type(DYCORE_data_type), allocatable :: DYCORE_Data(:) ! number of blocks
type(DYCORE_diag_type) :: DYCORE_Diag(25)

!----------------
! GFS containers
Expand Down Expand Up @@ -262,7 +264,7 @@ subroutine update_atmos_radiation_physics (Atmos)
if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_init step failed')

if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. &
GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then
GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca .or. GFS_Control%do_spp) then
!--- call stochastic physics pattern generation / cellular automata
call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr)
if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed')
Expand Down Expand Up @@ -380,7 +382,7 @@ subroutine update_atmos_radiation_physics (Atmos)
if(GFS_control%print_diff_pgr) then
call atmos_timestep_diagnostics(Atmos)
endif

! Update flag for first time step of time integration
GFS_control%first_time_step = .false.

Expand Down Expand Up @@ -444,7 +446,7 @@ subroutine atmos_timestep_diagnostics(Atmos)
enddo
pcount = pcount+count
enddo

! Sum pgr stats from psum/pcount and convert to hPa/hour global avg:
sendbuf(1:2) = (/ psum, pcount /)
call MPI_Allreduce(sendbuf,recvbuf,2,MPI_DOUBLE_PRECISION,MPI_SUM,GFS_Control%communicator,ierror)
Expand All @@ -454,7 +456,7 @@ subroutine atmos_timestep_diagnostics(Atmos)
sendbuf(1:2) = (/ maxabs, dble(GFS_Control%me) /)
call MPI_Allreduce(sendbuf,recvbuf,1,MPI_2DOUBLE_PRECISION,MPI_MAXLOC,GFS_Control%communicator,ierror)
call MPI_Bcast(pmaxloc,size(pmaxloc),MPI_DOUBLE_PRECISION,nint(recvbuf(2)),GFS_Control%communicator,ierror)

if(GFS_Control%me == GFS_Control%master) then
2933 format('At forecast hour ',F9.3,' mean abs pgr change is ',F16.8,' hPa/hr')
2934 format(' max abs change ',F15.10,' bar at tile=',I0,' i=',I0,' j=',I0)
Expand Down Expand Up @@ -491,23 +493,17 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
type (atmos_data_type), intent(inout) :: Atmos
type (time_type), intent(in) :: Time_init, Time, Time_step
!--- local variables ---
integer :: unit, ntdiag, ntfamily, i, j, k
integer :: mlon, mlat, nlon, nlat, nlev, sec, dt
integer :: unit, i
integer :: mlon, mlat, nlon, nlat, nlev, sec
integer :: ierr, io, logunit
integer :: idx, tile_num
integer :: tile_num
integer :: isc, iec, jsc, jec
integer :: isd, ied, jsd, jed
integer :: blk, ibs, ibe, jbs, jbe
real(kind=GFS_kind_phys) :: dt_phys
real, allocatable :: q(:,:,:,:), p_half(:,:,:)
character(len=80) :: control
character(len=64) :: filename, filename2, pelist_name
character(len=132) :: text
logical :: p_hydro, hydro, fexist
logical :: p_hydro, hydro
logical, save :: block_message = .true.
type(GFS_init_type) :: Init_parm
integer :: bdat(8), cdat(8)
integer :: ntracers, maxhf, maxh
integer :: ntracers
character(len=32), allocatable, target :: tracer_names(:)
integer, allocatable, target :: tracer_types(:)
integer :: nthrds, nb
Expand All @@ -533,7 +529,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
call atmosphere_resolution (nlon, nlat, global=.false.)
call atmosphere_resolution (mlon, mlat, global=.true.)
call alloc_atmos_data_type (nlon, nlat, Atmos)
call atmosphere_domain (Atmos%domain, Atmos%layout, Atmos%regional, Atmos%nested, Atmos%pelist)
call atmosphere_domain (Atmos%domain, Atmos%layout, Atmos%regional, Atmos%nested, Atmos%ngrids, Atmos%mygrid, Atmos%pelist)
call atmosphere_diag_axes (Atmos%axes)
call atmosphere_etalvls (Atmos%ak, Atmos%bk, flip=flip_vc)
call atmosphere_grid_bdry (Atmos%lon_bnd, Atmos%lat_bnd, global=.false.)
Expand All @@ -547,7 +543,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
!----------------------------------------------------------------------------------------------
! initialize atmospheric model - must happen AFTER atmosphere_init so that nests work correctly

IF ( file_exists('input.nml')) THEN
if (file_exists('input.nml')) then
read(input_nml_file, nml=atmos_model_nml, iostat=io)
ierr = check_nml_error(io, 'atmos_model_nml')
endif
Expand Down Expand Up @@ -635,19 +631,10 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
Init_parm%restart = Atm(mygrid)%flagstruct%warm_start
Init_parm%hydrostatic = Atm(mygrid)%flagstruct%hydrostatic

#ifdef INTERNAL_FILE_NML
! allocate required to work around GNU compiler bug 100886 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886
allocate(Init_parm%input_nml_file, mold=input_nml_file)
Init_parm%input_nml_file => input_nml_file
Init_parm%fn_nml='using internal file'
#else
pelist_name=mpp_get_current_pelist_name()
Init_parm%fn_nml='input_'//trim(pelist_name)//'.nml'
inquire(FILE=Init_parm%fn_nml, EXIST=fexist)
if (.not. fexist ) then
Init_parm%fn_nml='input.nml'
endif
#endif

call GFS_initialize (GFS_control, GFS_data%Statein, GFS_data%Stateout, GFS_data%Sfcprop, &
GFS_data%Coupling, GFS_data%Grid, GFS_data%Tbd, GFS_data%Cldprop, GFS_data%Radtend, &
Expand Down Expand Up @@ -711,7 +698,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP physics_init step failed')

if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. &
GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca) then
GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca .or. GFS_Control%do_spp) then

!--- Initialize stochastic physics pattern generation / cellular automata for first time step
call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr)
Expand Down Expand Up @@ -964,7 +951,7 @@ subroutine atmos_model_end (Atmos)
use update_ca, only: write_ca_restart
type (atmos_data_type), intent(inout) :: Atmos
!---local variables
integer :: idx, seconds, ierr
integer :: ierr

!-----------------------------------------------------------------------
!---- termination routine for atmospheric model ----
Expand All @@ -977,7 +964,7 @@ subroutine atmos_model_end (Atmos)
! call write_stoch_restart_atm('RESTART/atm_stoch.res.nc')
endif
if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. &
GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then
GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca .or. GFS_Control%do_spp) then
if(restart_endfcst) then
call write_stoch_restart_atm('RESTART/atm_stoch.res.nc')
if (GFS_control%do_ca)then
Expand All @@ -993,6 +980,8 @@ subroutine atmos_model_end (Atmos)
call CCPP_step (step="finalize", nblks=Atm_block%nblks, ierr=ierr)
if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP finalize step failed')

call dealloc_atmos_data_type (Atmos)

end subroutine atmos_model_end

! </SUBROUTINE>
Expand Down Expand Up @@ -1541,53 +1530,6 @@ subroutine update_atmos_chemistry(state, rc)
end select

end subroutine update_atmos_chemistry
! </SUBROUTINE>

!#######################################################################
! <SUBROUTINE NAME="atmos_data_type_chksum">
!
! <OVERVIEW>
! Print checksums of the various fields in the atmos_data_type.
! </OVERVIEW>

! <DESCRIPTION>
! Routine to print checksums of the various fields in the atmos_data_type.
! </DESCRIPTION>

! <TEMPLATE>
! call atmos_data_type_chksum(id, timestep, atm)
! </TEMPLATE>

! <IN NAME="Atm" TYPE="type(atmos_data_type)">
! Derived-type variable that contains fields in the atmos_data_type.
! </INOUT>
!
! <IN NAME="id" TYPE="character">
! Label to differentiate where this routine in being called from.
! </IN>
!
! <IN NAME="timestep" TYPE="integer">
! An integer to indicate which timestep this routine is being called for.
! </IN>
!
subroutine atmos_data_type_chksum(id, timestep, atm)
type(atmos_data_type), intent(in) :: atm
character(len=*), intent(in) :: id
integer , intent(in) :: timestep
integer :: n, outunit

100 format("CHECKSUM::",A32," = ",Z20)
101 format("CHECKSUM::",A16,a,'%',a," = ",Z20)

outunit = stdout()
write(outunit,*) 'BEGIN CHECKSUM(Atmos_data_type):: ', id, timestep
write(outunit,100) ' atm%lon_bnd ', mpp_chksum(atm%lon_bnd)
write(outunit,100) ' atm%lat_bnd ', mpp_chksum(atm%lat_bnd)
write(outunit,100) ' atm%lon ', mpp_chksum(atm%lon)
write(outunit,100) ' atm%lat ', mpp_chksum(atm%lat)

end subroutine atmos_data_type_chksum

! </SUBROUTINE>

subroutine alloc_atmos_data_type (nlon, nlat, Atmos)
Expand Down Expand Up @@ -1623,7 +1565,6 @@ subroutine assign_importdata(jdat, rc)
integer :: sphum, liq_wat, ice_wat, o3mr
character(len=128) :: impfield_name, fldname
type(ESMF_TypeKind_Flag) :: datatype
real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d
real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d
real(kind=ESMF_KIND_R8), dimension(:,:,:), pointer:: datar83d
real(kind=GFS_kind_phys), dimension(:,:), pointer :: datar8
Expand All @@ -1634,7 +1575,7 @@ subroutine assign_importdata(jdat, rc)
type(ESMF_Grid) :: grid
type(ESMF_Field) :: dbgField
character(19) :: currtimestring
real (kind=GFS_kind_phys), parameter :: z0ice=1.1 ! (in cm)
real (kind=GFS_kind_phys), parameter :: z0ice=1.0 ! (in cm)

!
! real(kind=GFS_kind_phys), parameter :: himax = 8.0 !< maximum ice thickness allowed
Expand Down Expand Up @@ -1690,10 +1631,6 @@ subroutine assign_importdata(jdat, rc)
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplIMP,atmos gets ',trim(impfield_name),' datar8=', &
datar8(isc,jsc), maxval(datar8), minval(datar8)
found = .true.
! gfs physics runs with r8
! else
! call ESMF_FieldGet(importFields(n),farrayPtr=datar42d,localDE=0, rc=rc)
! datar8 = datar42d
endif

else if( dimCount == 3) then
Expand Down Expand Up @@ -2489,7 +2426,7 @@ subroutine assign_importdata(jdat, rc)
if (GFS_data(nb)%Sfcprop%fice(ix) >= GFS_control%min_seaice) then

GFS_data(nb)%Coupling%hsnoin_cpl(ix) = min(hsmax, GFS_data(nb)%Coupling%hsnoin_cpl(ix) &
/ (GFS_data(nb)%Sfcprop%fice(ix)*GFS_data(nb)%Sfcprop%oceanfrac(ix)))
/ GFS_data(nb)%Sfcprop%fice(ix))
GFS_data(nb)%Sfcprop%zorli(ix) = z0ice
tem = GFS_data(nb)%Sfcprop%tisfc(ix) * GFS_data(nb)%Sfcprop%tisfc(ix)
tem = con_sbc * tem * tem
Expand Down Expand Up @@ -2546,7 +2483,6 @@ subroutine assign_importdata(jdat, rc)

rc=0
!
if (mpp_pe() == mpp_root_pe()) print *,'end of assign_importdata'
end subroutine assign_importdata

!
Expand All @@ -2560,9 +2496,9 @@ subroutine setup_exportdata(rc)
integer, optional, intent(out) :: rc

!--- local variables
integer :: i, j, k, idx, ix
integer :: i, j, ix
integer :: isc, iec, jsc, jec
integer :: ib, jb, nb, nsb, nk
integer :: nb, nk
integer :: sphum, liq_wat, ice_wat, o3mr
real(GFS_kind_phys) :: rtime, rtimek

Expand All @@ -2586,7 +2522,6 @@ subroutine setup_exportdata(rc)
jsc = Atm_block%jsc
jec = Atm_block%jec
nk = Atm_block%npz
nsb = Atm_block%blkno(isc,jsc)

rtime = one / GFS_control%dtp
rtimek = GFS_control%rho_h2o * rtime
Expand Down Expand Up @@ -2895,7 +2830,6 @@ subroutine addLsmask2grid(fcstGrid, rc)
integer isc, iec, jsc, jec
integer i, j, nb, ix
! integer CLbnd(2), CUbnd(2), CCount(2), TLbnd(2), TUbnd(2), TCount(2)
type(ESMF_StaggerLoc) :: staggerloc
integer, allocatable :: lsmask(:,:)
integer(kind=ESMF_KIND_I4), pointer :: maskPtr(:,:)
!
Expand Down Expand Up @@ -2947,5 +2881,14 @@ subroutine addLsmask2grid(fcstGrid, rc)

end subroutine addLsmask2grid
!------------------------------------------------------------------------------
subroutine atmos_model_get_nth_domain_info(n, layout, nx, ny, pelist)
integer, intent(in) :: n
integer, intent(out) :: layout(2)
integer, intent(out) :: nx, ny
integer, pointer, intent(out) :: pelist(:)

call get_nth_domain_info(n, layout, nx, ny, pelist)

end subroutine atmos_model_get_nth_domain_info

end module atmos_model_mod
4 changes: 2 additions & 2 deletions ccpp/data/CCPP_typedefs.F90
Original file line number Diff line number Diff line change
Expand Up @@ -141,8 +141,8 @@ subroutine interstitial_create (Interstitial, is, ie, isd, ied, js, je, jsd, jed
! For multi-gases physics
integer, intent(in) :: nwat
integer, intent(in), optional :: ngas
real(kind_dyn), intent(in), optional :: rilist(:)
real(kind_dyn), intent(in), optional :: cpilist(:)
real(kind_dyn), intent(in), optional :: rilist(0:)
real(kind_dyn), intent(in), optional :: cpilist(0:)
integer, intent(in) :: mpirank
integer, intent(in) :: mpiroot
!
Expand Down
Loading