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

Lnd nuopc fms -> merge_upstream2lnd_nuopc #8

Merged
merged 4 commits into from
Sep 22, 2021
Merged
Show file tree
Hide file tree
Changes from all 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
2 changes: 1 addition & 1 deletion FV3
1 change: 1 addition & 0 deletions Noah-Comp/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ add_library(lnd_comp STATIC
import_fields.F90
proc_bounds.F90
domain_create.F90
restart_io.F90
ccpphys_files/funcphys.f90
ccpphys_files/machine.F
ccpphys_files/sfc_diff.f
Expand Down
4 changes: 4 additions & 0 deletions Noah-Comp/domain_create.F90
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,10 @@ subroutine domain_create(ctrl_init, land_domain)
pe_end(n) = mpp_root_pe() + n*ctrl_init%layout(1)*ctrl_init%layout(2)-1
enddo

write(*,*) 'DC ni,nj: ', ctrl_init%npx-1, ctrl_init%npy-1 ! tmp debug
write(*,*) 'DC layout: ', ctrl_init%layout !tmp debug
write(*,*) 'DC pe_start: ', pe_start !tmp debug
write(*,*) 'DC pe_end: ', pe_end !tmp debug
call define_cubic_mosaic(land_domain, ctrl_init%npx-1, ctrl_init%npy-1, ctrl_init%layout, pe_start, pe_end, halo)
!write(*,*) 'some domain info: ', land_domain%pe, land_domain%ntiles !tmp debug
deallocate(pe_start)
Expand Down
80 changes: 46 additions & 34 deletions Noah-Comp/import_fields.F90
Original file line number Diff line number Diff line change
Expand Up @@ -357,12 +357,13 @@ subroutine import_allfields_am(State_i, procbounds, noah_model, ctrl_init, rc)
! write(*,*) 'i isc, iec, jsc, jec: ', isc, iec, jsc, jec
! write(*,*) 'foo_atm2lndfield: ', noah_model%model%foo_atm2lndfield

call state_getimport(State_i, 'Faxa_soiltyp', isc, iec, jsc, jec, noah_model%model%soiltyp, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_vegtype', isc, iec, jsc, jec, noah_model%model%vegtype, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_sigmaf', isc, iec, jsc, jec, noah_model%model%sigmaf, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!! Removing these, as now read in by restart
! call state_getimport(State_i, 'Faxa_soiltyp', isc, iec, jsc, jec, noah_model%model%soiltyp, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_vegtype', isc, iec, jsc, jec, noah_model%model%vegtype, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_sigmaf', isc, iec, jsc, jec, noah_model%model%sigmaf, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_sfcemis', isc, iec, jsc, jec, noah_model%model%sfcemis, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_dlwflx', isc, iec, jsc, jec, noah_model%model%dlwflx, rc=rc)
Expand All @@ -375,10 +376,12 @@ subroutine import_allfields_am(State_i, procbounds, noah_model, ctrl_init, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_tg3', isc, iec, jsc, jec, noah_model%model%tg3, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_cm', isc, iec, jsc, jec, noah_model%model%cm, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_ch', isc, iec, jsc, jec, noah_model%model%ch, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!! Is this needed for restart or otherwise?
! call state_getimport(State_i, 'Faxa_cm', isc, iec, jsc, jec, noah_model%model%cm, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
!! Is this needed for restart or otherwise?
! call state_getimport(State_i, 'Faxa_ch', isc, iec, jsc, jec, noah_model%model%ch, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_prsl1', isc, iec, jsc, jec, noah_model%model%prsl1, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_prslki', isc, iec, jsc, jec, noah_model%model%prslki, rc=rc)
Expand All @@ -387,14 +390,15 @@ subroutine import_allfields_am(State_i, procbounds, noah_model, ctrl_init, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_land', isc, iec, jsc, jec, noah_model%model%land, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_slopetyp', isc, iec, jsc, jec, noah_model%model%slopetyp, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_shdmin', isc, iec, jsc, jec, noah_model%model%shdmin, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_shdmax', isc, iec, jsc, jec, noah_model%model%shdmax, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_snoalb', isc, iec, jsc, jec, noah_model%model%snoalb, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!! Removing these, as now read in by restart
! call state_getimport(State_i, 'Faxa_slopetyp', isc, iec, jsc, jec, noah_model%model%slopetyp, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_shdmin', isc, iec, jsc, jec, noah_model%model%shdmin, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_shdmax', isc, iec, jsc, jec, noah_model%model%shdmax, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_snoalb', isc, iec, jsc, jec, noah_model%model%snoalb, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_sfalb', isc, iec, jsc, jec, noah_model%model%sfalb, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_bexppert', isc, iec, jsc, jec, noah_model%model%bexppert, rc=rc)
Expand All @@ -416,26 +420,33 @@ subroutine import_allfields_am(State_i, procbounds, noah_model, ctrl_init, rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_sfalb', isc, iec, jsc, jec, noah_model%model%sfalb, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_weasd', isc, iec, jsc, jec, noah_model%model%weasd, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_snwdph', isc, iec, jsc, jec, noah_model%model%snwdph, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_tskin', isc, iec, jsc, jec, noah_model%model%tskin, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_tprcp', isc, iec, jsc, jec, noah_model%model%tprcp, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_srflag', isc, iec, jsc, jec, noah_model%model%srflag, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

!! Removing these, as now read in by restart
! call state_getimport(State_i, 'Faxa_weasd', isc, iec, jsc, jec, noah_model%model%weasd, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_tskin', isc, iec, jsc, jec, noah_model%model%tskin, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_snwdph', isc, iec, jsc, jec, noah_model%model%snwdph, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_tprcp', isc, iec, jsc, jec, noah_model%model%tprcp, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_srflag', isc, iec, jsc, jec, noah_model%model%srflag, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return

! call state_getimport(State_i, 'Faxa_smc', isc, iec, jsc, jec, noah_model%model%smc, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_stc', isc, iec, jsc, jec, noah_model%model%stc, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_slc', isc, iec, jsc, jec, noah_model%model%slc, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_canopy', isc, iec, jsc, jec, noah_model%model%canopy, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_trans', isc, iec, jsc, jec, noah_model%model%trans, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

!! Removing these, as now read in by restart
! call state_getimport(State_i, 'Faxa_canopy', isc, iec, jsc, jec, noah_model%model%canopy, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return

!! Is this needed for restart or otherwise? Note controlled by flag_iter
! call state_getimport(State_i, 'Faxa_trans', isc, iec, jsc, jec, noah_model%model%trans, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_tsurf', isc, iec, jsc, jec, noah_model%model%tsurf, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_z0rl', isc, iec, jsc, jec, noah_model%model%z0rl, rc=rc)
Expand All @@ -444,8 +455,9 @@ subroutine import_allfields_am(State_i, procbounds, noah_model, ctrl_init, rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call state_getimport(State_i, 'Faxa_ztpert', isc, iec, jsc, jec, noah_model%model%ztpert, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_ustar', isc, iec, jsc, jec, noah_model%model%ustar, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!! Is this needed for restart or otherwise?
! call state_getimport(State_i, 'Faxa_ustar', isc, iec, jsc, jec, noah_model%model%ustar, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(State_i, 'Faxa_wind', isc, iec, jsc, jec, noah_model%model%wind, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end subroutine import_allfields_am
Expand Down
30 changes: 16 additions & 14 deletions Noah-Comp/lnd_comp_nuopc.F90
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ module lnd_comp_nuopc
use fms_mod, only: fms_init
use fms_io_mod, only: read_data

use noah_driver, only: init_driver
use noah_driver, only: init_driver, noah_finalize
!use land_domain_mod, only: domain_create


Expand Down Expand Up @@ -141,9 +141,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
character(len=CL) :: logmsg
logical :: isPresent, isSet
logical :: cism_evolve
integer :: mype, ntasks, mpi_comm_land
integer :: mype, ntasks, mpi_comm_land, mpi_comm_land2
character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) '
character(len=*), parameter :: format = "('("//trim(subname)//") :',A)"

!-------------------------------------------------------------------------------
rc = ESMF_SUCCESS

Expand All @@ -152,20 +153,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
call ESMF_GridCompGet(gcomp, vm=vm, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! start putting in fms/mpp stuff here
call ESMF_VMGetCurrent(vm=VM,rc=RC)
call ESMF_VMGet(vm=VM, localPet=mype, mpiCommunicator=mpi_comm_land, &
petCount=ntasks, rc=rc)
if (mype == 0) write(0,*) 'in lnd comp initadvert, ntasks=',ntasks
!write(0,*) 'in lnd comp init advert, ntasks=',ntasks, ' pe=',mype
call fms_init(mpi_comm_land)
!write(0,*) 'in lnd comp init advert 2, ntasks=',ntasks, ' pe=',mype


! Create domain

!! disabled, handled in FV3
! call ESMF_VMGetCurrent(vm=VM,rc=RC)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call ESMF_VMGet(vm=VM, localPet=mype, mpiCommunicator=mpi_comm_land, &
! petCount=ntasks, rc=rc)
! if (ChkErr(rc,__LINE__,u_FILE_u)) return
! call fms_init(mpi_comm_land)


! Create domain

call get_component_instance(gcomp, inst_suffix, inst_index, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
Expand Down Expand Up @@ -455,6 +452,7 @@ subroutine ModelAdvance(gcomp, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return



! Commenting out, because won't currently work with tiles
! ! write out imports. Should make this optional, and put into a routine

Expand Down Expand Up @@ -625,8 +623,12 @@ subroutine ModelFinalize(gcomp, rc)
character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) '

! begin
!write(*,*) '--- Land finalize called ---'
rc = ESMF_SUCCESS
call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO)

call noah_finalize()

end subroutine ModelFinalize


Expand Down
53 changes: 33 additions & 20 deletions Noah-Comp/noah_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -5,17 +5,18 @@ module noah_driver
use noah_loop, only: noah_loop_init, noah_loop_run
use noah_type_mod
use proc_bounds, only: procbounds_type, control_init_type

use mpp_domains_mod, only: domain2d


implicit none
private

type (noah_type), public :: noah_model
type(noah_type), public :: noah_model
type(domain2D), public :: land_domain
type(control_init_type), public :: ctrl_init
!type (noah_type), dimension(:), allocatable, public :: noah_model
type (control_init_type), public :: ctrl_init

public :: noah_loop_drv, init_driver, noah_block_run
public :: noah_loop_drv, init_driver, noah_block_run, noah_finalize

contains

Expand All @@ -26,18 +27,15 @@ subroutine init_driver(ctrl_init)
use mpp_mod, only: mpp_pe, mpp_root_pe
use land_domain_mod, only: domain_create
use block_control_mod, only: block_control_type, define_blocks_packed


!type(procbounds_type), intent(in) :: procbounds
!character(len=*), intent(out) :: gridchoice
use land_restart_mod, only: sfc_prop_restart_read, sfc_prop_transfer
type(control_init_type), intent(out) :: ctrl_init

! ---------------
! local

!type(control_init_type) :: ctrl_init
!type (noah_type) :: noah
type(domain2D) :: land_domain
!type(domain2D) :: land_domain
type (block_control_type), target :: Lnd_block ! Block container
integer :: isc, iec, jsc, jec

Expand Down Expand Up @@ -74,11 +72,11 @@ subroutine init_driver(ctrl_init)
! domain create with FMS:
call domain_create(ctrl_init, land_domain)

! Creat blocking a la FV3
! Create blocking a la FV3
call mpp_get_compute_domain(land_domain,isc,iec,jsc,jec)

im = (iec-isc+1)*(jec-jsc+1)
write(*,*) "isc,iec,jsc,jec, im: ",isc,iec,jsc,jec, im
!write(*,*) "isc,iec,jsc,jec, im: ",isc,iec,jsc,jec, im


! Create blocks, but not curretnly using
Expand Down Expand Up @@ -120,7 +118,12 @@ subroutine init_driver(ctrl_init)
noah_model%control%jec = jec
noah_model%static%im = im
call noah_model%Create(im)


! Restart read of sfc_data
call sfc_prop_restart_read(noah_model, land_domain, .false.)
! Transfer from sfcprop to model data
call sfc_prop_transfer(noah_model)
! initialization related to Noah LSM and stability
call noah_loop_init(0, ctrl_init%isot, ctrl_init%ivegsrc, 0 , errmsg, errflg)


Expand All @@ -142,7 +145,8 @@ end subroutine noah_block_run
subroutine noah_loop_drv(procbounds, noah_model)

use proc_bounds, only : procbounds_type

!use land_restart_mod, only: sfc_prop_restart_write ! TMP DEBUG

use physcons, only : &
cp => con_cp, &
eps => con_eps, &
Expand All @@ -153,7 +157,7 @@ subroutine noah_loop_drv(procbounds, noah_model)
rvrdm1 => con_fvirt, &
tfreeze => con_t0c

type(procbounds_type), intent(in) :: procbounds
type(procbounds_type), intent(in) :: procbounds
type(noah_type), intent(inout) :: noah_model ! land model's variable type

! local
Expand Down Expand Up @@ -226,10 +230,12 @@ subroutine noah_loop_drv(procbounds, noah_model)
real(kind_phys) :: prsik1(noah_model%static%im), z0pert(noah_model%static%im), &
ztpert(noah_model%static%im), stress(noah_model%static%im)

integer :: isot
integer :: ivegsrc
! tmp for testing. These should be coming from namelist
real(kind_phys), parameter :: delt = 900.0_kind_phys
integer, parameter :: ivegsrc = 1
integer, parameter :: isot = 1
!integer, parameter :: ivegsrc = 1
!integer, parameter :: isot = 1
logical, parameter :: lheatstrg = .false.
real(kind_phys), parameter :: pertvegf = 0.0_kind_phys
! outputs
Expand All @@ -248,7 +254,7 @@ subroutine noah_loop_drv(procbounds, noah_model)
im => noah_model%static%im ,&
km => noah_model%static%km ,&
! delt => noah_model%static%delt ,&
! isot => noah_model%static%isot ,&
isot => noah_model%static%isot ,&
! ivegsrc => noah_model%static%ivegsrc ,&
! pertvegf => noah_model%static%pertvegf ,&
! lheatstrg => noah_model%static%lheatstrg ,&
Expand Down Expand Up @@ -335,9 +341,6 @@ subroutine noah_loop_drv(procbounds, noah_model)
! gridbeg = procbounds%gridbeg
! gridend = procbounds%gridend

! tmp, debug
!write(6,'("noah drv: dswsfc - min/max/avg",3g16.6)') minval(dswsfc), maxval(dswsfc), sum(dswsfc)/size(dswsfc)

call noah_loop_run( &
!! ARGS FROM NOAH
! --- inputs:
Expand Down Expand Up @@ -381,5 +384,15 @@ subroutine noah_loop_drv(procbounds, noah_model)
end associate

end subroutine noah_loop_drv


! -------------------------------------------------------------------
subroutine noah_finalize()

use land_restart_mod, only: sfc_prop_restart_write

call sfc_prop_restart_write(noah_model, land_domain)

end subroutine noah_finalize

end module noah_driver
Loading