Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merge gsl/develop to RRFS_dev #132

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