From 9fba7ff0120914054468349ff42d7fe3caa1cb51 Mon Sep 17 00:00:00 2001 From: tsga Date: Sat, 16 Mar 2024 16:56:50 +0000 Subject: [PATCH 001/141] land iau init --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 967 ++++++++++++++++++ physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 132 ++- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 152 ++- 3 files changed, 1213 insertions(+), 38 deletions(-) create mode 100644 physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 new file mode 100644 index 000000000..2b53edd81 --- /dev/null +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -0,0 +1,967 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the FV3 dynamical core. +!* +!* The FV3 dynamical core is free software: you can redistribute it +!* and/or modify it under the terms of the +!* GNU Lesser General Public License as published by the +!* Free Software Foundation, either version 3 of the License, or +!* (at your option) any later version. +!* +!* The FV3 dynamical core is distributed in the hope that it will be +!* useful, but WITHOUT ANYWARRANTY; without even the implied warranty +!* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +!* See the GNU General Public License for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with the FV3 dynamical core. +!* If not, see . +!*********************************************************************** + +!> The routine 'remapcoeff is copied from 'fv_treat_da_inc.F90 by Xi.Chen +! and put at the end of this module because, due to the compile order in CCPP framework it wasn't possible to 'include' +! the original module when the land iau mod is called through CCPP frameowrk +! + + +!------------------------------------------------------------------------------- +!> @brief incremental analysis update module +!> @author Xi.Chen - author of fv_treat_da_inc.F90 +!> @author Philip Pegion +!> @date 09/13/2017 +! +!> REVISION HISTORY: +!> 09/13/2017 - Initial Version based on fv_treat_da_inc.F90 +!------------------------------------------------------------------------------- + +#ifdef OVERLOAD_R4 +#define _GET_VAR1 get_var1_real +#else +#define _GET_VAR1 get_var1_double +#endif + +module lnd_iau_mod + +! use fms_mod, only: file_exist +! use mpp_mod, only: mpp_error, FATAL, NOTE, mpp_pe +! use mpp_domains_mod, only: domain2d +! use constants_mod, only: pi=>pi_8 +! use fv_arrays_mod, only: R_GRID !, & + ! fv_atmos_type, & + ! fv_grid_type, & + ! fv_grid_bounds_type, & +! use fv_mp_mod, only: is_master + use sim_nc_mod_lnd, only: open_ncfile, & + close_ncfile, & + get_ncdim1, & + get_var1_double, & + get_var3_r4, & + get_var1_real, check_var_exists +! #ifdef GFS_TYPES +! use GFS_typedefs, only: IPD_init_type => GFS_init_type, & +! LND_IAU_Control_type => GFS_control_type, & +! kind_phys, & +! IPD_Data_type => GFS_data_type +! #else +! use IPD_typedefs, only: IPD_init_type, LND_IAU_Control_type, & +! kind_phys => IPD_kind_phys +! #endif + +! use block_control_mod, only: block_control_type +! use fv_treat_da_inc_mod, only: remap_coef +! use tracer_manager_mod, only: get_tracer_names,get_tracer_index, get_number_tracers +! use field_manager_mod, only: MODEL_ATMOS + + use machine, only: kind_phys, kind_dyn + use physcons, only: pi => con_pi + + implicit none + + private + + real,allocatable::s2c(:,:,:) +! real:: s2c(Atm(1)%bd%is:Atm(1)%bd%ie,Atm(1)%bd%js:Atm(1)%bd%je,4) +! integer, dimension(Atm(1)%bd%is:Atm(1)%bd%ie,Atm(1)%bd%js:Atm(1)%bd%je):: & +! id1, id2, jdc + integer,allocatable,dimension(:,:) :: id1,id2,jdc + + real :: deg2rad,dt,rdt + integer :: im,jm,km,nfiles,ncid + + integer :: n_soill, n_snowl !1.27.24 soil and snow layers + logical :: do_lnd_iau_inc !do_lnd_iau_inc + + integer :: is, ie, js, je + integer :: npz !, ntracers +! character(len=32), allocatable :: tracer_names(:) +! integer, allocatable :: tracer_indicies(:) + + real(kind=4), allocatable:: wk3(:,:,:) + + type iau_internal_data_type + ! real,allocatable :: ua_inc(:,:,:) + ! real,allocatable :: va_inc(:,:,:) + ! real,allocatable :: temp_inc(:,:,:) + ! real,allocatable :: delp_inc(:,:,:) + ! real,allocatable :: delz_inc(:,:,:) + ! real,allocatable :: tracer_inc(:,:,:,:) + real,allocatable :: stc_inc(:,:,:) + real,allocatable :: slc_inc(:,:,:) + real,allocatable :: tmp2m_inc(:,:, :) + real,allocatable :: spfh2m_inc(:,:, :) + end type iau_internal_data_type + + type lnd_iau_external_data_type + real,allocatable :: stc_inc(:,:,:) + real,allocatable :: slc_inc(:,:,:) + real,allocatable :: tmp2m_inc(:,:,:) + real,allocatable :: spfh2m_inc(:,:,:) + logical :: in_interval = .false. + ! logical :: drymassfixer = .false. + end type lnd_iau_external_data_type + + type iau_state_type + type(iau_internal_data_type):: inc1 + type(iau_internal_data_type):: inc2 + real(kind=kind_phys) :: hr1 + real(kind=kind_phys) :: hr2 + real(kind=kind_phys) :: wt + real(kind=kind_phys) :: wt_normfact + end type iau_state_type + + type lnd_iau_control_type + integer :: isc + integer :: jsc + integer :: nx + integer :: ny + integer :: nblks + ! integer :: blksz ! this could vary for the last block + integer, allocatable :: blksz(:) + integer, allocatable :: blk_strt_indx(:) + + integer :: lsoil !< number of soil layers + ! this is the max dim (TBC: check it is consitent for noahmpdrv) + integer :: lsnow_lsm !< maximum number of snow layers internal to land surface model + logical :: do_lnd_iau_inc + real(kind=kind_phys) :: iau_delthrs ! iau time interval (to scale increments) in hours + character(len=240) :: iau_inc_files(7)! list of increment files + real(kind=kind_phys) :: iaufhrs(7) ! forecast hours associated with increment files + logical :: iau_filter_increments + !, iau_drymassfixer + integer :: me !< MPI rank designator + integer :: mpi_root !< MPI rank of master atmosphere processor + character(len=64) :: fn_nml !< namelist filename for surface data cycling + real(kind=kind_phys) :: dtp !< physics timestep in seconds + real(kind=kind_phys) :: fhour !< current forecast hour + character(len=:), pointer, dimension(:) :: input_nml_file => null() ! null() !< character string containing full namelist + ! integer :: logunit + !--- calendars and time parameters and activation triggers + ! real(kind=kind_phys) :: dtf !< dynamics timestep in seconds + ! integer :: idat(1:8) !< initialization date and time + ! !< (yr, mon, day, t-zone, hr, min, sec, mil-sec) + ! integer :: jdat(1:8) !< current forecast date and time + ! !< (yr, mon, day, t-zone, hr, min, sec, mil-sec) + ! real(kind=kind_phys) :: sec !< seconds since model initialization + ! real(kind=kind_phys) :: phour !< previous forecast hour + ! real(kind=kind_phys) :: zhour !< previous hour diagnostic buckets emptied + ! integer :: kdt !< current forecast iteration + ! logical :: first_time_step !< flag signaling first time step for time integration routine + end type lnd_iau_control_type + + type(iau_state_type) :: IAU_state + public lnd_iau_control_type, lnd_iau_external_data_type, lnd_iau_mod_set_control, lnd_iau_mod_init, lnd_iau_mod_getiauforcing + +contains + +subroutine lnd_iau_mod_set_control(LND_IAU_Control,fn_nml,input_nml_file_i,me, mpi_root, isc, jsc, nx, ny, nblks, blksz, & + lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) !nlunit + + type (lnd_iau_control_type), intent(inout) :: LND_IAU_Control + character(*), intent(in) :: fn_nml !< namelist filename for surface data cycling + character(len=:), intent(in), dimension(:), pointer :: input_nml_file_i + integer, intent(in) :: me, mpi_root !< MPI rank of master atmosphere processor + integer, intent(in) :: isc, jsc, nx, ny, nblks, lsoil, lsnow_lsm + integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz + real(kind=kind_phys), intent(in) :: dtp !< physics timestep in seconds + real(kind=kind_phys), intent(in) :: fhour !< current forecast hour + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: nb, ix + integer :: nlunit = 360 ! unit for namelist !, intent(in) + integer :: ios + logical :: exists + character(len=512) :: ioerrmsg + !character(len=32) :: fn_nml = "input.nml" + character(len=:), pointer, dimension(:) :: input_nml_file => null() + integer :: input_nml_file_length !< length(number of lines) in namelist for internal reads + + + !> 3.9.24 these are not available through the CCPP interface so need to read them from namelist file + !> vars to read from namelist + logical :: do_lnd_iau_inc = .false. + real(kind=kind_phys) :: lnd_iau_delthrs = 0 !< iau time interval (to scale increments) + character(len=240) :: lnd_iau_inc_files(7) = '' !< list of increment files + real(kind=kind_phys) :: lnd_iaufhrs(7) = -1 !< forecast hours associated with increment files + logical :: lnd_iau_filter_increments = .false. !< filter IAU increments + + NAMELIST /lnd_iau_nml/ do_lnd_iau_inc, lnd_iau_delthrs, lnd_iau_inc_files, lnd_iaufhrs, lnd_iau_filter_increments !, lnd_iau_drymassfixer & + + !Errors messages handled through CCPP error handling variables + errmsg = '' + errflg = 0 + +!3.11.24: copied from GFS_typedefs.F90 +#ifdef INTERNAL_FILE_NML + ! allocate required to work around GNU compiler bug 100886 + ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886 + allocate(input_nml_file, mold=input_nml_file_i) + input_nml_file => input_nml_file_i + read(input_nml_file, nml=lnd_iau_nml) + ! Set length (number of lines) in namelist for internal reads + input_nml_file_length = size(input_nml_file) +#else + ! if (file_exist(fn_nml)) then + inquire (file=trim(fn_nml), exist=exists) ! TBCL: this maybe be replaced by nlunit passed from ccpp + if (.not. exists) then + ! call mpp_error(FATAL, 'lnd_iau_mod_set_control: namelist file ',trim(fn_nml),' does not exist') + write(6,*) 'lnd_iau_mod_set_control: namelist file ',trim(fn_nml),' does not exist' + errmsg = 'lnd_iau_mod_set_control: namelist file '//trim(fn_nml)//' does not exist' + errflg = 1 + return + else + LND_IAU_Control%fn_nml = trim(fn_nml) ! maynot need this + open (unit=nlunit, file=trim(fn_nml), action='READ', status='OLD', iostat=ios, iomsg=ioerrmsg) + rewind(nlunit) + read (nlunit, nml=lnd_iau_nml) + close (nlunit) + if (ios /= 0) then + ! call mpp_error(FATAL, 'lnd_iau_mod_set_control: error reading namelist file ',trim(fn_nml)) + ! write(6,*) 'lnd_iau_mod_set_control: error reading namelist file ',trim(fn_nml) + write(6,*) trim(ioerrmsg) + errmsg = 'lnd_iau_mod_set_control: error reading namelist file '//trim(fn_nml) & + // 'the error message from file handler:' //trim(ioerrmsg) + errflg = 1 + return + end if + endif +#endif + + if (me == mpi_root) then + write(6,*) "lnd_iau_nml" + write(6, lnd_iau_nml) + endif + + LND_IAU_Control%do_lnd_iau_inc = do_lnd_iau_inc + LND_IAU_Control%iau_delthrs = lnd_iau_delthrs + LND_IAU_Control%iau_inc_files = lnd_iau_inc_files + LND_IAU_Control%iaufhrs = lnd_iaufhrs + LND_IAU_Control%iau_filter_increments = lnd_iau_filter_increments + ! LND_IAU_Control%iau_drymassfixer = lnd_iau_drymassfixer + LND_IAU_Control%me = me + LND_IAU_Control%mpi_root = mpi_root + LND_IAU_Control%isc = isc + LND_IAU_Control%jsc = jsc + LND_IAU_Control%nx = nx + LND_IAU_Control%ny = ny + LND_IAU_Control%nblks = nblks + LND_IAU_Control%lsoil = lsoil + LND_IAU_Control%lsnow_lsm = lsnow_lsm + LND_IAU_Control%dtp = dtp + LND_IAU_Control%fhour = fhour + + LND_IAU_Control%input_nml_file = input_nml_file + LND_IAU_Control%input_nml_file_length = input_nml_file_length + + allocate(LND_IAU_Control%blksz(nblks)) + allocate(LND_IAU_Control%blk_strt_indx(nblks)) + !start index of each block, for flattened (ncol=nx*ny) arrays + ! required in noahmpdriv_run to get subsection of the stc array for each + ! proc/thread + ix = 1 + do nb=1, nblks + LND_IAU_Control%blksz(nb) = blksz(nb) + LND_IAU_Control%blk_strt_indx(nb) = ix + ix = ix + blksz(nb) + enddo + +end subroutine lnd_iau_mod_set_control + +subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) !nlunit, ncols, IPD_Data,,Init_parm) + ! integer, intent(in) :: me, mpi_root + type (lnd_iau_control_type), intent(in) :: LND_IAU_Control + type (lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data + ! type (IPD_init_type), intent(in) :: Init_parm + ! type (IPD_Data_type), dimension(:), intent(in) :: IPD_Data + ! integer, intent(in) :: ncols + real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon + real(kind_phys), dimension(:), intent(in) :: xlat ! latitude + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local + character(len=128) :: fname + ! real, dimension(:,:,:), allocatable:: u_inc, v_inc + real(kind=kind_dyn), allocatable:: lat(:), lon(:),agrid(:,:,:) + real(kind=kind_phys) sx,wx,wt,normfact,dtp + + integer:: ib, i, j, k, nstep, kstep + integer:: i1, i2, j1 + integer:: jbeg, jend + + logical:: found + integer nfilesall + integer, allocatable :: idt(:) + + real (kind=kind_phys), allocatable :: Init_parm_xlon (:, :) + real (kind=kind_phys), allocatable :: Init_parm_xlat (:, :) + integer :: nlon, nlat + ! integer :: nb, ix, nblks, blksz + logical :: exists + + !Errors messages handled through CCPP error handling variables + errmsg = '' + errflg = 0 + + do_lnd_iau_inc = LND_IAU_Control%do_lnd_iau_inc + n_soill = LND_IAU_Control%lsoil !4 for sfc updates +! n_snowl = LND_IAU_Control%lsnowl + npz = LND_IAU_Control%lsoil + + is = LND_IAU_Control%isc + ie = is + LND_IAU_Control%nx-1 + js = LND_IAU_Control%jsc + je = js + LND_IAU_Control%ny-1 + nlon = LND_IAU_Control%nx + nlat = LND_IAU_Control%ny + !nblks = LND_IAU_Control%nblks + !blksz = LND_IAU_Control%blksz(1) + + allocate(Init_parm_xlon(nlon,nlat), Init_parm_xlat(nlon,nlat)) + ib = 1 + do j = 1, nlat !ny + ! do i = 1, nx + Init_parm_xlon (:,j) = xlon(ib:ib+nlon-1) + Init_parm_xlat (:,j) = xlat(ib:ib+nlon-1) + ib = ib+nlon + ! enddo + enddo + ! call get_number_tracers(MODEL_ATMOS, num_tracers=ntracers) + ! allocate (tracer_names(ntracers)) + ! allocate (tracer_indicies(ntracers)) + ! do i = 1, ntracers + ! call get_tracer_names(MODEL_ATMOS, i, tracer_names(i)) + ! tracer_indicies(i) = get_tracer_index(MODEL_ATMOS,tracer_names(i)) + ! enddo + allocate(s2c(is:ie,js:je,4)) + allocate(id1(is:ie,js:je)) + allocate(id2(is:ie,js:je)) + allocate(jdc(is:ie,js:je)) + allocate(agrid(is:ie,js:je,2)) +! determine number of increment files to read, and the valid forecast hours + + nfilesall = size(LND_IAU_Control%iau_inc_files) + nfiles = 0 + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print*,'in lnd_iau_init incfile1 iaufhr1 ', & + trim(LND_IAU_Control%iau_inc_files(1)),LND_IAU_Control%iaufhrs(1) + do k=1,nfilesall + if (trim(LND_IAU_Control%iau_inc_files(k)) .eq. '' .or. LND_IAU_Control%iaufhrs(k) .lt. 0) exit + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print *,k,trim(adjustl(LND_IAU_Control%iau_inc_files(k))) + endif + nfiles = nfiles + 1 + enddo + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'nfiles = ',nfiles + if (nfiles < 1) then + return + endif + if (nfiles > 1) then + allocate(idt(nfiles-1)) + idt = LND_IAU_Control%iaufhrs(2:nfiles)-LND_IAU_Control%iaufhrs(1:nfiles-1) + do k=1,nfiles-1 + if (idt(k) .ne. LND_IAU_Control%iaufhrs(2)-LND_IAU_Control%iaufhrs(1)) then + print *,'in lnd_iau_init: forecast intervals in iaufhrs must be constant' + ! call mpp_error (FATAL,' forecast intervals in iaufhrs must be constant') + errmsg = 'Fatal error in lnd_iau_init. forecast intervals in iaufhrs must be constant' + errflg = 1 + return + endif + enddo + deallocate(idt) + endif + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'lnd_iau interval = ',LND_IAU_Control%iau_delthrs,' hours' + dt = (LND_IAU_Control%iau_delthrs*3600.) + rdt = 1.0/dt + +! set up interpolation weights to go from GSI's gaussian grid to cubed sphere + deg2rad = pi/180. + + ! npz = LND_IAU_Control%levs + fname = 'INPUT/'//trim(LND_IAU_Control%iau_inc_files(1)) + inquire (file=trim(fname), exist=exists) + if (exists) then + ! if( file_exist(fname) ) then + call open_ncfile( fname, ncid ) ! open the file +!TODO !change to Latitude + call get_ncdim1( ncid, 'longitude', im) + call get_ncdim1( ncid, 'latitude', jm) + ! call get_ncdim1( ncid, 'nsoill', km) + km = n_soill + ! if (km.ne.npz) then + ! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *, 'km = ', km + ! ! call mpp_error(FATAL, '==> Error in IAU_initialize: km is not equal to npz') + ! errmsg = 'Fatal Error in IAU_initialize: km is not equal to npz' + ! errflg = 1 + ! return + ! endif + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) write(*,*) fname, ' DA increment dimensions:', im,jm,km + + allocate ( lon(im) ) + allocate ( lat(jm) ) + + call _GET_VAR1 (ncid, 'longitude', im, lon ) + call _GET_VAR1 (ncid, 'latitude', jm, lat ) + call close_ncfile(ncid) + + ! Convert to radians + do i=1,im + lon(i) = lon(i) * deg2rad + enddo + do j=1,jm + lat(j) = lat(j) * deg2rad + enddo + else + ! call mpp_error(FATAL,'==> Error in IAU_initialize: Expected file '& + ! //trim(fname)//' for DA increment does not exist') + errmsg = 'FATAL Error in IAU_initialize: Expected file '// trim(fname)//' for DA increment does not exist' + errflg = 1 + return + endif + + ! Initialize lat-lon to Cubed bi-linear interpolation coeff: + ! populate agrid +! print*,'is,ie,js,je=',is,ie,js,ie +! print*,'size xlon=',size(Init_parm%xlon(:,1)),size(Init_parm%xlon(1,:)) +! print*,'size agrid=',size(agrid(:,1,1)),size(agrid(1,:,1)),size(agrid(1,1,:)) + do j = 1,size(Init_parm_xlon,2) + do i = 1,size(Init_parm_xlon,1) +! print*,i,j,is-1+j,js-1+j + agrid(is-1+i,js-1+j,1)=Init_parm_xlon(i,j) + agrid(is-1+i,js-1+j,2)=Init_parm_xlat(i,j) + enddo + enddo + call remap_coef( is, ie, js, je, is, ie, js, je, & + im, jm, lon, lat, id1, id2, jdc, s2c, & + agrid) + deallocate ( lon, lat,agrid ) + if (allocated(Init_parm_xlon)) deallocate(Init_parm_xlon) + if (allocated(Init_parm_xlat)) deallocate(Init_parm_xlat) + + ! allocate(LND_IAU_Data%ua_inc(is:ie, js:je, km)) + ! allocate(LND_IAU_Data%va_inc(is:ie, js:je, km)) + ! allocate(LND_IAU_Data%temp_inc(is:ie, js:je, km)) + ! allocate(LND_IAU_Data%delp_inc(is:ie, js:je, km)) + ! allocate(LND_IAU_Data%delz_inc(is:ie, js:je, km)) + ! allocate(LND_IAU_Data%tracer_inc(is:ie, js:je, km,ntracers)) + allocate(LND_IAU_Data%stc_inc(is:ie, js:je, km)) + allocate(LND_IAU_Data%slc_inc(is:ie, js:je, km)) + allocate(LND_IAU_Data%tmp2m_inc(is:ie, js:je, 1)) + allocate(LND_IAU_Data%spfh2m_inc(is:ie, js:je, 1)) +! allocate arrays that will hold iau state + allocate (iau_state%inc1%stc_inc(is:ie, js:je, km)) + allocate (iau_state%inc1%slc_inc(is:ie, js:je, km)) + allocate (iau_state%inc1%tmp2m_inc(is:ie, js:je, 1)) + allocate (iau_state%inc1%spfh2m_inc (is:ie, js:je, 1)) + iau_state%hr1=LND_IAU_Control%iaufhrs(1) + iau_state%wt = 1.0 ! IAU increment filter weights (default 1.0) + iau_state%wt_normfact = 1.0 + if (LND_IAU_Control%iau_filter_increments) then + ! compute increment filter weights, sum to obtain normalization factor + dtp=LND_IAU_Control%dtp + nstep = 0.5*LND_IAU_Control%iau_delthrs*3600/dtp + ! compute normalization factor for filter weights + normfact = 0. + do k=1,2*nstep+1 + kstep = k-1-nstep + sx = acos(-1.)*kstep/nstep + wx = acos(-1.)*kstep/(nstep+1) + if (kstep .ne. 0) then + wt = sin(wx)/wx*sin(sx)/sx + else + wt = 1.0 + endif + normfact = normfact + wt + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'filter wts',k,kstep,wt + enddo + iau_state%wt_normfact = (2*nstep+1)/normfact + endif + ! if (do_lnd_iau_inc) then + ! call read_iau_forcing(LND_IAU_Control,iau_state%inc1,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(1)), errmsg, errflg, & + ! 'INPUT/'//trim(LND_IAU_Control%iau_inc_files_sfc(1))) + ! else + call read_iau_forcing(LND_IAU_Control,iau_state%inc1,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(1)), errmsg, errflg) + ! endif + if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window + call setiauforcing(LND_IAU_Control,LND_IAU_Data,iau_state%wt) + endif + if (nfiles.GT.1) then !have multiple files, but only read in 2 at a time and interpoalte between them + allocate (iau_state%inc2%stc_inc(is:ie, js:je, km)) + allocate (iau_state%inc2%slc_inc(is:ie, js:je, km)) + allocate (iau_state%inc2%tmp2m_inc(is:ie, js:je, 1)) + allocate (iau_state%inc2%spfh2m_inc(is:ie, js:je, 1)) + iau_state%hr2=LND_IAU_Control%iaufhrs(2) + ! if (do_lnd_iau_inc) then + ! call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(2)),errmsg,errflg, & + ! 'INPUT/'//trim(LND_IAU_Control%iau_inc_files_sfc(2))) + ! else + call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(2)), errmsg, errflg) + ! endif + endif +! print*,'in IAU init',dt,rdt +! LND_IAU_Data%drymassfixer = LND_IAU_Control%iau_drymassfixer + +end subroutine lnd_iau_mod_init + +subroutine lnd_iau_mod_getiauforcing(LND_IAU_Control,LND_IAU_Data, errmsg, errflg) + + implicit none + ! integer, intent(in) :: me, mpi_root + type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + real(kind=kind_phys) t1,t2,sx,wx,wt,dtp + integer n,i,j,k,sphum,kstep,nstep,itnext + + LND_IAU_Data%in_interval=.false. + if (nfiles.LE.0) then + return + endif + + if (nfiles .eq. 1) then + t1 = LND_IAU_Control%iaufhrs(1)-0.5*LND_IAU_Control%iau_delthrs + t2 = LND_IAU_Control%iaufhrs(1)+0.5*LND_IAU_Control%iau_delthrs + else + t1 = LND_IAU_Control%iaufhrs(1) + t2 = LND_IAU_Control%iaufhrs(nfiles) + endif + if (LND_IAU_Control%iau_filter_increments) then + ! compute increment filter weight + ! t1 is beginning of window, t2 end of window + ! LND_IAU_Control%fhour current time + ! in window kstep=-nstep,nstep (2*nstep+1 total) + ! time step LND_IAU_Control%dtp + dtp=LND_IAU_Control%dtp + nstep = 0.5*LND_IAU_Control%iau_delthrs*3600/dtp + ! compute normalized filter weight + kstep = ((LND_IAU_Control%fhour-t1) - 0.5*LND_IAU_Control%iau_delthrs)*3600./dtp + if (LND_IAU_Control%fhour >= t1 .and. LND_IAU_Control%fhour < t2) then + sx = acos(-1.)*kstep/nstep + wx = acos(-1.)*kstep/(nstep+1) + if (kstep .ne. 0) then + wt = (sin(wx)/wx*sin(sx)/sx) + else + wt = 1. + endif + iau_state%wt = iau_state%wt_normfact*wt + !if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'kstep,t1,t,t2,filter wt=',kstep,t1,LND_IAU_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact + else + iau_state%wt = 0. + endif + endif + + if (nfiles.EQ.1) then +! on check to see if we are in the IAU window, no need to update the +! tendencies since they are fixed over the window + if ( LND_IAU_Control%fhour < t1 .or. LND_IAU_Control%fhour >= t2 ) then +! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'no iau forcing',t1,LND_IAU_Control%fhour,t2 + LND_IAU_Data%in_interval=.false. + else + if (LND_IAU_Control%iau_filter_increments) call setiauforcing(LND_IAU_Control,LND_IAU_Data,iau_state%wt) + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt=',t1,LND_IAU_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact + LND_IAU_Data%in_interval=.true. + endif + return + endif + + if (nfiles > 1) then + itnext=2 + if (LND_IAU_Control%fhour < t1 .or. LND_IAU_Control%fhour >= t2) then +! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'no iau forcing',LND_IAU_Control%iaufhrs(1),LND_IAU_Control%fhour,LND_IAU_Control%iaufhrs(nfiles) + LND_IAU_Data%in_interval=.false. + else + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt=',t1,LND_IAU_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact + LND_IAU_Data%in_interval=.true. + do k=nfiles,1,-1 + if (LND_IAU_Control%iaufhrs(k) > LND_IAU_Control%fhour) then + itnext=k + endif + enddo +! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'itnext=',itnext + if (LND_IAU_Control%fhour >= iau_state%hr2) then ! need to read in next increment file + iau_state%hr1=iau_state%hr2 + iau_state%hr2=LND_IAU_Control%iaufhrs(itnext) + iau_state%inc1=iau_state%inc2 + ! if (do_lnd_iau_inc) then + ! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'reading next increment files',trim(LND_IAU_Control%iau_inc_files(itnext)), & + ! trim(LND_IAU_Control%iau_inc_files_sfc(itnext)) + ! call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(itnext)), errmsg, errflg, & + ! 'INPUT/'//trim(LND_IAU_Control%iau_inc_files_sfc(itnext))) + ! else + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'reading next lnd iau increment file',trim(LND_IAU_Control%iau_inc_files(itnext)) + call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(itnext)), errmsg, errflg) + ! endif + endif + call updateiauforcing(LND_IAU_Control,LND_IAU_Data,iau_state%wt) + endif + endif + ! sphum=get_tracer_index(MODEL_ATMOS,'sphum') + + end subroutine lnd_iau_mod_getiauforcing + +subroutine updateiauforcing(LND_IAU_Control,LND_IAU_Data,wt) + + implicit none + type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data + real(kind_phys) delt,wt + integer i,j,k,l + +! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'in updateiauforcing',nfiles,LND_IAU_Control%iaufhrs(1:nfiles) + delt = (iau_state%hr2-(LND_IAU_Control%fhour))/(IAU_state%hr2-IAU_state%hr1) + do j = js,je + do i = is,ie + do k = 1,npz + ! LND_IAU_Data%ua_inc(i,j,k) =(delt*IAU_state%inc1%ua_inc(i,j,k) + (1.-delt)* IAU_state%inc2%ua_inc(i,j,k))*rdt*wt + ! LND_IAU_Data%va_inc(i,j,k) =(delt*IAU_state%inc1%va_inc(i,j,k) + (1.-delt)* IAU_state%inc2%va_inc(i,j,k))*rdt*wt + ! LND_IAU_Data%temp_inc(i,j,k) =(delt*IAU_state%inc1%temp_inc(i,j,k) + (1.-delt)* IAU_state%inc2%temp_inc(i,j,k))*rdt*wt + ! LND_IAU_Data%delp_inc(i,j,k) =(delt*IAU_state%inc1%delp_inc(i,j,k) + (1.-delt)* IAU_state%inc2%delp_inc(i,j,k))*rdt*wt + ! LND_IAU_Data%delz_inc(i,j,k) =(delt*IAU_state%inc1%delz_inc(i,j,k) + (1.-delt)* IAU_state%inc2%delz_inc(i,j,k))*rdt*wt + ! do l=1,ntracers + ! LND_IAU_Data%tracer_inc(i,j,k,l) =(delt*IAU_state%inc1%tracer_inc(i,j,k,l) + (1.-delt)* IAU_state%inc2%tracer_inc(i,j,k,l))*rdt*wt + ! enddo + ! enddo + ! do k = 1,n_soill ! + LND_IAU_Data%stc_inc(i,j,k) =(delt*IAU_state%inc1%stc_inc(i,j,k) + (1.-delt)* IAU_state%inc2%stc_inc(i,j,k))*rdt*wt + LND_IAU_Data%slc_inc(i,j,k) =(delt*IAU_state%inc1%slc_inc(i,j,k) + (1.-delt)* IAU_state%inc2%slc_inc(i,j,k))*rdt*wt + end do + LND_IAU_Data%tmp2m_inc(i,j,1) =(delt*IAU_state%inc1%tmp2m_inc(i,j,1) + (1.-delt)* IAU_state%inc2%tmp2m_inc(i,j,1))*rdt*wt + LND_IAU_Data%spfh2m_inc(i,j,1) =(delt*IAU_state%inc1%spfh2m_inc(i,j,1) + (1.-delt)* IAU_state%inc2%spfh2m_inc(i,j,1))*rdt*wt + enddo + enddo + end subroutine updateiauforcing + + + subroutine setiauforcing(LND_IAU_Control,LND_IAU_Data,wt) + + implicit none + type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data + real(kind_phys) delt, dt,wt + integer i,j,k,l,sphum +! this is only called if using 1 increment file + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'in lnd_iau setiauforcing',rdt + do j = js,je + do i = is,ie + do k = 1,npz + ! LND_IAU_Data%ua_inc(i,j,k) =wt*IAU_state%inc1%ua_inc(i,j,k)*rdt + ! LND_IAU_Data%va_inc(i,j,k) =wt*IAU_state%inc1%va_inc(i,j,k)*rdt + ! LND_IAU_Data%temp_inc(i,j,k) =wt*IAU_state%inc1%temp_inc(i,j,k)*rdt + ! LND_IAU_Data%delp_inc(i,j,k) =wt*IAU_state%inc1%delp_inc(i,j,k)*rdt + ! LND_IAU_Data%delz_inc(i,j,k) =wt*IAU_state%inc1%delz_inc(i,j,k)*rdt + ! do l = 1,ntracers + ! LND_IAU_Data%tracer_inc(i,j,k,l) =wt*IAU_state%inc1%tracer_inc(i,j,k,l)*rdt + ! enddo + ! enddo + ! do k = 1,n_soill ! + LND_IAU_Data%stc_inc(i,j,k) = wt*IAU_state%inc1%stc_inc(i,j,k)*rdt + LND_IAU_Data%slc_inc(i,j,k) = wt*IAU_state%inc1%slc_inc(i,j,k)*rdt + end do + LND_IAU_Data%tmp2m_inc(i,j,1) = wt*IAU_state%inc1%tmp2m_inc(i,j,1)*rdt + LND_IAU_Data%spfh2m_inc(i,j,1) = wt*IAU_state%inc1%spfh2m_inc(i,j,1)*rdt + enddo + enddo +! sphum=get_tracer_index(MODEL_ATMOS,'sphum') + + end subroutine setiauforcing + +subroutine read_iau_forcing(LND_IAU_Control, increments, fname, errmsg, errflg) !, fname_sfc) + type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + type(iau_internal_data_type), intent(inout):: increments + character(len=*), intent(in) :: fname + ! character(len=*), intent(in), optional :: fname_sfc + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +!locals + ! real, dimension(:,:,:), allocatable:: u_inc, v_inc + + integer:: i, j, k, l, npz + integer:: i1, i2, j1 + integer:: jbeg, jend + ! real(kind=R_GRID), dimension(2):: p1, p2, p3 + ! real(kind=R_GRID), dimension(3):: e1, e2, ex, ey + + ! logical :: found + integer :: is, ie, js, je, km_store + logical :: exists + + !Errors messages handled through CCPP error handling variables + errmsg = '' + errflg = 0 + + is = LND_IAU_Control%isc + ie = is + LND_IAU_Control%nx-1 + js = LND_IAU_Control%jsc + je = js + LND_IAU_Control%ny-1 + + deg2rad = pi/180. + + npz = LND_IAU_Control%lsoil + + inquire (file=trim(fname), exist=exists) + if (exists) then + ! if( file_exist(fname) ) then + call open_ncfile( fname, ncid ) ! open the file + else + ! call mpp_error(FATAL,'==> Error in read_iau_forcing: Expected file '& + ! //trim(fname)//' for DA increment does not exist') + errmsg = 'FATAL Error in read_iau_forcing: Expected file '//trim(fname)//' for DA increment does not exist' + errflg = 1 + return + endif + + ! Find bounding latitudes: + jbeg = jm-1; jend = 2 + do j=js,je + do i=is,ie + j1 = jdc(i,j) + jbeg = min(jbeg, j1) + jend = max(jend, j1+1) + enddo + enddo + + ! allocate ( wk3(1:im,jbeg:jend, 1:km) ) + ! read in 1 time level +! call interp_inc(LND_IAU_Control, 'T_inc',increments%temp_inc(:,:,:),jbeg,jend) +! call interp_inc(LND_IAU_Control, 'delp_inc',increments%delp_inc(:,:,:),jbeg,jend) +! call interp_inc(LND_IAU_Control, 'delz_inc',increments%delz_inc(:,:,:),jbeg,jend) +! call interp_inc(LND_IAU_Control, 'u_inc',increments%ua_inc(:,:,:),jbeg,jend) ! can these be treated as scalars? +! call interp_inc(LND_IAU_Control, 'v_inc',increments%va_inc(:,:,:),jbeg,jend) +! ! do l=1,ntracers +! ! call interp_inc(trim(tracer_names(l))//'_inc',increments%tracer_inc(:,:,:,l),jbeg,jend) +! ! enddo +! call close_ncfile(ncid) +! deallocate (wk3) + +! ! is_land = .true. +! if ( present(fname_sfc) ) then +! inquire (file=trim(fname_sfc), exist=exists) +! if (exists) then +! ! if( file_exist(fname_sfc) ) then +! call open_ncfile( fname_sfc, ncid ) ! open the file +! else +! ! call mpp_error(FATAL,'==> Error in read_iau_forcing sfc: Expected file '& +! ! //trim(fname_sfc)//' for DA increment does not exist') +! errmsg = 'FATAL Error in read_iau_forcing sfc: Expected file '//trim(fname_sfc)//' for DA increment does not exist' +! errflg = 1 +! return +! endif + km_store = km + km = 1 ! n_soill Currently each soil layer increment is saved separately + allocate ( wk3(1:im,jbeg:jend, 1:km) ) + ! call interp_inc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend) !TODO check var name + call interp_inc(LND_IAU_Control, 'soilt1_inc',increments%stc_inc(:,:,1),jbeg,jend) + call interp_inc(LND_IAU_Control, 'soilt2_inc',increments%stc_inc(:,:,2),jbeg,jend) + call interp_inc(LND_IAU_Control, 'soilt3_inc',increments%stc_inc(:,:,3),jbeg,jend) + call interp_inc(LND_IAU_Control, 'soilt4_inc',increments%stc_inc(:,:,4),jbeg,jend) + + call interp_inc(LND_IAU_Control, 'slc1_inc',increments%slc_inc(:,:,1),jbeg,jend) + call interp_inc(LND_IAU_Control, 'slc2_inc',increments%slc_inc(:,:,2),jbeg,jend) + call interp_inc(LND_IAU_Control, 'slc3_inc',increments%slc_inc(:,:,3),jbeg,jend) + call interp_inc(LND_IAU_Control, 'slc4_inc',increments%slc_inc(:,:,4),jbeg,jend) + + call interp_inc(LND_IAU_Control, 'tmp2m_inc',increments%tmp2m_inc(:,:,1),jbeg,jend) + call interp_inc(LND_IAU_Control, 'spfh2m_inc',increments%spfh2m_inc(:,:,1),jbeg,jend) + ! call interp_inc_sfc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend, n_soill) + call close_ncfile(ncid) + deallocate (wk3) + km = km_store + ! else + ! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'No IAU inc file for sfc, setting stc_inc=0.' + ! increments%stc_inc(:,:,:) = 0. + ! end if + +end subroutine read_iau_forcing + +subroutine interp_inc(LND_IAU_Control, field_name,var,jbeg,jend) +! interpolate increment from GSI gaussian grid to cubed sphere +! everying is on the A-grid, earth relative + type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + character(len=*), intent(in) :: field_name + real, dimension(is:ie,js:je,1:km), intent(inout) :: var + integer, intent(in) :: jbeg,jend + integer:: i1, i2, j1, k,j,i,ierr + call check_var_exists(ncid, field_name, ierr) + if (ierr == 0) then + call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) + else + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(field_name),' found, assuming zero' + wk3 = 0. + endif + do k=1,km + do j=js,je + do i=is,ie + i1 = id1(i,j) + i2 = id2(i,j) + j1 = jdc(i,j) + var(i,j,k) = s2c(i,j,1)*wk3(i1,j1 ,k) + s2c(i,j,2)*wk3(i2,j1 ,k)+& + s2c(i,j,3)*wk3(i2,j1+1,k) + s2c(i,j,4)*wk3(i1,j1+1,k) + enddo + enddo + enddo +end subroutine interp_inc + +!> This routine is copied from 'fv_treat_da_inc.F90 by Xi.Chen +! copying it here, due to inability to 'include' from the original module when the land iau mod is called through CCPP frameowrk +! +!> @author Xi.Chen +!> @date 02/12/2016 +! +! REVISION HISTORY: +! 02/12/2016 - Initial Version + !============================================================================= + !>@brief The subroutine 'remap_coef' calculates the coefficients for horizonal regridding. + + subroutine remap_coef( is, ie, js, je, isd, ied, jsd, jed, & + im, jm, lon, lat, id1, id2, jdc, s2c, agrid ) + + integer, intent(in):: is, ie, js, je, isd, ied, jsd, jed + integer, intent(in):: im, jm + real(kind=kind_dyn), intent(in):: lon(im), lat(jm) + real, intent(out):: s2c(is:ie,js:je,4) + integer, intent(out), dimension(is:ie,js:je):: id1, id2, jdc + real(kind=kind_dyn), intent(in):: agrid(isd:ied,jsd:jed,2) + ! local: + real :: rdlon(im) + real :: rdlat(jm) + real:: a1, b1 + integer i,j, i1, i2, jc, i0, j0 + do i=1,im-1 + rdlon(i) = 1. / (lon(i+1) - lon(i)) + enddo + rdlon(im) = 1. / (lon(1) + 2.*pi - lon(im)) + + do j=1,jm-1 + rdlat(j) = 1. / (lat(j+1) - lat(j)) + enddo + + ! * Interpolate to cubed sphere cell center + do 5000 j=js,je + + do i=is,ie + + if ( agrid(i,j,1)>lon(im) ) then + i1 = im; i2 = 1 + a1 = (agrid(i,j,1)-lon(im)) * rdlon(im) + elseif ( agrid(i,j,1)=lon(i0) .and. agrid(i,j,1)<=lon(i0+1) ) then + i1 = i0; i2 = i0+1 + a1 = (agrid(i,j,1)-lon(i1)) * rdlon(i0) + go to 111 + endif + enddo + endif +111 continue + + if ( agrid(i,j,2)lat(jm) ) then + jc = jm-1 + b1 = 1. + else + do j0=1,jm-1 + if ( agrid(i,j,2)>=lat(j0) .and. agrid(i,j,2)<=lat(j0+1) ) then + jc = j0 + b1 = (agrid(i,j,2)-lat(jc)) * rdlat(jc) + go to 222 + endif + enddo + endif +222 continue + + if ( a1<0.0 .or. a1>1.0 .or. b1<0.0 .or. b1>1.0 ) then +!TODO uncomment and fix mpp_pe write(*,*) 'gid=', mpp_pe(), i,j,a1, b1 + endif + + s2c(i,j,1) = (1.-a1) * (1.-b1) + s2c(i,j,2) = a1 * (1.-b1) + s2c(i,j,3) = a1 * b1 + s2c(i,j,4) = (1.-a1) * b1 + id1(i,j) = i1 + id2(i,j) = i2 + jdc(i,j) = jc + enddo !i-loop +5000 continue ! j-loop + + end subroutine remap_coef + +! subroutine interp_inc_sfc(LND_IAU_Control, field_name,var,jbeg,jend, k_lv) !is_land_in) +! ! interpolate increment from GSI gaussian grid to cubed sphere +! ! everying is on the A-grid, earth relative +! type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control +! character(len=*), intent(in) :: field_name +! integer, intent(in) :: jbeg, jend, k_lv +! real, dimension(is:ie,js:je,1:k_lv), intent(inout) :: var +! ! logical, intent(in), optional :: is_land_in +! ! logical :: is_land +! integer:: i1, i2, j1, k,j,i,ierr +! ! k_lv = km +! ! is_land = .false. +! ! if ( present(is_land_in) ) is_land = is_land_in +! ! if (is_land) k_lv = n_soill +! call check_var_exists(ncid, field_name, ierr) +! if (ierr == 0) then +! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,k_lv, wk3 ) !k, wk3 ) +! else +! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(field_name),' found, assuming zero' +! wk3 = 0. +! endif + +! do k=1,k_lv !km +! do j=js,je +! do i=is,ie +! i1 = id1(i,j) +! i2 = id2(i,j) +! j1 = jdc(i,j) +! var(i,j,k) = s2c(i,j,1)*wk3(i1,j1 ,k) + s2c(i,j,2)*wk3(i2,j1 ,k)+& +! s2c(i,j,3)*wk3(i2,j1+1,k) + s2c(i,j,4)*wk3(i1,j1+1,k) +! enddo +! enddo +! enddo + +! end subroutine interp_inc_sfc + +end module lnd_iau_mod + + diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 6aff50666..a780eb745 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -12,6 +12,9 @@ module noahmpdrv use module_sf_noahmplsm + ! 3.5.24 for use in IAU + use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type,& + lnd_iau_mod_set_control, lnd_iau_mod_init,lnd_iau_mod_getiauforcing implicit none @@ -20,6 +23,10 @@ module noahmpdrv private public :: noahmpdrv_init, noahmpdrv_run + + ! IAU data and control + type (lnd_iau_control_type) :: LND_IAU_Control + type (lnd_iau_external_data_type) :: LND_IAU_Data !(number of blocks):each proc holds nblks contains @@ -29,29 +36,46 @@ module noahmpdrv !! \section arg_table_noahmpdrv_init Argument Table !! \htmlinclude noahmpdrv_init.html !! - subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & - nlunit, pores, resid, & - do_mynnsfclay,do_mynnedmf, & - errmsg, errflg) + subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & + isot, ivegsrc, & + nlunit, pores, resid, & + do_mynnsfclay,do_mynnedmf, & + errmsg, errflg, & + mpi_root, & + fn_nml, input_nml_file, isc, jsc, ncols, nx, ny, nblks, & + blksz, xlon, xlat, & + lsoil, lsnow_lsm, dtp, fhour) use machine, only: kind_phys use set_soilveg_mod, only: set_soilveg use namelist_soilveg use noahmp_tables + !use GFS_typedefs, only: GFS_control_type + ! use GFS_typedefs, only: GFS_data_type implicit none + integer, intent(in) :: lsm integer, intent(in) :: lsm_noahmp - integer, intent(in) :: me, isot, ivegsrc, nlunit - + integer, intent(in) :: me ! mpi_rank + integer, intent(in) :: isot, ivegsrc, nlunit real (kind=kind_phys), dimension(:), intent(out) :: pores, resid - logical, intent(in) :: do_mynnsfclay logical, intent(in) :: do_mynnedmf - - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + ! land iau mod + integer, intent(in) :: mpi_root ! = GFS_Control%master + character(*), intent(in) :: fn_nml + character(len=:), intent(in), dimension(:), pointer :: input_nml_file + integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks + integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz + real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon + real(kind_phys), dimension(:), intent(in) :: xlat ! latitude + integer, intent(in) :: lsoil, lsnow_lsm + real(kind=kind_phys), intent(in) :: dtp, fhour + ! type(gfs_data_type), dimension(:), intent(inout) :: GFS_Data ! !(one:) + !type(gfs_control_type), intent(in) :: GFS_Control ! Initialize CCPP error handling variables errmsg = '' @@ -85,7 +109,6 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & return end if - !--- initialize soil vegetation call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) @@ -101,6 +124,18 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & pores (:) = maxsmc (:) resid (:) = drysmc (:) + ! 3.7.24 init iau for land + call lnd_iau_mod_set_control(LND_IAU_Control, fn_nml, input_nml_file, me, mpi_root, isc,jsc, nx, ny, nblks, blksz, & + lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) +! print*, 'proc errmsg, errflg after set control', me, errmsg, errflg +! print*, 'proc iau_control isc, nx, dtp fhour', me, LND_IAU_Control%isc, LND_IAU_Control%nx, & +! LND_IAU_Control%dtp, LND_IAU_Control%fhour +! print*, 'proc iau_control incfiles(1)', me, LND_IAU_Control%iau_inc_files(1) +! stop + call lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) + !print*, 'proc errmsg, errflg interval after lnd_iau_init ', me,trim(errmsg), errflg, LND_IAU_Data%in_interval + print*, 'proc nblks blksize(1) after set init', me,LND_IAU_Control%nblks, LND_IAU_Control%blksz(1) + end subroutine noahmpdrv_init !> \ingroup NoahMP_LSM @@ -127,7 +162,7 @@ end subroutine noahmpdrv_init subroutine noahmpdrv_run & !................................... ! --- inputs: - ( im, km, lsnowl, itime, ps, u1, v1, t1, q1, soiltyp,soilcol,& + (nb, im, km, lsnowl, itime, fhour, ps, u1, v1, t1, q1, soiltyp,soilcol,& vegtype, sigmaf, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & prsl1, prslk1, prslki, prsik1, zf,pblh, dry, wind, slopetyp,& shdmin, shdmax, snoalb, sfalb, flag_iter,con_g, & @@ -136,7 +171,7 @@ subroutine noahmpdrv_run & iopt_trs,iopt_diag,xlatin, xcoszin, iyrlen, julian, garea, & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, rhonewsn1,& con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd, cpllnd2atm,& + con_fvirt, con_rd, con_hfus, thsfc_loc, & ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & @@ -229,10 +264,12 @@ subroutine noahmpdrv_run & ! --- CCPP interface fields (in call order) ! + integer , intent(in) :: nb !=cdata%blk_no, integer , intent(in) :: im ! horiz dimension and num of used pts integer , intent(in) :: km ! vertical soil layer dimension integer , intent(in) :: lsnowl ! lower bound for snow level arrays - integer , intent(in) :: itime ! NOT USED + integer , intent(in) :: itime ! NOT USED current forecast iteration + real(kind=kind_phys) , intent(in) :: fhour ! currentforecast time (hr) real(kind=kind_phys), dimension(:) , intent(in) :: ps ! surface pressure [Pa] real(kind=kind_phys), dimension(:) , intent(in) :: u1 ! u-component of wind [m/s] real(kind=kind_phys), dimension(:) , intent(in) :: v1 ! u-component of wind [m/s] @@ -310,9 +347,6 @@ subroutine noahmpdrv_run & logical , intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation - logical , intent(in) :: cpllnd ! Flag for land coupling (atm->lnd) - logical , intent(in) :: cpllnd2atm ! Flag for land coupling (lnd->atm) - real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! ground surface skin temperature [K] @@ -670,6 +704,13 @@ subroutine noahmpdrv_run & logical :: is_snowing ! used for penman calculation logical :: is_freeze_rain ! used for penman calculation integer :: i, k + + ! IAU update + real,allocatable :: stc_inc_flat(:,:) + real,allocatable :: slc_inc_flat(:,:) + real,allocatable :: tmp2m_inc_flat(:) + real,allocatable :: spfh2m_inc_flat(:) + integer :: j, ix, ib ! ! --- local derived constants: @@ -686,13 +727,62 @@ subroutine noahmpdrv_run & ! errmsg = '' errflg = 0 + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*,"nb ",nb," itime ",itime," GFScont%fhour ",fhour," iauCon%fhour",LND_IAU_Control%fhour," delt ",delt," iauCont%dtp",LND_IAU_Control%dtp + endif + ! 3.7.24 read iau increments + call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) + if (errflg .ne. 0) return + ! update with iau increments + if (LND_IAU_Data%in_interval) then + if (LND_IAU_Control%lsoil .ne. km) then + write(errmsg, *)'in noahmpdrv_run, lnd_iau_mod update increments:LND_IAU_Control%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km + errflg = 1 + return + endif + ! LND_IAU_Data%stc_inc(is:ie, js:je, km)) size of (nx, ny) + ! xlatin(im) stc(im,km) slc() t2mmp(:) q2mp(im) km=n_soill, im = + ! GFS_Control%blksz(cdata%blk_no) + ! >> need to get (cdata%blk_no from function call + + ! local variable to copy blocked data LND_IAU_Data%stc_inc + allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols + allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols + allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols + allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols + ib = 1 + do j = 1, LND_IAU_Control%ny !ny + do k = 1, km + stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%stc_inc(:,j,k) + slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j,k) + enddo + ! ib = 1 + ! do j = 1, LND_IAU_Control%ny !ny + tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) = LND_IAU_Data%tmp2m_inc(:,j,1) + spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) = LND_IAU_Data%spfh2m_inc(:,j,1) + ib = ib + LND_IAU_Control%nx !nlon + enddo + + !IAU increments are in units of 1/sec !LND_IAU_Control%dtp + ! delt=GFS_Control%dtf + if ((LND_IAU_Control%dtp - delt) > 0.0001) then + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*, "Warning time step used in noahmpdrv_run delt ",delt," different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp + endif + endif + do k = 1, km + stc(:,k)=stc(:,k)+stc_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1, k)*delt !LND_IAU_Control%dtp + slc(:,k)=slc(:,k)+slc_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1, k)*delt !LND_IAU_Control%dtp + enddo + t2mmp = t2mmp+tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1)*delt !LND_IAU_Control%dtp + q2mp = q2mp +spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1)*delt !LND_IAU_Control%dtp + + deallocate(stc_inc_flat, slc_inc_flat, tmp2m_inc_flat, spfh2m_inc_flat) + + end if -! -! --- Just return if external land component is activated for two-way interaction -! - if (cpllnd .and. cpllnd2atm) return - do i = 1, im +do i = 1, im if (flag_iter(i) .and. dry(i)) then diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 39eed1493..8a8093dd3 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -1,9 +1,8 @@ [ccpp-table-properties] name = noahmpdrv type = scheme - dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F - dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90 - dependencies = ../Noah/set_soilveg.f + dependencies = funcphys.f90,machine.F,sfc_diff.f,module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,set_soilveg.f + dependencies = sim_nc_mod_lnd.F90,lnd_iau_mod.F90 ######################################################################## [ccpp-arg-table] @@ -96,11 +95,136 @@ dimensions = () type = integer intent = out +[mpi_root] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[fn_nml] + standard_name = filename_of_namelist + long_name = namelist filename + units = none + type = character + dimensions = () + kind = len=* + intent = in +[input_nml_file] + standard_name = filename_of_internal_namelist + long_name = amelist filename for internal file reads + units = none + type = character + dimensions = (ccpp_constant_one:number_of_lines_in_internal_namelist) + kind = len=256 + intent = in +[isc] + standard_name = starting_x_index_for_this_mpi_rank + long_name = starting index in the x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[jsc] + standard_name = starting_y_index_for_this_mpi_rank + long_name = starting index in the y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[ncols] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[nx] + standard_name = number_of_points_in_x_direction_for_this_mpi_rank + long_name = number of points in x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[ny] + standard_name = number_of_points_in_y_direction_for_this_mpi_rank + long_name = number of points in y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[nblks] + standard_name = ccpp_block_count + long_name = for explicit data blocking: number of blocks + units = count + dimensions = () + type = integer + intent = in +[blksz] + standard_name = ccpp_block_sizes + long_name = for explicit data blocking: block sizes of all blocks + units = count + dimensions = (ccpp_constant_one:ccpp_block_count) + type = integer + intent = in +[xlon] + standard_name = longitude + long_name = longitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[xlat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[lsoil] + standard_name = vertical_dimension_of_soil + long_name = number of soil layers + units = count + dimensions = () + type = integer + intent = in +[lsnow_lsm] + standard_name = vertical_dimension_of_surface_snow + long_name = maximum number of snow layers for land surface model + units = count + dimensions = () + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in ######################################################################## [ccpp-arg-table] name = noahmpdrv_run type = scheme +[nb] + standard_name = ccpp_block_number + long_name = number of block for explicit data blocking in CCPP + units = index + dimensions = () + type = integer + intent = in [im] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -129,6 +253,14 @@ dimensions = () type = integer intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in [ps] standard_name = surface_air_pressure long_name = surface pressure @@ -635,20 +767,6 @@ dimensions = () type = logical intent = in -[cpllnd] - standard_name = flag_for_land_coupling - long_name = flag controlling cpllnd collection (default off) - units = flag - dimensions = () - type = logical - intent = in -[cpllnd2atm] - standard_name = flag_for_one_way_land_coupling_to_atmosphere - long_name = flag controlling land coupling to the atmosphere (default off) - units = flag - dimensions = () - type = logical - intent = in [weasd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land From bc810b4e0d68c4ba6b027ff7939cda3fd20bfd79 Mon Sep 17 00:00:00 2001 From: tsga Date: Sun, 17 Mar 2024 18:55:05 +0000 Subject: [PATCH 002/141] mv iau forcing read to noahmpdrv_timestep_init --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 212 +++++--- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 66 +++ .../SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 | 466 ++++++++++++++++++ 3 files changed, 679 insertions(+), 65 deletions(-) create mode 100644 physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index a780eb745..69228e926 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -22,7 +22,7 @@ module noahmpdrv private - public :: noahmpdrv_init, noahmpdrv_run + public :: noahmpdrv_init, noahmpdrv_run, noahmpdrv_timestep_init ! IAU data and control type (lnd_iau_control_type) :: LND_IAU_Control @@ -134,10 +134,153 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & ! stop call lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) !print*, 'proc errmsg, errflg interval after lnd_iau_init ', me,trim(errmsg), errflg, LND_IAU_Data%in_interval - print*, 'proc nblks blksize(1) after set init', me,LND_IAU_Control%nblks, LND_IAU_Control%blksz(1) + ! print*, 'proc nblks blksize(1) after set init', me,LND_IAU_Control%nblks, LND_IAU_Control%blksz(1) end subroutine noahmpdrv_init +!> \ingroup NoahMP_LSM +!! \brief This subroutine is called before noahmpdrv_run timestep to update +!! states with iau increments +!! \section arg_table_noahmpdrv_timestep_init Argument Table +!! \htmlinclude noahmpdrv_timestep_init.html +!! + subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_root, + stc, slc, errmsg, errflg) ! smc, t2mmp, q2mp, + ! lsnow_lsm, lsnowl, & + ! ncols, isc, jsc, nx, ny, nblks, + ! & + ! blksz, xlon, xlat, + ! & !& garea, iyrlen, julian, + ! vegtype, idveg, & + ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, + + use machine, only: kind_phys + + implicit none + + ! integer, intent(in) :: me !mpi_rank + ! integer, intent(in) :: mpi_root ! = GFS_Control%master + integer , intent(in) :: itime !current forecast iteration + real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) + real(kind=kind_phys) , intent(in) :: delt ! time interval [s] + integer , intent(in) :: km !vertical soil layer dimension + real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] + real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! integer, intent(in) :: lsnow_lsm + ! integer , intent(in) :: lsnowl ! lower bound for snow level arrays + ! integer, intent(in) :: ncols, isc, jsc, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks + ! integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz + ! real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon + ! real(kind_phys), dimension(:), intent(in) :: xlat ! latitude + !integer , dimension(:) , intent(in) :: vegtype !vegetation type (integer index) + ! real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] + ! real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] + ! real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! + ! ground surface skin temperature [K] + ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! + ! total soil moisture content [m3/m3] + ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! + ! soil temp [K] + ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc ! + ! liquid soil moisture [m3/m3] + ! real(kind=kind_phys), dimension(:) , intent(out) :: t2mmp ! + ! combined T2m from tiles + ! real(kind=kind_phys), dimension(:) , intent(out) :: q2mp ! + ! combined q2m from tiles + ! character(len=*), intent(out) :: errmsg + ! integer, intent(out) :: errflg + + ! --- local variable + ! integer :: nb, im ! vertical soil layer dimension + + ! IAU update + real,allocatable :: stc_inc_flat(:,:) + real,allocatable :: slc_inc_flat(:,:) + ! real,allocatable :: tmp2m_inc_flat(:) + ! real,allocatable :: spfh2m_inc_flat(:) + integer :: j, k, ib + ! --- end declaration + + ! --- Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + !> update current forecast hour + ! GFS_control%jdat(:) = jdat(:) + LND_IAU_Control%fhour=fhour + + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",LND_IAU_Control%fhour, & + " delt ",delt," IauCont%dtp",LND_IAU_Control%dtp + endif + + !> 3.7.24 read iau increments + call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) + if (errflg .ne. 0) then + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" + print*, errmsg + endif + return + endif + + !> update with iau increments + if (LND_IAU_Data%in_interval) then + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*, "adding land iau increments " + endif + + if (LND_IAU_Control%lsoil .ne. km) then + write(errmsg,*) 'noahmpdrv_timestep_init: LND_IAU_Data%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km + errflg = 1 + return + endif + + ! local variable to copy blocked data LND_IAU_Data%stc_inc + allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols + allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols + ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols + ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols + ib = 1 + do j = 1, LND_IAU_Control%ny !ny + do k = 1, km + stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) =LND_IAU_Data%stc_inc(:,j, k) + slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j, k) + enddo + ! ib = 1 + ! do j = 1, LND_IAU_Control%ny !ny + ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) =LND_IAU_Data%tmp2m_inc(:,j, 1) + ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1)=LND_IAU_Data%spfh2m_inc(:,j, 1) + + ib = ib + LND_IAU_Control%nx !nlon + enddo + + ! delt=GFS_Control%dtf + if ((LND_IAU_Control%dtp - delt) > 0.0001) then + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*, "Warning noahmpdrv_run delt ",delt,"different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp + endif + endif + !IAU increments are in units of 1/sec !LND_IAU_Control%dtp + do k = 1, km + stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !LND_IAU_Control%dtp + slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !LND_IAU_Control%dtp + enddo + ! t2mmp = t2mmp + & + ! tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb) + im-1)*delt !LND_IAU_Control%dtp + ! q2mp = q2mp + & + ! spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+ im-1)*delt !LND_IAU_Control%dtp + + deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) + + endif + + end subroutine noahmpdrv_timestep_init + + !> \ingroup NoahMP_LSM !! \brief This subroutine is the main CCPP entry point for the NoahMP LSM. !! \section arg_table_noahmpdrv_run Argument Table @@ -704,14 +847,7 @@ subroutine noahmpdrv_run & logical :: is_snowing ! used for penman calculation logical :: is_freeze_rain ! used for penman calculation integer :: i, k - - ! IAU update - real,allocatable :: stc_inc_flat(:,:) - real,allocatable :: slc_inc_flat(:,:) - real,allocatable :: tmp2m_inc_flat(:) - real,allocatable :: spfh2m_inc_flat(:) - integer :: j, ix, ib - + ! ! --- local derived constants: ! @@ -727,62 +863,8 @@ subroutine noahmpdrv_run & ! errmsg = '' errflg = 0 - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*,"nb ",nb," itime ",itime," GFScont%fhour ",fhour," iauCon%fhour",LND_IAU_Control%fhour," delt ",delt," iauCont%dtp",LND_IAU_Control%dtp - endif - ! 3.7.24 read iau increments - call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) - if (errflg .ne. 0) return - ! update with iau increments - if (LND_IAU_Data%in_interval) then - if (LND_IAU_Control%lsoil .ne. km) then - write(errmsg, *)'in noahmpdrv_run, lnd_iau_mod update increments:LND_IAU_Control%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km - errflg = 1 - return - endif - ! LND_IAU_Data%stc_inc(is:ie, js:je, km)) size of (nx, ny) - ! xlatin(im) stc(im,km) slc() t2mmp(:) q2mp(im) km=n_soill, im = - ! GFS_Control%blksz(cdata%blk_no) - ! >> need to get (cdata%blk_no from function call - - ! local variable to copy blocked data LND_IAU_Data%stc_inc - allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols - allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols - allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols - allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols - ib = 1 - do j = 1, LND_IAU_Control%ny !ny - do k = 1, km - stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%stc_inc(:,j,k) - slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j,k) - enddo - ! ib = 1 - ! do j = 1, LND_IAU_Control%ny !ny - tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) = LND_IAU_Data%tmp2m_inc(:,j,1) - spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) = LND_IAU_Data%spfh2m_inc(:,j,1) - ib = ib + LND_IAU_Control%nx !nlon - enddo - - !IAU increments are in units of 1/sec !LND_IAU_Control%dtp - ! delt=GFS_Control%dtf - if ((LND_IAU_Control%dtp - delt) > 0.0001) then - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*, "Warning time step used in noahmpdrv_run delt ",delt," different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp - endif - endif - do k = 1, km - stc(:,k)=stc(:,k)+stc_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1, k)*delt !LND_IAU_Control%dtp - slc(:,k)=slc(:,k)+slc_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1, k)*delt !LND_IAU_Control%dtp - enddo - t2mmp = t2mmp+tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1)*delt !LND_IAU_Control%dtp - q2mp = q2mp +spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1)*delt !LND_IAU_Control%dtp - - deallocate(stc_inc_flat, slc_inc_flat, tmp2m_inc_flat, spfh2m_inc_flat) - - end if - -do i = 1, im + do i = 1, im if (flag_iter(i) .and. dry(i)) then diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 8a8093dd3..2f037467f 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -214,6 +214,72 @@ kind = kind_phys intent = in +######################################################################## +[ccpp-arg-table] + name = noahmpdrv_timestep_init + type = scheme +[itime] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[delt] + standard_name = timestep_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[km] + standard_name = vertical_dimension_of_soil + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[slc] + standard_name = volume_fraction_of_unfrozen_water_in_soil + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + ######################################################################## [ccpp-arg-table] name = noahmpdrv_run diff --git a/physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 b/physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 new file mode 100644 index 000000000..9dcb096ef --- /dev/null +++ b/physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 @@ -0,0 +1,466 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the FV3 dynamical core. +!* +!* The FV3 dynamical core is free software: you can redistribute it +!* and/or modify it under the terms of the +!* GNU Lesser General Public License as published by the +!* Free Software Foundation, either version 3 of the License, or +!* (at your option) any later version. +!* +!* The FV3 dynamical core is distributed in the hope that it will be +!* useful, but WITHOUT ANYWARRANTY; without even the implied warranty +!* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +!* See the GNU General Public License for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with the FV3 dynamical core. +!* If not, see . +!*********************************************************************** + +!>@brief The module 'sim_nc' is a netcdf file reader. +!>@details The code is necessary to circumvent issues with the FMS +!! 'read_data' utility, which opens too many files and uses excessive +!! memory. +!>@author Shian-Jiann Lin + +module sim_nc_mod_lnd + +! This is S-J Lin's private netcdf file reader +! This code is needed because FMS utility (read_data) led to too much +! memory usage and too many files openned. Perhaps lower-level FMS IO +! calls should be used instead. + +#if defined(OLD_PT_TO_T) || defined(OLD_COS_SG) +#error +#error Compile time options -DOLD_PT_TO_T and -DOLD_COS_SG are no longer supported. Please remove them from your XML. +#error +#endif + +! use mpp_mod, only: mpp_error, FATAL + + implicit none +#include + + private + public open_ncfile, close_ncfile, get_ncdim1, get_var1_double, get_var2_double, & + get_var3_real, get_var3_double, get_var3_r4, get_var2_real, get_var2_r4, & + handle_err, check_var, get_var1_real, get_var_att_double, & + check_var_exists + + contains + + subroutine open_ncfile( iflnm, ncid ) + character(len=*), intent(in):: iflnm + integer, intent(out):: ncid + integer:: status + + status = nf_open (iflnm, NF_NOWRITE, ncid) + if (status .ne. NF_NOERR) call handle_err('nf_open',status) + + + end subroutine open_ncfile + + + subroutine close_ncfile( ncid ) + integer, intent(in):: ncid + integer:: status + + status = nf_close (ncid) + if (status .ne. NF_NOERR) call handle_err('nf_close',status) + + + end subroutine close_ncfile + + + subroutine get_ncdim1( ncid, var1_name, im ) + integer, intent(in):: ncid + character(len=*), intent(in):: var1_name + integer, intent(out):: im + integer:: status, var1id + + status = nf_inq_dimid (ncid, var1_name, var1id) + if (status .ne. NF_NOERR) call handle_err('dimid '//var1_name,status) + + status = nf_inq_dimlen (ncid, var1id, im) + if (status .ne. NF_NOERR) call handle_err('dimid '//var1_name,status) + + end subroutine get_ncdim1 + +!>@brief The 'get_var' subroutines read in variables from netcdf files + subroutine get_var1_double( ncid, var1_name, im, var1, var_exist ) + integer, intent(in):: ncid + character(len=*), intent(in):: var1_name + integer, intent(in):: im + logical, intent(out), optional:: var_exist + real(kind=8), intent(out):: var1(im) + integer:: status, var1id + + status = nf_inq_varid (ncid, var1_name, var1id) + if (status .ne. NF_NOERR) then +! call handle_err('varid '//var1_name,status) + if(present(var_exist) ) var_exist = .false. + else + status = nf_get_var_double (ncid, var1id, var1) + if (status .ne. NF_NOERR) call handle_err('varid '//var1_name,status) + if(present(var_exist) ) var_exist = .true. + endif + + + end subroutine get_var1_double + + +! 4-byte data: + subroutine get_var1_real( ncid, var1_name, im, var1, var_exist ) + integer, intent(in):: ncid + character(len=*), intent(in):: var1_name + integer, intent(in):: im + logical, intent(out), optional:: var_exist + real(kind=4), intent(out):: var1(im) + integer:: status, var1id + + status = nf_inq_varid (ncid, var1_name, var1id) + if (status .ne. NF_NOERR) then +! call handle_err(status) + if(present(var_exist) ) var_exist = .false. + else + status = nf_get_var_real (ncid, var1id, var1) + if (status .ne. NF_NOERR) call handle_err('get_var1_real1 '//var1_name,status) + if(present(var_exist) ) var_exist = .true. + endif + + + end subroutine get_var1_real + + subroutine get_var2_real( ncid, var_name, im, jm, var2 ) + integer, intent(in):: ncid + character(len=*), intent(in):: var_name + integer, intent(in):: im, jm + real(kind=4), intent(out):: var2(im) + + integer:: status, var1id + + status = nf_inq_varid (ncid, var_name, var1id) + if (status .ne. NF_NOERR) call handle_err('get_var2_real varid '//var_name,status) + + status = nf_get_var_real (ncid, var1id, var2) + if (status .ne. NF_NOERR) call handle_err('get_var2_real get_var'//var_name,status) + + end subroutine get_var2_real + + subroutine get_var2_r4( ncid, var2_name, is,ie, js,je, var2, time_slice ) + integer, intent(in):: ncid + character(len=*), intent(in):: var2_name + integer, intent(in):: is, ie, js, je + real(kind=4), intent(out):: var2(is:ie,js:je) + integer, intent(in), optional :: time_slice +! + real(kind=4), dimension(1) :: time + integer, dimension(3):: start, nreco + integer:: status, var2id + + status = nf_inq_varid (ncid, var2_name, var2id) + if (status .ne. NF_NOERR) call handle_err('get_var2_r4 varid'//var2_name,status) + + start(1) = is; start(2) = js; start(3) = 1 + if ( present(time_slice) ) then + start(3) = time_slice + end if + + nreco(1) = ie - is + 1 + nreco(2) = je - js + 1 + nreco(3) = 1 + + status = nf_get_vara_real(ncid, var2id, start, nreco, var2) + if (status .ne. NF_NOERR) call handle_err('get_var2_r4 get_vara_real'//var2_name,status) + + end subroutine get_var2_r4 + + subroutine get_var2_double( ncid, var2_name, im, jm, var2 ) + integer, intent(in):: ncid + character(len=*), intent(in):: var2_name + integer, intent(in):: im, jm + real(kind=8), intent(out):: var2(im,jm) + + integer:: status, var2id + + status = nf_inq_varid (ncid, var2_name, var2id) + if (status .ne. NF_NOERR) call handle_err('get_var2_double varid'//var2_name,status) + + status = nf_get_var_double (ncid, var2id, var2) + if (status .ne. NF_NOERR) call handle_err('get_var2_double get_var_double'//var2_name,status) + + + end subroutine get_var2_double + + + subroutine get_var3_double( ncid, var3_name, im, jm, km, var3 ) + integer, intent(in):: ncid + character(len=*), intent(in):: var3_name + integer, intent(in):: im, jm, km + real(kind=8), intent(out):: var3(im,jm,km) + + integer:: status, var3id + + status = nf_inq_varid (ncid, var3_name, var3id) + + if (status .ne. NF_NOERR) & + call handle_err('get_var3_double varid '//var3_name,status) + + status = nf_get_var_double (ncid, var3id, var3) + if (status .ne. NF_NOERR) & + call handle_err('get_var3_double get_vara_double '//var3_name,status) + + end subroutine get_var3_double + + subroutine get_var3_real( ncid, var3_name, im, jm, km, var3 ) + integer, intent(in):: ncid + character(len=*), intent(in):: var3_name + integer, intent(in):: im, jm, km + real(kind=4), intent(out):: var3(im,jm,km) + + integer:: status, var3id + + status = nf_inq_varid (ncid, var3_name, var3id) + + if (status .ne. NF_NOERR) & + call handle_err('get_var3_real varid '//var3_name,status) + status = nf_get_var_real (ncid, var3id, var3) + + if (status .ne. NF_NOERR) & + call handle_err('get_var3_real get_var_real '//var3_name,status) + + end subroutine get_var3_real + + + subroutine check_var_exists(ncid, var_name, status) + integer, intent(in):: ncid + integer, intent(inout) :: status + character(len=*), intent(in):: var_name + integer:: varid + status = nf_inq_varid (ncid, var_name, varid) + end subroutine check_var_exists + + subroutine get_var3_r4( ncid, var3_name, is,ie, js,je, ks,ke, var3, time_slice ) + integer, intent(in):: ncid + character(len=*), intent(in):: var3_name + integer, intent(in):: is, ie, js, je, ks,ke + real(kind=4), intent(out):: var3(is:ie,js:je,ks:ke) + integer, intent(in), optional :: time_slice +! + real(kind=4), dimension(1) :: time + integer, dimension(4):: start, nreco + integer:: status, var3id + + status = nf_inq_varid (ncid, var3_name, var3id) + if (status .ne. NF_NOERR) call handle_err('get_var3_r4 varid '//var3_name,status) + + start(1) = is; start(2) = js; start(3) = ks; start(4) = 1 + if ( present(time_slice) ) then + start(4) = time_slice + end if + + nreco(1) = ie - is + 1 + nreco(2) = je - js + 1 + nreco(3) = ke - ks + 1 + nreco(4) = 1 + + status = nf_get_vara_real(ncid, var3id, start, nreco, var3) + if (status .ne. NF_NOERR) call handle_err('get_var3_r4 get_vara_real '//var3_name,status) + + end subroutine get_var3_r4 + + + subroutine get_var4_real( ncid, var4_name, im, jm, km, nt, var4 ) + implicit none +#include + integer, intent(in):: ncid + character*(*), intent(in):: var4_name + integer, intent(in):: im, jm, km, nt + real*4:: wk4(im,jm,km,4) + real*4, intent(out):: var4(im,jm) + integer:: status, var4id + integer:: start(4), icount(4) + integer:: i,j + + start(1) = 1 + start(2) = 1 + start(3) = 1 + start(4) = nt + + icount(1) = im ! all range + icount(2) = jm ! all range + icount(3) = km ! all range + icount(4) = 1 ! one time level at a time + +! write(*,*) nt, 'Within get_var4_double: ', var4_name + + status = nf_inq_varid (ncid, var4_name, var4id) +! write(*,*) '#1', status, ncid, var4id + + status = nf_get_vara_real(ncid, var4id, start, icount, var4) +! status = nf_get_vara_real(ncid, var4id, start, icount, wk4) +! write(*,*) '#2', status, ncid, var4id + + do j=1,jm + do i=1,im +! var4(i,j) = wk4(i,j,1,nt) + enddo + enddo + + if (status .ne. NF_NOERR) call handle_err('get_var4_r4 get_vara_real '//var4_name,status) + + end subroutine get_var4_real + + + subroutine get_var4_double( ncid, var4_name, im, jm, km, nt, var4 ) + integer, intent(in):: ncid + character(len=*), intent(in):: var4_name + integer, intent(in):: im, jm, km, nt + real(kind=8), intent(out):: var4(im,jm,km,1) + integer:: status, var4id +! + integer:: start(4), icount(4) + + start(1) = 1 + start(2) = 1 + start(3) = 1 + start(4) = nt + + icount(1) = im ! all range + icount(2) = jm ! all range + icount(3) = km ! all range + icount(4) = 1 ! one time level at a time + + status = nf_inq_varid (ncid, var4_name, var4id) + status = nf_get_vara_double(ncid, var4id, start, icount, var4) + + if (status .ne. NF_NOERR) call handle_err('get_var4_double get_vara_double '//var4_name,status) + + end subroutine get_var4_double +!------------------------------------------------------------------------ + + subroutine get_real3( ncid, var4_name, im, jm, nt, var4 ) +! This is for multi-time-level 2D var + integer, intent(in):: ncid + character(len=*), intent(in):: var4_name + integer, intent(in):: im, jm, nt + real(kind=4), intent(out):: var4(im,jm) + integer:: status, var4id + integer:: start(3), icount(3) + integer:: i,j + + start(1) = 1 + start(2) = 1 + start(3) = nt + + icount(1) = im + icount(2) = jm + icount(3) = 1 + + status = nf_inq_varid (ncid, var4_name, var4id) + status = nf_get_vara_real(ncid, var4id, start, icount, var4) + + if (status .ne. NF_NOERR) & + call handle_err('get_real3 get_vara_real '//var4_name,status) + + end subroutine get_real3 +!------------------------------------------------------------------------ + + logical function check_var( ncid, var3_name) + integer, intent(in):: ncid + character(len=*), intent(in):: var3_name + + integer:: status, var3id + + status = nf_inq_varid (ncid, var3_name, var3id) + check_var = (status == NF_NOERR) + + end function check_var + + subroutine get_var_att_str(ncid, var_name, att_name, att) + implicit none +#include + integer, intent(in):: ncid + character*(*), intent(in):: var_name, att_name + character*(*), intent(out):: att + + integer:: status, varid + + status = nf_inq_varid (ncid, var_name, varid) + status = nf_get_att_text(ncid, varid, att_name, att) + + if (status .ne. NF_NOERR) call handle_err('get_var_att_str '//var_name,status) + + end subroutine get_var_att_str + + subroutine get_var_att_double(ncid, var_name, att_name, value) + implicit none +#include + integer, intent(in):: ncid + character*(*), intent(in):: var_name, att_name + real(kind=8), intent(out):: value + + integer:: status, varid + + status = nf_inq_varid (ncid, var_name, varid) + status = nf_get_att(ncid, varid, att_name, value) + + if (status .ne. NF_NOERR) call handle_err('get_var_att_double '//var_name,status) + + end subroutine get_var_att_double + + + subroutine handle_err(idstr, status, errflg) + integer status + character(len=500) :: errstr + character(len=*) :: idstr + integer, optional, intent(inout) :: errflg + + if (status .ne. nf_noerr) then + write(errstr,*) 'Error in handle_err: ',trim(idstr)//' ',NF_STRERROR(STATUS) + ! call mpp_error(FATAL,errstr) + ! if (available(errflg)) errflg = 1 + ! return + write(6, *) trim(errstr) + stop + endif + + end subroutine handle_err + +!>@brief The subroutine 'calendar' computes the current GMT. + subroutine calendar(year, month, day, hour) + integer, intent(inout) :: year ! year + integer, intent(inout) :: month ! month + integer, intent(inout) :: day ! day + integer, intent(inout) :: hour +! +! Local variables +! + integer irem4,irem100 + integer mdays(12) !< number day of month + data mdays /31,28,31,30,31,30,31,31,30,31,30,31/ +!**** consider leap year +! + irem4 = mod( year, 4 ) + irem100 = mod( year, 100 ) + if( irem4 == 0 .and. irem100 /= 0) mdays(2) = 29 +! + if( hour >= 24 ) then + day = day + 1 + hour = hour - 24 + end if + + if( day > mdays(month) ) then + day = day - mdays(month) + month = month + 1 + end if + if( month > 12 ) then + year = year + 1 + month = 1 + end if + + end subroutine calendar + +end module sim_nc_mod_lnd From fcbfb5ca175f1409114fb7267f6ff12a069772bd Mon Sep 17 00:00:00 2001 From: tsga Date: Tue, 19 Mar 2024 11:55:53 +0000 Subject: [PATCH 003/141] add land iau as noahmpdrv_time_vary module --- config/ccpp_prebuild_config.py | 250 +++++++++++++ driver/CCPP_driver.F90 | 254 +++++++++++++ physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 288 +++++++-------- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 130 +++---- .../Land/Noahmp/noahmpdrv_time_vary.F90 | 340 ++++++++++++++++++ .../Land/Noahmp/noahmpdrv_time_vary.meta | 230 ++++++++++++ .../suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml | 96 +++++ suites/suite_FV3_GFS_v17_p8_ugwpv1.xml | 95 +++++ 8 files changed, 1475 insertions(+), 208 deletions(-) create mode 100755 config/ccpp_prebuild_config.py create mode 100644 driver/CCPP_driver.F90 create mode 100644 physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.F90 create mode 100644 physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.meta create mode 100644 suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml create mode 100644 suites/suite_FV3_GFS_v17_p8_ugwpv1.xml diff --git a/config/ccpp_prebuild_config.py b/config/ccpp_prebuild_config.py new file mode 100755 index 000000000..6080e1769 --- /dev/null +++ b/config/ccpp_prebuild_config.py @@ -0,0 +1,250 @@ +#!/usr/bin/env python + +# CCPP prebuild config for GFDL Finite-Volume Cubed-Sphere Model (FV3) + + +############################################################################### +# Definitions # +############################################################################### + +HOST_MODEL_IDENTIFIER = "FV3" + +# Add all files with metadata tables on the host model side and in CCPP, +# relative to basedir = top-level directory of host model. This includes +# kind and type definitions used in CCPP physics. Also add any internal +# dependencies of these files to the list. +VARIABLE_DEFINITION_FILES = [ + # actual variable definition files + 'framework/src/ccpp_types.F90', + 'physics/physics/machine.F', + 'physics/physics/radsw_param.f', + 'physics/physics/radlw_param.f', + 'physics/physics/h2o_def.f', + 'physics/physics/radiation_surface.f', + 'physics/physics/module_ozphys.F90', + 'data/CCPP_typedefs.F90', + 'data/GFS_typedefs.F90', + 'data/CCPP_data.F90', + ] + +TYPEDEFS_NEW_METADATA = { + 'ccpp_types' : { + 'ccpp_t' : 'cdata', + 'ccpp_types' : '', + }, + 'machine' : { + 'machine' : '', + }, + 'module_radlw_parameters' : { + 'module_radsw_parameters' : '', + }, + 'module_radlw_parameters' : { + 'module_radlw_parameters' : '', + }, + 'module_ozphys' : { + 'module_ozphys' : '', + 'ty_ozphys' : '', + }, + 'CCPP_typedefs' : { + 'GFS_interstitial_type' : 'GFS_Interstitial(cdata%thrd_no)', + 'GFDL_interstitial_type' : 'GFDL_interstitial', + 'CCPP_typedefs' : '', + }, + 'CCPP_data' : { + 'CCPP_data' : '', + }, + 'GFS_typedefs' : { + 'GFS_control_type' : 'GFS_Control', + 'GFS_data_type' : 'GFS_Data(cdata%blk_no)', + 'GFS_diag_type' : 'GFS_Data(cdata%blk_no)%Intdiag', + 'GFS_tbd_type' : 'GFS_Data(cdata%blk_no)%Tbd', + 'GFS_sfcprop_type' : 'GFS_Data(cdata%blk_no)%Sfcprop', + 'GFS_coupling_type' : 'GFS_Data(cdata%blk_no)%Coupling', + 'GFS_statein_type' : 'GFS_Data(cdata%blk_no)%Statein', + 'GFS_cldprop_type' : 'GFS_Data(cdata%blk_no)%Cldprop', + 'GFS_radtend_type' : 'GFS_Data(cdata%blk_no)%Radtend', + 'GFS_grid_type' : 'GFS_Data(cdata%blk_no)%Grid', + 'GFS_stateout_type' : 'GFS_Data(cdata%blk_no)%Stateout', + 'GFS_typedefs' : '', + }, + } + +# Add all physics scheme files relative to basedir +SCHEME_FILES = [ + # Relative path to source (from where ccpp_prebuild.py is called) : [ list of physics sets in which scheme may be called ]; + # current restrictions are that each scheme can only belong to one physics set, and all schemes within one group in the + # suite definition file have to belong to the same physics set + 'physics/physics/GFS_DCNV_generic_pre.F90', + 'physics/physics/GFS_DCNV_generic_post.F90', + 'physics/physics/GFS_GWD_generic_pre.F90', + 'physics/physics/GFS_GWD_generic_post.F90', + 'physics/physics/GFS_MP_generic_pre.F90', + 'physics/physics/GFS_MP_generic_post.F90', + 'physics/physics/GFS_PBL_generic_pre.F90', + 'physics/physics/GFS_PBL_generic_post.F90', + 'physics/physics/GFS_SCNV_generic_pre.F90', + 'physics/physics/GFS_SCNV_generic_post.F90', + 'physics/physics/GFS_debug.F90', + 'physics/physics/GFS_phys_time_vary.fv3.F90', + 'physics/physics/GFS_rad_time_vary.fv3.F90', + 'physics/physics/GFS_radiation_surface.F90', + 'physics/physics/GFS_rrtmg_post.F90', + 'physics/physics/GFS_rrtmg_pre.F90', + 'physics/physics/GFS_rrtmg_setup.F90', + 'physics/physics/GFS_stochastics.F90', + 'physics/physics/GFS_suite_interstitial_rad_reset.F90', + 'physics/physics/GFS_suite_interstitial_phys_reset.F90', + 'physics/physics/GFS_suite_interstitial_1.F90', + 'physics/physics/GFS_suite_interstitial_2.F90', + 'physics/physics/GFS_suite_stateout_reset.F90', + 'physics/physics/GFS_suite_stateout_update.F90', + 'physics/physics/GFS_suite_interstitial_3.F90', + 'physics/physics/GFS_suite_interstitial_4.F90', + 'physics/physics/GFS_suite_interstitial_5.F90', + 'physics/physics/GFS_surface_generic_pre.F90', + 'physics/physics/GFS_surface_generic_post.F90', + 'physics/physics/GFS_surface_composites_pre.F90', + 'physics/physics/GFS_surface_composites_inter.F90', + 'physics/physics/GFS_surface_composites_post.F90', + 'physics/physics/GFS_surface_loop_control_part1.F90', + 'physics/physics/GFS_surface_loop_control_part2.F90', + 'physics/physics/GFS_time_vary_pre.fv3.F90', + 'physics/physics/GFS_physics_post.F90', + 'physics/physics/cires_ugwp.F90', + 'physics/physics/cires_ugwp_post.F90', + 'physics/physics/unified_ugwp.F90', + 'physics/physics/unified_ugwp_post.F90', + 'physics/physics/ugwpv1_gsldrag.F90', + 'physics/physics/ugwpv1_gsldrag_post.F90', + 'physics/physics/cnvc90.f', + 'physics/physics/cs_conv_pre.F90', + 'physics/physics/cs_conv.F90', + 'physics/physics/cs_conv_post.F90', + 'physics/physics/cs_conv_aw_adj.F90', + 'physics/physics/cu_ntiedtke_pre.F90', + 'physics/physics/cu_ntiedtke.F90', + 'physics/physics/cu_ntiedtke_post.F90', + 'physics/physics/dcyc2t3.f', + 'physics/physics/drag_suite.F90', + 'physics/physics/shoc.F90', + 'physics/physics/get_prs_fv3.F90', + 'physics/physics/get_phi_fv3.F90', + 'physics/physics/gfdl_cloud_microphys.F90', + 'physics/physics/fv_sat_adj.F90', + 'physics/physics/gfdl_sfc_layer.F90', + 'physics/physics/zhaocarr_gscond.f', + 'physics/physics/gwdc_pre.f', + 'physics/physics/gwdc.f', + 'physics/physics/gwdc_post.f', + 'physics/physics/gwdps.f', + 'physics/physics/h2ophys.f', + 'physics/physics/samfdeepcnv.f', + 'physics/physics/samfshalcnv.f', + 'physics/physics/sascnvn.F', + 'physics/physics/shalcnv.F', + 'physics/physics/maximum_hourly_diagnostics.F90', + 'physics/physics/m_micro.F90', + 'physics/physics/m_micro_pre.F90', + 'physics/physics/m_micro_post.F90', + 'physics/physics/cu_gf_driver_pre.F90', + 'physics/physics/cu_gf_driver.F90', + 'physics/physics/cu_gf_driver_post.F90', + 'physics/physics/cu_c3_driver_pre.F90', + 'physics/physics/cu_c3_driver.F90', + 'physics/physics/cu_c3_driver_post.F90', + 'physics/physics/hedmf.f', + 'physics/physics/moninshoc.f', + 'physics/physics/satmedmfvdif.F', + 'physics/physics/satmedmfvdifq.F', + 'physics/physics/shinhongvdif.F90', + 'physics/physics/ysuvdif.F90', + 'physics/physics/mynnedmf_wrapper.F90', + 'physics/physics/mynnsfc_wrapper.F90', + 'physics/physics/sgscloud_radpre.F90', + 'physics/physics/sgscloud_radpost.F90', + 'physics/physics/myjsfc_wrapper.F90', + 'physics/physics/myjpbl_wrapper.F90', + 'physics/physics/mp_thompson_pre.F90', + 'physics/physics/mp_thompson.F90', + 'physics/physics/mp_thompson_post.F90', + 'physics/physics/mp_nssl.F90', + 'physics/physics/zhaocarr_precpd.f', + 'physics/physics/radlw_main.F90', + 'physics/physics/radsw_main.F90', + 'physics/physics/rascnv.F90', + 'physics/physics/rayleigh_damp.f', + 'physics/physics/rrtmg_lw_post.F90', + 'physics/physics/rrtmg_lw_pre.F90', + 'physics/physics/rrtmg_sw_post.F90', + 'physics/physics/rad_sw_pre.F90', + 'physics/physics/sfc_diag.f', + 'physics/physics/sfc_diag_post.F90', + 'physics/physics/lsm_ruc.F90', + 'physics/physics/sfc_cice.f', + 'physics/physics/sfc_diff.f', + 'physics/physics/lsm_noah.f', + 'physics/physics/noahmpdrv.F90', + 'physics/physics/noahmpdrv_time_vary.F90', + 'physics/physics/flake_driver.F90', + 'physics/physics/clm_lake.f90', + 'physics/physics/sfc_nst_pre.f90', + 'physics/physics/sfc_nst.f90', + 'physics/physics/sfc_nst_post.f90', + 'physics/physics/sfc_ocean.F', + 'physics/physics/sfc_sice.f', + # HAFS FER_HIRES + 'physics/physics/mp_fer_hires.F90', + # SMOKE + 'physics/physics/smoke_dust/rrfs_smoke_wrapper.F90', + 'physics/physics/smoke_dust/rrfs_smoke_postpbl.F90', + # RRTMGP + 'physics/physics/rrtmgp_aerosol_optics.F90', + 'physics/physics/rrtmgp_lw_main.F90', + 'physics/physics/rrtmgp_sw_main.F90', + 'physics/physics/GFS_rrtmgp_setup.F90', + 'physics/physics/GFS_rrtmgp_pre.F90', + 'physics/physics/GFS_cloud_diagnostics.F90', + 'physics/physics/GFS_rrtmgp_cloud_mp.F90', + 'physics/physics/GFS_rrtmgp_cloud_overlap.F90', + 'physics/physics/GFS_rrtmgp_post.F90' + ] + +# Default build dir, relative to current working directory, +# if not specified as command-line argument +DEFAULT_BUILD_DIR = 'build' + +# Auto-generated makefile/cmakefile snippets that contain all type definitions +TYPEDEFS_MAKEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.mk' +TYPEDEFS_CMAKEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.cmake' +TYPEDEFS_SOURCEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.sh' + +# Auto-generated makefile/cmakefile snippets that contain all schemes +SCHEMES_MAKEFILE = '{build_dir}/physics/CCPP_SCHEMES.mk' +SCHEMES_CMAKEFILE = '{build_dir}/physics/CCPP_SCHEMES.cmake' +SCHEMES_SOURCEFILE = '{build_dir}/physics/CCPP_SCHEMES.sh' + +# Auto-generated makefile/cmakefile snippets that contain all caps +CAPS_MAKEFILE = '{build_dir}/physics/CCPP_CAPS.mk' +CAPS_CMAKEFILE = '{build_dir}/physics/CCPP_CAPS.cmake' +CAPS_SOURCEFILE = '{build_dir}/physics/CCPP_CAPS.sh' + +# Directory where to put all auto-generated physics caps +CAPS_DIR = '{build_dir}/physics' + +# Directory where the suite definition files are stored +SUITES_DIR = 'suites' + +# Directory where to write static API to +STATIC_API_DIR = '{build_dir}/physics' +STATIC_API_CMAKEFILE = '{build_dir}/physics/CCPP_STATIC_API.cmake' +STATIC_API_SOURCEFILE = '{build_dir}/physics/CCPP_STATIC_API.sh' + +# Directory for writing HTML pages generated from metadata files +# used by metadata2html.py for generating scientific documentation +METADATA_HTML_OUTPUT_DIR = '{build_dir}/physics/physics/docs' + +# HTML document containing the model-defined CCPP variables +HTML_VARTABLE_FILE = '{build_dir}/physics/CCPP_VARIABLES_FV3.html' + +# LaTeX document containing the provided vs requested CCPP variables +LATEX_VARTABLE_FILE = '{build_dir}/framework/doc/DevelopersGuide/CCPP_VARIABLES_FV3.tex' diff --git a/driver/CCPP_driver.F90 b/driver/CCPP_driver.F90 new file mode 100644 index 000000000..6c633fc4d --- /dev/null +++ b/driver/CCPP_driver.F90 @@ -0,0 +1,254 @@ +module CCPP_driver + + use ccpp_types, only: ccpp_t + + use ccpp_static_api, only: ccpp_physics_init, & + ccpp_physics_timestep_init, & + ccpp_physics_run, & + ccpp_physics_timestep_finalize, & + ccpp_physics_finalize + + use CCPP_data, only: cdata_tile, & + cdata_domain, & + cdata_block, & + ccpp_suite, & + GFS_control, & + GFS_data + + implicit none + +!--------------------------------------------------------! +! Pointer to CCPP containers defined in CCPP_data ! +!--------------------------------------------------------! + type(ccpp_t), pointer :: cdata => null() + +!--------------------------------------------------------! +! Flag for non-uniform block sizes (last block smaller) ! +! and number of OpenMP threads (with special thread ! +! number nthrdsX in case of non-uniform block sizes) ! +!--------------------------------------------------------! + logical :: non_uniform_blocks + integer :: nthrds, nthrdsX + +!---------------- +! Public Entities +!---------------- +! functions + public CCPP_step +! module variables + public non_uniform_blocks + + CONTAINS +!******************************************************************************************* + +!------------------------------- +! CCPP step +!------------------------------- + subroutine CCPP_step (step, nblks, ierr) + +#ifdef _OPENMP + use omp_lib +#endif + + implicit none + + character(len=*), intent(in) :: step + integer, intent(in) :: nblks + integer, intent(out) :: ierr + ! Local variables + integer :: nb, nt, ntX + integer :: ierr2 + ! DH* 20210104 - remove kdt_rad when code to clear diagnostic buckets is removed + integer :: kdt_rad + + ierr = 0 + + if (trim(step)=="init") then + + ! Get and set number of OpenMP threads (module + ! variable) that are available to run physics +#ifdef _OPENMP + nthrds = omp_get_max_threads() +#else + nthrds = 1 +#endif + + ! For non-uniform blocksizes, we use index nthrds+1 + ! for the interstitial data type with different length + if (non_uniform_blocks) then + nthrdsX = nthrds+1 + else + nthrdsX = nthrds + end if + + ! For physics running over the entire domain, block and thread + ! number are not used; set to safe values + cdata_domain%blk_no = 1 + cdata_domain%thrd_no = 1 + + ! Allocate cdata structures for blocks and threads + if (.not.allocated(cdata_block)) allocate(cdata_block(1:nblks,1:nthrdsX)) + + ! Loop over all blocks and threads + do nt=1,nthrdsX + do nb=1,nblks + ! Assign the correct block and thread numbers + cdata_block(nb,nt)%blk_no = nb + cdata_block(nb,nt)%thrd_no = nt + end do + end do + + else if (trim(step)=="physics_init") then + + ! Since the physics init step is independent of the blocking structure, + ! we can use cdata_domain. And since we don't use threading on the host + ! model side, we can allow threading inside the physics init routines. + GFS_control%nthreads = nthrds + + call ccpp_physics_init(cdata_domain, suite_name=trim(ccpp_suite), ierr=ierr) + if (ierr/=0) then + write(0,'(a)') "An error occurred in ccpp_physics_init" + write(0,'(a)') trim(cdata_domain%errmsg) + return + end if + + ! Timestep init = time_vary + else if (trim(step)=="timestep_init") then + + ! Since the physics timestep init step is independent of the blocking structure, + ! we can use cdata_domain. And since we don't use threading on the host + ! model side, we can allow threading inside the timestep init (time_vary) routines. + GFS_control%nthreads = nthrds + + call ccpp_physics_timestep_init(cdata_domain, suite_name=trim(ccpp_suite), group_name="time_vary", ierr=ierr) + if (ierr/=0) then + write(0,'(a)') "An error occurred in ccpp_physics_timestep_init for group time_vary" + write(0,'(a)') trim(cdata_domain%errmsg) + return + end if + + ! call timestep_init for "physics" + call ccpp_physics_timestep_init(cdata_domain, suite_name=trim(ccpp_suite),group_name="physics", ierr=ierr) + if (ierr/=0) then + write(0,'(a)') "An error occurred in ccpp_physics_timestep_init for group physics" + write(0,'(a)') trim(cdata_domain%errmsg) + return + end if + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! DH* 20210104 - this block of code will be removed once the CCPP framework ! + ! fully supports handling diagnostics through its metadata, work in progress ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !--- determine if radiation diagnostics buckets need to be cleared + if (nint(GFS_control%fhzero*3600) >= nint(max(GFS_control%fhswr,GFS_control%fhlwr))) then + if (mod(GFS_control%kdt,GFS_control%nszero) == 1) then + do nb = 1,nblks + call GFS_data(nb)%Intdiag%rad_zero(GFS_control) + end do + endif + else + kdt_rad = nint(min(GFS_control%fhswr,GFS_control%fhlwr)/GFS_control%dtp) + if (mod(GFS_control%kdt,kdt_rad) == 1) then + do nb = 1,nblks + call GFS_data(nb)%Intdiag%rad_zero(GFS_control) + enddo + endif + endif + + !--- determine if physics diagnostics buckets need to be cleared + if ((mod(GFS_control%kdt-1,GFS_control%nszero)) == 0) then + do nb = 1,nblks + call GFS_data(nb)%Intdiag%phys_zero(GFS_control) + end do + endif + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! *DH 20210104 ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! Radiation, physics and and stochastic physics - threaded regions using blocked data structures + else if (trim(step)=="radiation" .or. trim(step)=="physics" .or. trim(step)=="stochastics") then + + ! Set number of threads available to physics schemes to one, + ! because threads are used on the host model side for blocking + GFS_control%nthreads = 1 + +!$OMP parallel num_threads (nthrds) & +!$OMP default (shared) & +!$OMP private (nb,nt,ntX,ierr2) & +!$OMP reduction (+:ierr) +#ifdef _OPENMP + nt = omp_get_thread_num()+1 +#else + nt = 1 +#endif +!$OMP do schedule (dynamic,1) + do nb = 1,nblks + ! For non-uniform blocks, the last block has a different (shorter) + ! length than the other blocks; use special CCPP_Interstitial(nthrdsX) + if (non_uniform_blocks .and. nb==nblks) then + ntX = nthrdsX + else + ntX = nt + end if + !--- Call CCPP radiation/physics/stochastics group + call ccpp_physics_run(cdata_block(nb,ntX), suite_name=trim(ccpp_suite), group_name=trim(step), ierr=ierr2) + if (ierr2/=0) then + write(0,'(2a,3(a,i4),a)') "An error occurred in ccpp_physics_run for group ", trim(step), & + ", block ", nb, " and thread ", nt, " (ntX=", ntX, "):" + write(0,'(a)') trim(cdata_block(nb,ntX)%errmsg) + ierr = ierr + ierr2 + end if + end do +!$OMP end do + +!$OMP end parallel + if (ierr/=0) return + + ! Timestep finalize = time_vary + else if (trim(step)=="timestep_finalize") then + + ! Since the physics timestep finalize step is independent of the blocking structure, + ! we can use cdata_domain. And since we don't use threading on the host model side, + ! we can allow threading inside the timestep finalize (time_vary) routines. + GFS_control%nthreads = nthrds + + call ccpp_physics_timestep_finalize(cdata_domain, suite_name=trim(ccpp_suite), group_name="time_vary", ierr=ierr) + if (ierr/=0) then + write(0,'(a)') "An error occurred in ccpp_physics_timestep_finalize for group time_vary" + write(0,'(a)') trim(cdata_domain%errmsg) + return + end if + + ! Physics finalize + else if (trim(step)=="physics_finalize") then + + ! Since the physics finalize step is independent of the blocking structure, + ! we can use cdata_domain. And since we don't use threading on the host + ! model side, we can allow threading inside the physics finalize routines. + GFS_control%nthreads = nthrds + + call ccpp_physics_finalize(cdata_domain, suite_name=trim(ccpp_suite), ierr=ierr) + if (ierr/=0) then + write(0,'(a)') "An error occurred in ccpp_physics_finalize" + write(0,'(a)') trim(cdata_domain%errmsg) + return + end if + + ! Finalize + else if (trim(step)=="finalize") then + ! Deallocate cdata structure for blocks and threads + if (allocated(cdata_block)) deallocate(cdata_block) + + else + + write(0,'(2a)') 'Error, undefined CCPP step ', trim(step) + ierr = 1 + return + + end if + + end subroutine CCPP_step + +end module CCPP_driver diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 69228e926..cb92724c0 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -13,8 +13,8 @@ module noahmpdrv use module_sf_noahmplsm ! 3.5.24 for use in IAU - use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type,& - lnd_iau_mod_set_control, lnd_iau_mod_init,lnd_iau_mod_getiauforcing +! use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type,& +! lnd_iau_mod_set_control, lnd_iau_mod_init,lnd_iau_mod_getiauforcing implicit none @@ -22,11 +22,11 @@ module noahmpdrv private - public :: noahmpdrv_init, noahmpdrv_run, noahmpdrv_timestep_init + public :: noahmpdrv_init, noahmpdrv_run !, noahmpdrv_timestep_init ! IAU data and control - type (lnd_iau_control_type) :: LND_IAU_Control - type (lnd_iau_external_data_type) :: LND_IAU_Data !(number of blocks):each proc holds nblks +! type (lnd_iau_control_type) :: LND_IAU_Control +! type (lnd_iau_external_data_type) :: LND_IAU_Data !(number of blocks):each proc holds nblks contains @@ -125,14 +125,16 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & resid (:) = drysmc (:) ! 3.7.24 init iau for land - call lnd_iau_mod_set_control(LND_IAU_Control, fn_nml, input_nml_file, me, mpi_root, isc,jsc, nx, ny, nblks, blksz, & - lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) +! call lnd_iau_mod_set_control(LND_IAU_Control, fn_nml, input_nml_file, me, mpi_root, isc,jsc, nx, ny, nblks, blksz, & +! lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) + ! print*, 'proc errmsg, errflg after set control', me, errmsg, errflg ! print*, 'proc iau_control isc, nx, dtp fhour', me, LND_IAU_Control%isc, LND_IAU_Control%nx, & ! LND_IAU_Control%dtp, LND_IAU_Control%fhour ! print*, 'proc iau_control incfiles(1)', me, LND_IAU_Control%iau_inc_files(1) ! stop - call lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) + +! call lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) !print*, 'proc errmsg, errflg interval after lnd_iau_init ', me,trim(errmsg), errflg, LND_IAU_Data%in_interval ! print*, 'proc nblks blksize(1) after set init', me,LND_IAU_Control%nblks, LND_IAU_Control%blksz(1) @@ -144,141 +146,141 @@ end subroutine noahmpdrv_init !! \section arg_table_noahmpdrv_timestep_init Argument Table !! \htmlinclude noahmpdrv_timestep_init.html !! - subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_root, - stc, slc, errmsg, errflg) ! smc, t2mmp, q2mp, - ! lsnow_lsm, lsnowl, & - ! ncols, isc, jsc, nx, ny, nblks, - ! & - ! blksz, xlon, xlat, - ! & !& garea, iyrlen, julian, - ! vegtype, idveg, & - ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, - - use machine, only: kind_phys - - implicit none - - ! integer, intent(in) :: me !mpi_rank - ! integer, intent(in) :: mpi_root ! = GFS_Control%master - integer , intent(in) :: itime !current forecast iteration - real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) - real(kind=kind_phys) , intent(in) :: delt ! time interval [s] - integer , intent(in) :: km !vertical soil layer dimension - real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] - real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! integer, intent(in) :: lsnow_lsm - ! integer , intent(in) :: lsnowl ! lower bound for snow level arrays - ! integer, intent(in) :: ncols, isc, jsc, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks - ! integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz - ! real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon - ! real(kind_phys), dimension(:), intent(in) :: xlat ! latitude - !integer , dimension(:) , intent(in) :: vegtype !vegetation type (integer index) - ! real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] - ! real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] - ! real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! - ! ground surface skin temperature [K] - ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! - ! total soil moisture content [m3/m3] - ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! - ! soil temp [K] - ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc ! - ! liquid soil moisture [m3/m3] - ! real(kind=kind_phys), dimension(:) , intent(out) :: t2mmp ! - ! combined T2m from tiles - ! real(kind=kind_phys), dimension(:) , intent(out) :: q2mp ! - ! combined q2m from tiles - ! character(len=*), intent(out) :: errmsg - ! integer, intent(out) :: errflg - - ! --- local variable - ! integer :: nb, im ! vertical soil layer dimension - - ! IAU update - real,allocatable :: stc_inc_flat(:,:) - real,allocatable :: slc_inc_flat(:,:) - ! real,allocatable :: tmp2m_inc_flat(:) - ! real,allocatable :: spfh2m_inc_flat(:) - integer :: j, k, ib - ! --- end declaration - - ! --- Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - !> update current forecast hour - ! GFS_control%jdat(:) = jdat(:) - LND_IAU_Control%fhour=fhour - - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",LND_IAU_Control%fhour, & - " delt ",delt," IauCont%dtp",LND_IAU_Control%dtp - endif - - !> 3.7.24 read iau increments - call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) - if (errflg .ne. 0) then - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" - print*, errmsg - endif - return - endif - - !> update with iau increments - if (LND_IAU_Data%in_interval) then - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*, "adding land iau increments " - endif - - if (LND_IAU_Control%lsoil .ne. km) then - write(errmsg,*) 'noahmpdrv_timestep_init: LND_IAU_Data%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km - errflg = 1 - return - endif - - ! local variable to copy blocked data LND_IAU_Data%stc_inc - allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols - allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols - ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols - ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols - ib = 1 - do j = 1, LND_IAU_Control%ny !ny - do k = 1, km - stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) =LND_IAU_Data%stc_inc(:,j, k) - slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j, k) - enddo - ! ib = 1 - ! do j = 1, LND_IAU_Control%ny !ny - ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) =LND_IAU_Data%tmp2m_inc(:,j, 1) - ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1)=LND_IAU_Data%spfh2m_inc(:,j, 1) - - ib = ib + LND_IAU_Control%nx !nlon - enddo - - ! delt=GFS_Control%dtf - if ((LND_IAU_Control%dtp - delt) > 0.0001) then - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*, "Warning noahmpdrv_run delt ",delt,"different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp - endif - endif - !IAU increments are in units of 1/sec !LND_IAU_Control%dtp - do k = 1, km - stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !LND_IAU_Control%dtp - slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !LND_IAU_Control%dtp - enddo - ! t2mmp = t2mmp + & - ! tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb) + im-1)*delt !LND_IAU_Control%dtp - ! q2mp = q2mp + & - ! spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+ im-1)*delt !LND_IAU_Control%dtp - - deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) - - endif - - end subroutine noahmpdrv_timestep_init +! subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_root, +! stc, slc, errmsg, errflg) ! smc, t2mmp, q2mp, +! ! lsnow_lsm, lsnowl, & +! ! ncols, isc, jsc, nx, ny, nblks, +! ! & +! ! blksz, xlon, xlat, +! ! & !& garea, iyrlen, julian, +! ! vegtype, idveg, & +! ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, +! +! use machine, only: kind_phys +! +! implicit none +! +! ! integer, intent(in) :: me !mpi_rank +! ! integer, intent(in) :: mpi_root ! = GFS_Control%master +! integer , intent(in) :: itime !current forecast iteration +! real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) +! real(kind=kind_phys) , intent(in) :: delt ! time interval [s] +! integer , intent(in) :: km !vertical soil layer dimension +! real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] +! real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' +! character(len=*), intent(out) :: errmsg +! integer, intent(out) :: errflg +! +! ! integer, intent(in) :: lsnow_lsm +! ! integer , intent(in) :: lsnowl ! lower bound for snow level arrays +! ! integer, intent(in) :: ncols, isc, jsc, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks +! ! integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz +! ! real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon +! ! real(kind_phys), dimension(:), intent(in) :: xlat ! latitude +! !integer , dimension(:) , intent(in) :: vegtype !vegetation type (integer index) +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! +! ! ground surface skin temperature [K] +! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! +! ! total soil moisture content [m3/m3] +! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! +! ! soil temp [K] +! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc ! +! ! liquid soil moisture [m3/m3] +! ! real(kind=kind_phys), dimension(:) , intent(out) :: t2mmp ! +! ! combined T2m from tiles +! ! real(kind=kind_phys), dimension(:) , intent(out) :: q2mp ! +! ! combined q2m from tiles +! ! character(len=*), intent(out) :: errmsg +! ! integer, intent(out) :: errflg +! +! ! --- local variable +! ! integer :: nb, im ! vertical soil layer dimension +! +! ! IAU update +! real,allocatable :: stc_inc_flat(:,:) +! real,allocatable :: slc_inc_flat(:,:) +! ! real,allocatable :: tmp2m_inc_flat(:) +! ! real,allocatable :: spfh2m_inc_flat(:) +! integer :: j, k, ib +! ! --- end declaration +! +! ! --- Initialize CCPP error handling variables +! errmsg = '' +! errflg = 0 +! +! !> update current forecast hour +! ! GFS_control%jdat(:) = jdat(:) +! LND_IAU_Control%fhour=fhour +! +! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then +! print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",LND_IAU_Control%fhour, & +! " delt ",delt," IauCont%dtp",LND_IAU_Control%dtp +! endif +! +! !> 3.7.24 read iau increments +! call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) +! if (errflg .ne. 0) then +! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then +! print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" +! print*, errmsg +! endif +! return +! endif +! +! !> update with iau increments +! if (LND_IAU_Data%in_interval) then +! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then +! print*, "adding land iau increments " +! endif +! +! if (LND_IAU_Control%lsoil .ne. km) then +! write(errmsg,*) 'noahmpdrv_timestep_init: LND_IAU_Data%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km +! errflg = 1 +! return +! endif +! +! ! local variable to copy blocked data LND_IAU_Data%stc_inc +! allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols +! allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols +! ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols +! ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols +! ib = 1 +! do j = 1, LND_IAU_Control%ny !ny +! do k = 1, km +! stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) =LND_IAU_Data%stc_inc(:,j, k) +! slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j, k) +! enddo +! ! ib = 1 +! ! do j = 1, LND_IAU_Control%ny !ny +! ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) =LND_IAU_Data%tmp2m_inc(:,j, 1) +! ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1)=LND_IAU_Data%spfh2m_inc(:,j, 1) +! +! ib = ib + LND_IAU_Control%nx !nlon +! enddo +! +! ! delt=GFS_Control%dtf +! if ((LND_IAU_Control%dtp - delt) > 0.0001) then +! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then +! print*, "Warning noahmpdrv_run delt ",delt,"different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp +! endif +! endif +! !IAU increments are in units of 1/sec !LND_IAU_Control%dtp +! do k = 1, km +! stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !LND_IAU_Control%dtp +! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !LND_IAU_Control%dtp +! enddo +! ! t2mmp = t2mmp + & +! ! tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb) + im-1)*delt !LND_IAU_Control%dtp +! ! q2mp = q2mp + & +! ! spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+ im-1)*delt !LND_IAU_Control%dtp +! +! deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) +! +! endif +! +! end subroutine noahmpdrv_timestep_init !> \ingroup NoahMP_LSM diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 2f037467f..4cb7792c9 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -215,71 +215,71 @@ intent = in ######################################################################## -[ccpp-arg-table] - name = noahmpdrv_timestep_init - type = scheme -[itime] - standard_name = index_of_timestep - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in -[fhour] - standard_name = forecast_time - long_name = current forecast time - units = h - dimensions = () - type = real - kind = kind_phys - intent = in -[delt] - standard_name = timestep_for_dynamics - long_name = dynamics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[km] - standard_name = vertical_dimension_of_soil - long_name = soil vertical layer dimension - units = count - dimensions = () - type = integer - intent = in -[stc] - standard_name = soil_temperature - long_name = soil temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension_of_soil) - type = real - kind = kind_phys - intent = inout -[slc] - standard_name = volume_fraction_of_unfrozen_water_in_soil - long_name = liquid soil moisture - units = frac - dimensions = (horizontal_dimension,vertical_dimension_of_soil) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - +#[ccpp-arg-table] +# name = noahmpdrv_timestep_init +# type = scheme +#[itime] +# standard_name = index_of_timestep +# long_name = current forecast iteration +# units = index +# dimensions = () +# type = integer +# intent = in +#[fhour] +# standard_name = forecast_time +# long_name = current forecast time +# units = h +# dimensions = () +# type = real +# kind = kind_phys +# intent = in +#[delt] +# standard_name = timestep_for_dynamics +# long_name = dynamics timestep +# units = s +# dimensions = () +# type = real +# kind = kind_phys +# intent = in +#[km] +# standard_name = vertical_dimension_of_soil +# long_name = soil vertical layer dimension +# units = count +# dimensions = () +# type = integer +# intent = in +#[stc] +# standard_name = soil_temperature +# long_name = soil temperature +# units = K +# dimensions = (horizontal_dimension,vertical_dimension_of_soil) +# type = real +# kind = kind_phys +# intent = inout +#[slc] +# standard_name = volume_fraction_of_unfrozen_water_in_soil +# long_name = liquid soil moisture +# units = frac +# dimensions = (horizontal_dimension,vertical_dimension_of_soil) +# type = real +# kind = kind_phys +# intent = inout +#[errmsg] +# standard_name = ccpp_error_message +# long_name = error message for error handling in CCPP +# units = none +# dimensions = () +# type = character +# kind = len=* +# intent = out +#[errflg] +# standard_name = ccpp_error_code +# long_name = error code for error handling in CCPP +# units = 1 +# dimensions = () +# type = integer +# intent = out +# ######################################################################## [ccpp-arg-table] name = noahmpdrv_run diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.F90 new file mode 100644 index 000000000..ea9805cd4 --- /dev/null +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.F90 @@ -0,0 +1,340 @@ +#define CCPP +!> \file noahmpdrv_time_vary.F90 +!! This file contains the IAU Updates for the NoahMP land surface scheme driver. + +!>\defgroup NoahMP_LSM NoahMP LSM Model +!! \brief This is the NoahMP LSM the IAU Updates module + +!> This module contains the CCPP-compliant IAU Update module for NoahMP land surface model driver. +!> The noahmpdrv_time_vary module is an alternative to calling the IAU updates directly from within the noahmpdrv module +!> The current "CCPP_driver" module's ccpp_step(step="timestep_init") function call only handles group="time_vary" and not "physics" +! +module noahmpdrv_time_vary + + ! use module_sf_noahmplsm + ! 3.5.24 for use in IAU + use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type,& + lnd_iau_mod_set_control, lnd_iau_mod_init,lnd_iau_mod_getiauforcing + + implicit none + + private + + public :: noahmpdrv_time_vary_init, noahmpdrv_time_vary_timestep_init !, noahmpdrv_time_vary_run +! public :: noahmpdrv_time_vary_timestep_finalize, noahmpdrv_time_vary_finalize + + ! IAU data and control + type (lnd_iau_control_type) :: LND_IAU_Control + type (lnd_iau_external_data_type) :: LND_IAU_Data !(number of blocks):each proc holds nblks + + contains + +!> \ingroup NoahMP_LSM +!! \brief This subroutine is called during the CCPP initialization phase to +!! initialize Land IAU Control and Land IAU Data structures. +!! \section arg_table_noahmpdrv_time_vary_init Argument Table +!! \htmlinclude noahmpdrv_time_vary_init.html +!! + subroutine noahmpdrv_time_vary_init(lsm, lsm_noahmp, me, mpi_root, & + fn_nml, input_nml_file, isc, jsc, ncols, nx, ny, nblks, & + blksz, xlon, xlat, & + lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) + + use machine, only: kind_phys + !use GFS_typedefs, only: GFS_control_type + ! use GFS_typedefs, only: GFS_data_type + + implicit none + + integer, intent(in) :: lsm + integer, intent(in) :: lsm_noahmp + integer, intent(in) :: me ! mpi_rank + integer, intent(in) :: mpi_root ! = GFS_Control%master + character(*), intent(in) :: fn_nml + character(len=:), intent(in), dimension(:), pointer :: input_nml_file + integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks + integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz + real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon + real(kind_phys), dimension(:), intent(in) :: xlat ! latitude + integer, intent(in) :: lsoil, lsnow_lsm + real(kind=kind_phys), intent(in) :: dtp, fhour + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! type(gfs_data_type), dimension(:), intent(inout) :: GFS_Data ! !(one:) + ! type(gfs_control_type), intent(in) :: GFS_Control + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! 3.7.24 init iau for land + call lnd_iau_mod_set_control(LND_IAU_Control, fn_nml, input_nml_file, me, mpi_root, isc,jsc, nx, ny, nblks, blksz, & + lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) +! print*, 'proc errmsg, errflg after set control', me, errmsg, errflg +! print*, 'proc iau_control isc, nx, dtp fhour', me, LND_IAU_Control%isc, LND_IAU_Control%nx, & +! LND_IAU_Control%dtp, LND_IAU_Control%fhour +! print*, 'proc iau_control incfiles(1)', me, LND_IAU_Control%iau_inc_files(1) +! stop + call lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) + !print*, 'proc errmsg, errflg interval after lnd_iau_init ', me,trim(errmsg), errflg, LND_IAU_Data%in_interval + print*, 'proc nblks blksize(1) after lnd_iau_mod_init ', me,LND_IAU_Control%nblks, LND_IAU_Control%blksz(1) + + end subroutine noahmpdrv_time_vary_init + +!> \ingroup NoahMP_LSM +!! \brief This subroutine is called before noahmpdrv_run timestep to update +!! states with iau increments +!! \section arg_table_noahmpdrv_time_vary_timestep_init Argument Table +!! \htmlinclude noahmpdrv_time_vary_timestep_init.html +!! + subroutine noahmpdrv_time_vary_timestep_init (itime, fhour, delt, km, & !me, mpi_root, + stc, slc, errmsg, errflg) ! smc, t2mmp, q2mp, + + use machine, only: kind_phys + + implicit none + + ! integer, intent(in) :: me !mpi_rank + ! integer, intent(in) :: mpi_root ! = GFS_Control%master + integer , intent(in) :: itime !current forecast iteration + real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) + real(kind=kind_phys) , intent(in) :: delt ! time interval [s] + integer , intent(in) :: km !vertical soil layer dimension + real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] + real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! --- local variable + ! integer :: nb, im ! vertical soil layer dimension + + ! IAU update + real,allocatable :: stc_inc_flat(:,:) + real,allocatable :: slc_inc_flat(:,:) + ! real,allocatable :: tmp2m_inc_flat(:) + ! real,allocatable :: spfh2m_inc_flat(:) + integer :: j, k, ib + ! --- end declaration + + ! --- Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + !> update current forecast hour + ! GFS_control%jdat(:) = jdat(:) + LND_IAU_Control%fhour=fhour + + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",LND_IAU_Control%fhour, & + " delt ",delt," IauCont%dtp",LND_IAU_Control%dtp + endif + + !> 3.7.24 read iau increments + call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) + if (errflg .ne. 0) then + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" + print*, errmsg + endif + return + endif + + !> update with iau increments + if (LND_IAU_Data%in_interval) then + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*, "adding land iau increments " + endif + + if (LND_IAU_Control%lsoil .ne. km) then + write(errmsg,*) 'noahmpdrv_timestep_init: LND_IAU_Data%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km + errflg = 1 + return + endif + + ! local variable to copy blocked data LND_IAU_Data%stc_inc + allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols + allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols + ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols + ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols + ib = 1 + do j = 1, LND_IAU_Control%ny !ny + do k = 1, km + stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) =LND_IAU_Data%stc_inc(:,j, k) + slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j, k) + enddo + ! ib = 1 + ! do j = 1, LND_IAU_Control%ny !ny + ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) =LND_IAU_Data%tmp2m_inc(:,j, 1) + ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1)=LND_IAU_Data%spfh2m_inc(:,j, 1) + + ib = ib + LND_IAU_Control%nx !nlon + enddo + + ! delt=GFS_Control%dtf + if ((LND_IAU_Control%dtp - delt) > 0.0001) then + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*, "Warning noahmpdrv_timevary_tstep delt ",delt,"different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp + endif + endif + !IAU increments are in units of 1/sec !LND_IAU_Control%dtp + do k = 1, km + stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !LND_IAU_Control%dtp + slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !LND_IAU_Control%dtp + enddo + ! t2mmp = t2mmp + & + ! tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb) + im-1)*delt !LND_IAU_Control%dtp + ! q2mp = q2mp + & + ! spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+ im-1)*delt !LND_IAU_Control%dtp + + deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) + + endif + + end subroutine noahmpdrv_time_vary_timestep_init + + +! !> \ingroup NoahMP_LSM +! !! \brief +! !! \section arg_table_noahmpdrv_time_vary_run Argument Table +! !! \htmlinclude noahmpdrv_time_vary_run.html +! !! +! !! \section general_noahmpdrv_time_vary_run +! !! @{ +! !! - Initialize CCPP error handling variables. + +! subroutine noahmpdrv_time_vary_run(nb, im, km, lsnowl, itime, fhour, errmsg, errflg) +! ! ! --- inputs: +! ! ! --- in/outs: +! ! weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & +! ! ! --- Noah MP specific +! ! ! --- outputs: +! ! ) + +! use machine , only : kind_phys + +! implicit none + +! ! +! ! --- CCPP interface fields (in call order) +! ! +! integer , intent(in) :: nb !=cdata%blk_no, +! integer , intent(in) :: im ! horiz dimension and num of used pts +! integer , intent(in) :: km ! vertical soil layer dimension +! integer , intent(in) :: lsnowl ! lower bound for snow level arrays +! integer , intent(in) :: itime ! NOT USED current forecast iteration +! real(kind=kind_phys) , intent(in) :: fhour ! currentforecast time (hr) + +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! ground surface skin temperature [K] +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: tprcp ! total precipitation [m] +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: srflag ! snow/rain flag for precipitation +! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! total soil moisture content [m3/m3] +! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soil temp [K] +! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc ! liquid soil moisture [m3/m3] +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: canopy ! canopy moisture content [mm] +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: trans ! total plant transpiration [m/s] +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: tsurf ! surface skin temperature [K] +! ! real(kind=kind_phys), dimension(:) , intent(inout) :: zorl ! surface roughness [cm] + +! character(len=*) , intent(out) :: errmsg +! integer , intent(out) :: errflg +! ! +! ! --- end declaration +! ! + +! ! +! ! --- Initialize CCPP error handling variables +! ! +! errmsg = '' +! errflg = 0 + +! ! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then +! ! print*,"nb ",nb," itime ",itime," GFScont%fhour ",fhour," iauCon%fhour",LND_IAU_Control%fhour," delt ",delt," iauCont%dtp",LND_IAU_Control%dtp +! ! endif +! ! ! 3.7.24 read iau increments +! ! call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) +! ! if (errflg .ne. 0) return +! ! ! update with iau increments +! ! if (LND_IAU_Data%in_interval) then +! ! if (LND_IAU_Control%lsoil .ne. km) then +! ! write(errmsg, *)'in noahmpdrv_run, lnd_iau_mod update increments:LND_IAU_Control%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km +! ! errflg = 1 +! ! return +! ! endif +! ! ! LND_IAU_Data%stc_inc(is:ie, js:je, km)) size of (nx, ny) +! ! ! xlatin(im) stc(im,km) slc() t2mmp(:) q2mp(im) km=n_soill, im = +! ! ! GFS_Control%blksz(cdata%blk_no) +! ! ! >> need to get (cdata%blk_no from function call + +! ! ! local variable to copy blocked data LND_IAU_Data%stc_inc +! ! allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols +! ! allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols +! ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols +! ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols +! ! ib = 1 +! ! do j = 1, LND_IAU_Control%ny !ny +! ! do k = 1, km +! ! stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%stc_inc(:,j,k) +! ! slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j,k) +! ! enddo +! ! ! ib = 1 +! ! ! do j = 1, LND_IAU_Control%ny !ny +! ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) = LND_IAU_Data%tmp2m_inc(:,j,1) +! ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) = LND_IAU_Data%spfh2m_inc(:,j,1) +! ! ib = ib + LND_IAU_Control%nx !nlon +! ! enddo + +! ! !IAU increments are in units of 1/sec !LND_IAU_Control%dtp +! ! ! delt=GFS_Control%dtf +! ! if ((LND_IAU_Control%dtp - delt) > 0.0001) then +! ! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then +! ! print*, "Warning time step used in noahmpdrv_run delt ",delt," different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp +! ! endif +! ! endif +! ! do k = 1, km +! ! stc(:,k)=stc(:,k)+stc_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1, k)*delt !LND_IAU_Control%dtp +! ! slc(:,k)=slc(:,k)+slc_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1, k)*delt !LND_IAU_Control%dtp +! ! enddo +! ! t2mmp = t2mmp+tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1)*delt !LND_IAU_Control%dtp +! ! q2mp = q2mp +spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1)*delt !LND_IAU_Control%dtp + +! ! deallocate(stc_inc_flat, slc_inc_flat, tmp2m_inc_flat, spfh2m_inc_flat) + +! ! end if +! end subroutine noahmpdrv_time_vary_run + +! subroutine noahmpdrv_time_vary_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, + + +! use machine, only: kind_phys + +! implicit none + +! character(len=*), intent(out) :: errmsg +! integer, intent(out) :: errflg + +! ! --- Initialize CCPP error handling variables +! errmsg = '' +! errflg = 0 + +! end subroutine noahmpdrv_time_vary_timestep_finalize + +! subroutine noahmpdrv_time_vary_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, + + +! use machine, only: kind_phys + +! implicit none + +! character(len=*), intent(out) :: errmsg +! integer, intent(out) :: errflg + +! ! --- Initialize CCPP error handling variables +! errmsg = '' +! errflg = 0 + +! end subroutine noahmpdrv_time_vary_finalize + +end module noahmpdrv_time_vary diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.meta new file mode 100644 index 000000000..246fe1f5e --- /dev/null +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.meta @@ -0,0 +1,230 @@ +[ccpp-table-properties] + name = noahmpdrv_time_vary + type = scheme + dependencies = funcphys.f90, machine.F + dependencies = sim_nc_mod_lnd.F90, lnd_iau_mod.F90 + +######################################################################## +[ccpp-arg-table] + name = noahmpdrv_time_vary_init + type = scheme +[lsm] + standard_name = control_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in +[lsm_noahmp] + standard_name = identifier_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[mpi_root] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[fn_nml] + standard_name = filename_of_namelist + long_name = namelist filename + units = none + type = character + dimensions = () + kind = len=* + intent = in +[input_nml_file] + standard_name = filename_of_internal_namelist + long_name = amelist filename for internal file reads + units = none + type = character + dimensions = (ccpp_constant_one:number_of_lines_in_internal_namelist) + kind = len=256 + intent = in +[isc] + standard_name = starting_x_index_for_this_mpi_rank + long_name = starting index in the x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[jsc] + standard_name = starting_y_index_for_this_mpi_rank + long_name = starting index in the y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[ncols] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[nx] + standard_name = number_of_points_in_x_direction_for_this_mpi_rank + long_name = number of points in x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[ny] + standard_name = number_of_points_in_y_direction_for_this_mpi_rank + long_name = number of points in y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[nblks] + standard_name = ccpp_block_count + long_name = for explicit data blocking: number of blocks + units = count + dimensions = () + type = integer + intent = in +[blksz] + standard_name = ccpp_block_sizes + long_name = for explicit data blocking: block sizes of all blocks + units = count + dimensions = (ccpp_constant_one:ccpp_block_count) + type = integer + intent = in +[xlon] + standard_name = longitude + long_name = longitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[xlat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[lsoil] + standard_name = vertical_dimension_of_soil + long_name = number of soil layers + units = count + dimensions = () + type = integer + intent = in +[lsnow_lsm] + standard_name = vertical_dimension_of_surface_snow + long_name = maximum number of snow layers for land surface model + units = count + dimensions = () + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = noahmpdrv_time_vary_timestep_init + type = scheme +[itime] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[delt] + standard_name = timestep_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[km] + standard_name = vertical_dimension_of_soil + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[slc] + standard_name = volume_fraction_of_unfrozen_water_in_soil + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml b/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml new file mode 100644 index 000000000..011a93867 --- /dev/null +++ b/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml @@ -0,0 +1,96 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + noahmpdrv_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + sfc_cice + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_post + GFS_GWD_generic_post + GFS_suite_stateout_update + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + GFS_physics_post + + + + diff --git a/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml b/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml new file mode 100644 index 000000000..bca1b018d --- /dev/null +++ b/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml @@ -0,0 +1,95 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + noahmpdrv_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_post + GFS_GWD_generic_post + GFS_suite_stateout_update + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + GFS_physics_post + + + + From 2b576f0c42ba4f67d8afcd4f37ceca0ff4eab7b9 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 24 Mar 2024 12:11:15 -0400 Subject: [PATCH 004/141] revert to using noahmpdrv_timestep_init --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 484 +++++++++--------- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 152 +++--- 2 files changed, 334 insertions(+), 302 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index cb92724c0..6493332d1 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -9,26 +9,26 @@ !! as diagnotics calculation. !> This module contains the CCPP-compliant NoahMP land surface model driver. - module noahmpdrv +module noahmpdrv - use module_sf_noahmplsm - ! 3.5.24 for use in IAU -! use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type,& -! lnd_iau_mod_set_control, lnd_iau_mod_init,lnd_iau_mod_getiauforcing + use module_sf_noahmplsm + ! 3.5.24 for use in IAU + use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type,& + lnd_iau_mod_set_control, lnd_iau_mod_init, lnd_iau_mod_getiauforcing !, & lnd_iau_mod_finalize - implicit none + implicit none - integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS + integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS - private + private - public :: noahmpdrv_init, noahmpdrv_run !, noahmpdrv_timestep_init - - ! IAU data and control -! type (lnd_iau_control_type) :: LND_IAU_Control -! type (lnd_iau_external_data_type) :: LND_IAU_Data !(number of blocks):each proc holds nblks + public :: noahmpdrv_init, noahmpdrv_run !, noahmpdrv_timestep_init + + ! IAU data and control + type (lnd_iau_control_type) :: LND_IAU_Control + type (lnd_iau_external_data_type) :: LND_IAU_Data !(number of blocks):each proc holds nblks - contains + contains !> \ingroup NoahMP_LSM !! \brief This subroutine is called during the CCPP initialization phase and calls set_soilveg() to @@ -36,7 +36,7 @@ module noahmpdrv !! \section arg_table_noahmpdrv_init Argument Table !! \htmlinclude noahmpdrv_init.html !! - subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & + subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & isot, ivegsrc, & nlunit, pores, resid, & do_mynnsfclay,do_mynnedmf, & @@ -46,242 +46,254 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & blksz, xlon, xlat, & lsoil, lsnow_lsm, dtp, fhour) - use machine, only: kind_phys - use set_soilveg_mod, only: set_soilveg - use namelist_soilveg - use noahmp_tables - !use GFS_typedefs, only: GFS_control_type - ! use GFS_typedefs, only: GFS_data_type - - implicit none - - integer, intent(in) :: lsm - integer, intent(in) :: lsm_noahmp - integer, intent(in) :: me ! mpi_rank - integer, intent(in) :: isot, ivegsrc, nlunit - real (kind=kind_phys), dimension(:), intent(out) :: pores, resid - logical, intent(in) :: do_mynnsfclay - logical, intent(in) :: do_mynnedmf - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - ! land iau mod - integer, intent(in) :: mpi_root ! = GFS_Control%master - character(*), intent(in) :: fn_nml - character(len=:), intent(in), dimension(:), pointer :: input_nml_file - integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks - integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz - real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon - real(kind_phys), dimension(:), intent(in) :: xlat ! latitude - integer, intent(in) :: lsoil, lsnow_lsm - real(kind=kind_phys), intent(in) :: dtp, fhour - ! type(gfs_data_type), dimension(:), intent(inout) :: GFS_Data ! !(one:) - !type(gfs_control_type), intent(in) :: GFS_Control - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Consistency checks - if (lsm/=lsm_noahmp) then - write(errmsg,'(*(a))') 'Logic error: namelist choice of ', & - & 'LSM is different from Noah' - errflg = 1 - return - end if - - if (ivegsrc /= 1) then - errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// & - 'namelist parameter is 1. Exiting...' - errflg = 1 - return - end if - if (isot /= 1) then - errmsg = 'The NOAHMP LSM expects that the isot physics '// & - 'namelist parameter is 1. Exiting...' - errflg = 1 - return - end if + use machine, only: kind_phys + use set_soilveg_mod, only: set_soilveg + use namelist_soilveg + use noahmp_tables + !use GFS_typedefs, only: GFS_control_type + ! use GFS_typedefs, only: GFS_data_type + + implicit none + + integer, intent(in) :: lsm + integer, intent(in) :: lsm_noahmp + integer, intent(in) :: me ! mpi_rank + integer, intent(in) :: isot, ivegsrc, nlunit + real (kind=kind_phys), dimension(:), intent(out) :: pores, resid + logical, intent(in) :: do_mynnsfclay + logical, intent(in) :: do_mynnedmf + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! land iau mod + integer, intent(in) :: mpi_root ! = GFS_Control%master + character(*), intent(in) :: fn_nml + character(len=:), intent(in), dimension(:), pointer :: input_nml_file + integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks + integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz + real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon + real(kind_phys), dimension(:), intent(in) :: xlat ! latitude + integer, intent(in) :: lsoil, lsnow_lsm + real(kind=kind_phys), intent(in) :: dtp, fhour + ! type(gfs_data_type), dimension(:), intent(inout) :: GFS_Data ! !(one:) + !type(gfs_control_type), intent(in) :: GFS_Control + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (lsm/=lsm_noahmp) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of ', & + & 'LSM is different from Noah' + errflg = 1 + return + end if - if ( do_mynnsfclay .and. .not. do_mynnedmf) then - errmsg = 'Problem : do_mynnsfclay = .true.' // & - 'but mynnpbl is .false.. Exiting ...' - errflg = 1 - return - end if + if (ivegsrc /= 1) then + errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// & + 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + if (isot /= 1) then + errmsg = 'The NOAHMP LSM expects that the isot physics '// & + 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if - !--- initialize soil vegetation - call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) + if ( do_mynnsfclay .and. .not. do_mynnedmf) then + errmsg = 'Problem : do_mynnsfclay = .true.' // & + 'but mynnpbl is .false.. Exiting ...' + errflg = 1 + return + end if - !--- read in noahmp table - call read_mp_table_parameters(errmsg, errflg) + !--- initialize soil vegetation + call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) - ! initialize psih and psim + !--- read in noahmp table + call read_mp_table_parameters(errmsg, errflg) - if ( do_mynnsfclay ) then - call psi_init(psi_opt,errmsg,errflg) - endif + ! initialize psih and psim - pores (:) = maxsmc (:) - resid (:) = drysmc (:) + if ( do_mynnsfclay ) then + call psi_init(psi_opt,errmsg,errflg) + endif - ! 3.7.24 init iau for land -! call lnd_iau_mod_set_control(LND_IAU_Control, fn_nml, input_nml_file, me, mpi_root, isc,jsc, nx, ny, nblks, blksz, & -! lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) + pores (:) = maxsmc (:) + resid (:) = drysmc (:) -! print*, 'proc errmsg, errflg after set control', me, errmsg, errflg -! print*, 'proc iau_control isc, nx, dtp fhour', me, LND_IAU_Control%isc, LND_IAU_Control%nx, & -! LND_IAU_Control%dtp, LND_IAU_Control%fhour -! print*, 'proc iau_control incfiles(1)', me, LND_IAU_Control%iau_inc_files(1) -! stop + ! 3.7.24 init iau for land + call lnd_iau_mod_set_control(LND_IAU_Control, fn_nml, input_nml_file, me, mpi_root, isc,jsc, nx, ny, nblks, blksz, & + lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) + ! print*, 'proc errmsg, errflg after set control', me, errmsg, errflg + ! print*, 'proc iau_control isc, nx, dtp fhour', me, LND_IAU_Control%isc, LND_IAU_Control%nx, & + ! LND_IAU_Control%dtp, LND_IAU_Control%fhour + ! print*, 'proc iau_control incfiles(1)', me, LND_IAU_Control%iau_inc_files(1) -! call lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) - !print*, 'proc errmsg, errflg interval after lnd_iau_init ', me,trim(errmsg), errflg, LND_IAU_Data%in_interval - ! print*, 'proc nblks blksize(1) after set init', me,LND_IAU_Control%nblks, LND_IAU_Control%blksz(1) + call lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) + !print*, 'proc errmsg, errflg interval after lnd_iau_init ', me,trim(errmsg), errflg, LND_IAU_Data%in_interval + ! print*, 'proc nblks blksize(1) after set init', me,LND_IAU_Control%nblks, LND_IAU_Control%blksz(1) - end subroutine noahmpdrv_init + end subroutine noahmpdrv_init !> \ingroup NoahMP_LSM -!! \brief This subroutine is called before noahmpdrv_run timestep to update -!! states with iau increments +!! \brief This subroutine is called before noahmpdrv_run +!! to update states with iau increments !! \section arg_table_noahmpdrv_timestep_init Argument Table !! \htmlinclude noahmpdrv_timestep_init.html !! -! subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_root, -! stc, slc, errmsg, errflg) ! smc, t2mmp, q2mp, -! ! lsnow_lsm, lsnowl, & -! ! ncols, isc, jsc, nx, ny, nblks, -! ! & -! ! blksz, xlon, xlat, -! ! & !& garea, iyrlen, julian, -! ! vegtype, idveg, & -! ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, -! -! use machine, only: kind_phys -! -! implicit none -! -! ! integer, intent(in) :: me !mpi_rank -! ! integer, intent(in) :: mpi_root ! = GFS_Control%master -! integer , intent(in) :: itime !current forecast iteration -! real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) -! real(kind=kind_phys) , intent(in) :: delt ! time interval [s] -! integer , intent(in) :: km !vertical soil layer dimension -! real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] -! real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' -! character(len=*), intent(out) :: errmsg -! integer, intent(out) :: errflg -! -! ! integer, intent(in) :: lsnow_lsm -! ! integer , intent(in) :: lsnowl ! lower bound for snow level arrays -! ! integer, intent(in) :: ncols, isc, jsc, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks -! ! integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz -! ! real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon -! ! real(kind_phys), dimension(:), intent(in) :: xlat ! latitude -! !integer , dimension(:) , intent(in) :: vegtype !vegetation type (integer index) -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! -! ! ground surface skin temperature [K] -! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! -! ! total soil moisture content [m3/m3] -! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! -! ! soil temp [K] -! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc ! -! ! liquid soil moisture [m3/m3] -! ! real(kind=kind_phys), dimension(:) , intent(out) :: t2mmp ! -! ! combined T2m from tiles -! ! real(kind=kind_phys), dimension(:) , intent(out) :: q2mp ! -! ! combined q2m from tiles -! ! character(len=*), intent(out) :: errmsg -! ! integer, intent(out) :: errflg -! -! ! --- local variable -! ! integer :: nb, im ! vertical soil layer dimension -! -! ! IAU update -! real,allocatable :: stc_inc_flat(:,:) -! real,allocatable :: slc_inc_flat(:,:) -! ! real,allocatable :: tmp2m_inc_flat(:) -! ! real,allocatable :: spfh2m_inc_flat(:) -! integer :: j, k, ib -! ! --- end declaration -! -! ! --- Initialize CCPP error handling variables -! errmsg = '' -! errflg = 0 -! -! !> update current forecast hour -! ! GFS_control%jdat(:) = jdat(:) -! LND_IAU_Control%fhour=fhour -! -! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then -! print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",LND_IAU_Control%fhour, & -! " delt ",delt," IauCont%dtp",LND_IAU_Control%dtp -! endif -! -! !> 3.7.24 read iau increments -! call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) -! if (errflg .ne. 0) then -! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then -! print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" -! print*, errmsg -! endif -! return -! endif -! -! !> update with iau increments -! if (LND_IAU_Data%in_interval) then -! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then -! print*, "adding land iau increments " -! endif -! -! if (LND_IAU_Control%lsoil .ne. km) then -! write(errmsg,*) 'noahmpdrv_timestep_init: LND_IAU_Data%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km -! errflg = 1 -! return -! endif -! -! ! local variable to copy blocked data LND_IAU_Data%stc_inc -! allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols -! allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols -! ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols -! ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols -! ib = 1 -! do j = 1, LND_IAU_Control%ny !ny -! do k = 1, km -! stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) =LND_IAU_Data%stc_inc(:,j, k) -! slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j, k) -! enddo -! ! ib = 1 -! ! do j = 1, LND_IAU_Control%ny !ny -! ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) =LND_IAU_Data%tmp2m_inc(:,j, 1) -! ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1)=LND_IAU_Data%spfh2m_inc(:,j, 1) -! -! ib = ib + LND_IAU_Control%nx !nlon -! enddo -! -! ! delt=GFS_Control%dtf -! if ((LND_IAU_Control%dtp - delt) > 0.0001) then -! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then -! print*, "Warning noahmpdrv_run delt ",delt,"different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp -! endif -! endif -! !IAU increments are in units of 1/sec !LND_IAU_Control%dtp -! do k = 1, km -! stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !LND_IAU_Control%dtp -! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !LND_IAU_Control%dtp -! enddo -! ! t2mmp = t2mmp + & -! ! tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb) + im-1)*delt !LND_IAU_Control%dtp -! ! q2mp = q2mp + & -! ! spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+ im-1)*delt !LND_IAU_Control%dtp -! -! deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) -! -! endif -! -! end subroutine noahmpdrv_timestep_init + subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_root, + stc, slc, errmsg, errflg) ! smc, t2mmp, q2mp, + ! lsnow_lsm, lsnowl, & + ! ncols, isc, jsc, nx, ny, nblks, + ! & + ! blksz, xlon, xlat, + ! & !& garea, iyrlen, julian, + ! vegtype, idveg, & + ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, + + use machine, only: kind_phys + + implicit none + + ! integer, intent(in) :: me !mpi_rank + ! integer, intent(in) :: mpi_root ! = GFS_Control%master + integer , intent(in) :: itime !current forecast iteration + real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) + real(kind=kind_phys) , intent(in) :: delt ! time interval [s] + integer , intent(in) :: km !vertical soil layer dimension + real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] + real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! integer, intent(in) :: lsnow_lsm + ! integer , intent(in) :: lsnowl ! lower bound for snow level arrays + ! integer, intent(in) :: ncols, isc, jsc, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks + ! integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz + ! real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon + ! real(kind_phys), dimension(:), intent(in) :: xlat ! latitude + + ! --- local variable + ! integer :: nb, im ! vertical soil layer dimension + + ! IAU update + real,allocatable :: stc_inc_flat(:,:) + real,allocatable :: slc_inc_flat(:,:) + ! real,allocatable :: tmp2m_inc_flat(:) + ! real,allocatable :: spfh2m_inc_flat(:) + integer :: j, k, ib + ! --- end declaration + + ! --- Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + !> update current forecast hour + ! GFS_control%jdat(:) = jdat(:) + LND_IAU_Control%fhour=fhour + + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",LND_IAU_Control%fhour, & + " delt ",delt," IauCont%dtp",LND_IAU_Control%dtp + endif + + !> 3.7.24 read iau increments + call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) + if (errflg .ne. 0) then + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" + print*, errmsg + endif + return + endif + + !> update with iau increments + if (LND_IAU_Data%in_interval) then + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*, "adding land iau increments " + endif + + if (LND_IAU_Control%lsoil .ne. km) then + write(errmsg,*) 'noahmpdrv_timestep_init: LND_IAU_Data%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km + errflg = 1 + return + endif + + ! local variable to copy blocked data LND_IAU_Data%stc_inc + allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols + allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols + ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols + ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols + ib = 1 + do j = 1, LND_IAU_Control%ny !ny + do k = 1, km + stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) =LND_IAU_Data%stc_inc(:,j, k) + slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j, k) + enddo + ! ib = 1 + ! do j = 1, LND_IAU_Control%ny !ny + ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) =LND_IAU_Data%tmp2m_inc(:,j, 1) + ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1)=LND_IAU_Data%spfh2m_inc(:,j, 1) + + ib = ib + LND_IAU_Control%nx !nlon + enddo + + ! delt=GFS_Control%dtf + if ((LND_IAU_Control%dtp - delt) > 0.0001) then + if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + print*, "Warning noahmpdrv_run delt ",delt,"different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp + endif + endif + !IAU increments are in units of 1/sec !LND_IAU_Control%dtp + do k = 1, km + stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !LND_IAU_Control%dtp + slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !LND_IAU_Control%dtp + enddo + ! t2mmp = t2mmp + & + ! tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb) + im-1)*delt !LND_IAU_Control%dtp + ! q2mp = q2mp + & + ! spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+ im-1)*delt !LND_IAU_Control%dtp + + deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) + + endif + + end subroutine noahmpdrv_timestep_init + + !> \ingroup NoahMP_LSM +!! \brief This subroutine is called after noahmpdrv_run +!! to free up allocated memory +!! \section arg_table_noahmpdrv_timestep_finalize Argument Table +!! \htmlinclude noahmpdrv_timestep_init.html +!! + subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, + + use machine, only: kind_phys + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: j, k, ib + + ! --- Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! ! delt=GFS_Control%dtf + ! if ((LND_IAU_Control%dtp - delt) > 0.0001) then + ! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + ! print*, "Warning noahmpdrv_run delt ",delt,"different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp + ! endif + ! endif + + ! call lnd_iau_mod_finalize() !LND_IAU_Control%finalize() + end subroutine noahmpdrv_timestep_finalize !> \ingroup NoahMP_LSM !! \brief This subroutine is the main CCPP entry point for the NoahMP LSM. @@ -1905,4 +1917,4 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & ! ---------------------------------------------------------------------- end subroutine penman - end module noahmpdrv +end module noahmpdrv diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 4cb7792c9..e99535399 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -215,72 +215,92 @@ intent = in ######################################################################## -#[ccpp-arg-table] -# name = noahmpdrv_timestep_init -# type = scheme -#[itime] -# standard_name = index_of_timestep -# long_name = current forecast iteration -# units = index -# dimensions = () -# type = integer -# intent = in -#[fhour] -# standard_name = forecast_time -# long_name = current forecast time -# units = h -# dimensions = () -# type = real -# kind = kind_phys -# intent = in -#[delt] -# standard_name = timestep_for_dynamics -# long_name = dynamics timestep -# units = s -# dimensions = () -# type = real -# kind = kind_phys -# intent = in -#[km] -# standard_name = vertical_dimension_of_soil -# long_name = soil vertical layer dimension -# units = count -# dimensions = () -# type = integer -# intent = in -#[stc] -# standard_name = soil_temperature -# long_name = soil temperature -# units = K -# dimensions = (horizontal_dimension,vertical_dimension_of_soil) -# type = real -# kind = kind_phys -# intent = inout -#[slc] -# standard_name = volume_fraction_of_unfrozen_water_in_soil -# long_name = liquid soil moisture -# units = frac -# dimensions = (horizontal_dimension,vertical_dimension_of_soil) -# type = real -# kind = kind_phys -# intent = inout -#[errmsg] -# standard_name = ccpp_error_message -# long_name = error message for error handling in CCPP -# units = none -# dimensions = () -# type = character -# kind = len=* -# intent = out -#[errflg] -# standard_name = ccpp_error_code -# long_name = error code for error handling in CCPP -# units = 1 -# dimensions = () -# type = integer -# intent = out -# -######################################################################## +[ccpp-arg-table] + name = noahmpdrv_timestep_init + type = scheme +[itime] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[delt] + standard_name = timestep_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[km] + standard_name = vertical_dimension_of_soil + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[slc] + standard_name = volume_fraction_of_unfrozen_water_in_soil + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +####################################################################### +[ccpp-arg-table] + name = noahmpdrv_timestep_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +####################################################################### [ccpp-arg-table] name = noahmpdrv_run type = scheme From d61f9dcab94937e374d39c49d5fdf3a01ecde3d4 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 24 Mar 2024 15:54:49 -0400 Subject: [PATCH 005/141] read all increment files at _init time --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 571 +++++++++++------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 7 +- 2 files changed, 344 insertions(+), 234 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 2b53edd81..bb2592319 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -88,6 +88,7 @@ module lnd_iau_mod real :: deg2rad,dt,rdt integer :: im,jm,km,nfiles,ncid + integer:: jbeg, jend integer :: n_soill, n_snowl !1.27.24 soil and snow layers logical :: do_lnd_iau_inc !do_lnd_iau_inc @@ -97,7 +98,8 @@ module lnd_iau_mod ! character(len=32), allocatable :: tracer_names(:) ! integer, allocatable :: tracer_indicies(:) - real(kind=4), allocatable:: wk3(:,:,:) +! real(kind=4), allocatable:: wk3(:, :,:,:) + real(kind=4), allocatable:: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :), wk3_t2m(:, :, :, :), wk3_q2m(:, :, :, :) type iau_internal_data_type ! real,allocatable :: ua_inc(:,:,:) @@ -323,7 +325,6 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, integer:: ib, i, j, k, nstep, kstep integer:: i1, i2, j1 - integer:: jbeg, jend logical:: found integer nfilesall @@ -369,11 +370,11 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, ! call get_tracer_names(MODEL_ATMOS, i, tracer_names(i)) ! tracer_indicies(i) = get_tracer_index(MODEL_ATMOS,tracer_names(i)) ! enddo - allocate(s2c(is:ie,js:je,4)) - allocate(id1(is:ie,js:je)) - allocate(id2(is:ie,js:je)) - allocate(jdc(is:ie,js:je)) - allocate(agrid(is:ie,js:je,2)) + allocate(s2c(is:ie,js:je,4)) + allocate(id1(is:ie,js:je)) + allocate(id2(is:ie,js:je)) + allocate(jdc(is:ie,js:je)) + allocate(agrid(is:ie,js:je,2)) ! determine number of increment files to read, and the valid forecast hours nfilesall = size(LND_IAU_Control%iau_inc_files) @@ -381,9 +382,9 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print*,'in lnd_iau_init incfile1 iaufhr1 ', & trim(LND_IAU_Control%iau_inc_files(1)),LND_IAU_Control%iaufhrs(1) do k=1,nfilesall - if (trim(LND_IAU_Control%iau_inc_files(k)) .eq. '' .or. LND_IAU_Control%iaufhrs(k) .lt. 0) exit + if (trim(LND_IAU_Control%iau_inc_files(k)) .eq. '' .or. LND_IAU_Control%iaufhrs(k) .lt. 0) exit if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print *,k,trim(adjustl(LND_IAU_Control%iau_inc_files(k))) + print *,k, " ", trim(adjustl(LND_IAU_Control%iau_inc_files(k))) endif nfiles = nfiles + 1 enddo @@ -410,12 +411,12 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, rdt = 1.0/dt ! set up interpolation weights to go from GSI's gaussian grid to cubed sphere - deg2rad = pi/180. + deg2rad = pi/180. ! npz = LND_IAU_Control%levs - fname = 'INPUT/'//trim(LND_IAU_Control%iau_inc_files(1)) - inquire (file=trim(fname), exist=exists) - if (exists) then + fname = 'INPUT/'//trim(LND_IAU_Control%iau_inc_files(1)) + inquire (file=trim(fname), exist=exists) + if (exists) then ! if( file_exist(fname) ) then call open_ncfile( fname, ncid ) ! open the file !TODO !change to Latitude @@ -446,32 +447,32 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, do j=1,jm lat(j) = lat(j) * deg2rad enddo - else + else ! call mpp_error(FATAL,'==> Error in IAU_initialize: Expected file '& ! //trim(fname)//' for DA increment does not exist') errmsg = 'FATAL Error in IAU_initialize: Expected file '// trim(fname)//' for DA increment does not exist' errflg = 1 return - endif + endif - ! Initialize lat-lon to Cubed bi-linear interpolation coeff: - ! populate agrid +! Initialize lat-lon to Cubed bi-linear interpolation coeff: +! populate agrid ! print*,'is,ie,js,je=',is,ie,js,ie ! print*,'size xlon=',size(Init_parm%xlon(:,1)),size(Init_parm%xlon(1,:)) ! print*,'size agrid=',size(agrid(:,1,1)),size(agrid(1,:,1)),size(agrid(1,1,:)) - do j = 1,size(Init_parm_xlon,2) + do j = 1,size(Init_parm_xlon,2) do i = 1,size(Init_parm_xlon,1) -! print*,i,j,is-1+j,js-1+j + ! print*,i,j,is-1+j,js-1+j agrid(is-1+i,js-1+j,1)=Init_parm_xlon(i,j) agrid(is-1+i,js-1+j,2)=Init_parm_xlat(i,j) enddo - enddo - call remap_coef( is, ie, js, je, is, ie, js, je, & - im, jm, lon, lat, id1, id2, jdc, s2c, & - agrid) - deallocate ( lon, lat,agrid ) - if (allocated(Init_parm_xlon)) deallocate(Init_parm_xlon) - if (allocated(Init_parm_xlat)) deallocate(Init_parm_xlat) + enddo + call remap_coef( is, ie, js, je, is, ie, js, je, & + im, jm, lon, lat, id1, id2, jdc, s2c, & + agrid) + deallocate ( lon, lat,agrid ) + if (allocated(Init_parm_xlon)) deallocate(Init_parm_xlon) + if (allocated(Init_parm_xlat)) deallocate(Init_parm_xlat) ! allocate(LND_IAU_Data%ua_inc(is:ie, js:je, km)) ! allocate(LND_IAU_Data%va_inc(is:ie, js:je, km)) @@ -479,69 +480,116 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, ! allocate(LND_IAU_Data%delp_inc(is:ie, js:je, km)) ! allocate(LND_IAU_Data%delz_inc(is:ie, js:je, km)) ! allocate(LND_IAU_Data%tracer_inc(is:ie, js:je, km,ntracers)) - allocate(LND_IAU_Data%stc_inc(is:ie, js:je, km)) - allocate(LND_IAU_Data%slc_inc(is:ie, js:je, km)) - allocate(LND_IAU_Data%tmp2m_inc(is:ie, js:je, 1)) - allocate(LND_IAU_Data%spfh2m_inc(is:ie, js:je, 1)) + allocate(LND_IAU_Data%stc_inc(is:ie, js:je, km)) + allocate(LND_IAU_Data%slc_inc(is:ie, js:je, km)) + allocate(LND_IAU_Data%tmp2m_inc(is:ie, js:je, 1)) + allocate(LND_IAU_Data%spfh2m_inc(is:ie, js:je, 1)) ! allocate arrays that will hold iau state - allocate (iau_state%inc1%stc_inc(is:ie, js:je, km)) - allocate (iau_state%inc1%slc_inc(is:ie, js:je, km)) - allocate (iau_state%inc1%tmp2m_inc(is:ie, js:je, 1)) - allocate (iau_state%inc1%spfh2m_inc (is:ie, js:je, 1)) - iau_state%hr1=LND_IAU_Control%iaufhrs(1) - iau_state%wt = 1.0 ! IAU increment filter weights (default 1.0) - iau_state%wt_normfact = 1.0 - if (LND_IAU_Control%iau_filter_increments) then - ! compute increment filter weights, sum to obtain normalization factor - dtp=LND_IAU_Control%dtp - nstep = 0.5*LND_IAU_Control%iau_delthrs*3600/dtp - ! compute normalization factor for filter weights - normfact = 0. - do k=1,2*nstep+1 - kstep = k-1-nstep - sx = acos(-1.)*kstep/nstep - wx = acos(-1.)*kstep/(nstep+1) - if (kstep .ne. 0) then - wt = sin(wx)/wx*sin(sx)/sx - else - wt = 1.0 - endif - normfact = normfact + wt - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'filter wts',k,kstep,wt - enddo - iau_state%wt_normfact = (2*nstep+1)/normfact - endif - ! if (do_lnd_iau_inc) then - ! call read_iau_forcing(LND_IAU_Control,iau_state%inc1,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(1)), errmsg, errflg, & - ! 'INPUT/'//trim(LND_IAU_Control%iau_inc_files_sfc(1))) - ! else - call read_iau_forcing(LND_IAU_Control,iau_state%inc1,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(1)), errmsg, errflg) - ! endif - if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window - call setiauforcing(LND_IAU_Control,LND_IAU_Data,iau_state%wt) - endif - if (nfiles.GT.1) then !have multiple files, but only read in 2 at a time and interpoalte between them - allocate (iau_state%inc2%stc_inc(is:ie, js:je, km)) - allocate (iau_state%inc2%slc_inc(is:ie, js:je, km)) - allocate (iau_state%inc2%tmp2m_inc(is:ie, js:je, 1)) - allocate (iau_state%inc2%spfh2m_inc(is:ie, js:je, 1)) - iau_state%hr2=LND_IAU_Control%iaufhrs(2) - ! if (do_lnd_iau_inc) then - ! call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(2)),errmsg,errflg, & - ! 'INPUT/'//trim(LND_IAU_Control%iau_inc_files_sfc(2))) - ! else - call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(2)), errmsg, errflg) - ! endif - endif -! print*,'in IAU init',dt,rdt -! LND_IAU_Data%drymassfixer = LND_IAU_Control%iau_drymassfixer + allocate (iau_state%inc1%stc_inc(is:ie, js:je, km)) + allocate (iau_state%inc1%slc_inc(is:ie, js:je, km)) + allocate (iau_state%inc1%tmp2m_inc(is:ie, js:je, 1)) + allocate (iau_state%inc1%spfh2m_inc (is:ie, js:je, 1)) + iau_state%hr1=LND_IAU_Control%iaufhrs(1) + iau_state%wt = 1.0 ! IAU increment filter weights (default 1.0) + iau_state%wt_normfact = 1.0 + if (LND_IAU_Control%iau_filter_increments) then + ! compute increment filter weights, sum to obtain normalization factor + dtp=LND_IAU_Control%dtp + nstep = 0.5*LND_IAU_Control%iau_delthrs*3600/dtp + ! compute normalization factor for filter weights + normfact = 0. + do k=1,2*nstep+1 + kstep = k-1-nstep + sx = acos(-1.)*kstep/nstep + wx = acos(-1.)*kstep/(nstep+1) + if (kstep .ne. 0) then + wt = sin(wx)/wx*sin(sx)/sx + else + wt = 1.0 + endif + normfact = normfact + wt + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'filter wts',k,kstep,wt + enddo + iau_state%wt_normfact = (2*nstep+1)/normfact + endif + +!3.22.24 MB wants to read all increments files at iau init + ! Find bounding latitudes: + jbeg = jm-1 + jend = 2 + do j=js,je + do i=is,ie + j1 = jdc(i,j) + jbeg = min(jbeg, j1) + jend = max(jend, j1+1) + enddo + enddo + + ! call read_iau_forcing(LND_IAU_Control,iau_state%inc1,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(1)), errmsg, errflg) + allocate (wk3_stc(nfiles, 1:im,jbeg:jend, 1:km)) + allocate (wk3_slc(nfiles, 1:im,jbeg:jend, 1:km)) + allocate (wk3_t2m(nfiles, 1:im,jbeg:jend, 1:1)) + allocate (wk3_q2m(nfiles, 1:im,jbeg:jend, 1:1)) + do k=1, nfiles + call read_iau_forcing_all_timesteps(LND_IAU_Control, 'INPUT/'//trim(LND_IAU_Control%iau_inc_files(k)), errmsg, errflg, & + wk3_stc(k, :, :, :), wk3_slc(k, :, :, :), wk3_t2m(k, :, :, :), wk3_q2m(k, :, :, :)) + enddo + ! call interp_inc(LND_IAU_Control, 'soilt1_inc',increments%stc_inc(:,:,1),jbeg,jend) + ! call interp_inc(LND_IAU_Control, 'tmp2m_inc',increments%tmp2m_inc(:,:,1),jbeg,jend) + call interp_inc_at_timestep(LND_IAU_Control, km, wk3_stc(1, :, :, :), iau_state%inc1%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(LND_IAU_Control, km, wk3_slc(1, :, :, :), iau_state%inc1%slc_inc, errmsg, errflg) + call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_t2m(1, :, :, :), iau_state%inc1%tmp2m_inc, errmsg, errflg) + call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_q2m(1, :, :, :), iau_state%inc1%spfh2m_inc, errmsg, errflg) + + if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window + call setiauforcing(LND_IAU_Control, LND_IAU_Data, iau_state%wt) + endif + if (nfiles.GT.1) then !have multiple files, but only read in 2 at a time and interpoalte between them + allocate (iau_state%inc2%stc_inc(is:ie, js:je, km)) + allocate (iau_state%inc2%slc_inc(is:ie, js:je, km)) + allocate (iau_state%inc2%tmp2m_inc(is:ie, js:je, 1)) + allocate (iau_state%inc2%spfh2m_inc(is:ie, js:je, 1)) + iau_state%hr2=LND_IAU_Control%iaufhrs(2) + + ! call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(2)), errmsg, errflg) + call interp_inc_at_timestep(LND_IAU_Control, km, wk3_stc(2, :, :, :), iau_state%inc2%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(LND_IAU_Control, km, wk3_slc(2, :, :, :), iau_state%inc2%slc_inc, errmsg, errflg) + call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_t2m(2, :, :, :), iau_state%inc2%tmp2m_inc, errmsg, errflg) + call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_q2m(2, :, :, :), iau_state%inc2%spfh2m_inc, errmsg, errflg) + endif +! print*,'end of IAU init',dt,rdt end subroutine lnd_iau_mod_init -subroutine lnd_iau_mod_getiauforcing(LND_IAU_Control,LND_IAU_Data, errmsg, errflg) +subroutine lnd_iau_mod_finalize() + + implicit none + + if (allocated (wk3_stc)) deallocate (wk3_stc) + if (allocated (wk3_slc)) deallocate (wk3_slc) + if (allocated (wk3_t2m)) deallocate (wk3_t2m) + if (allocated (wk3_q2m)) deallocate (wk3_q2m) + + if (allocated(LND_IAU_Data%stc_inc)) deallocate (LND_IAU_Data%stc_inc) + if (allocated(LND_IAU_Data%slc_inc)) deallocate (LND_IAU_Data%slc_inc) + if (allocated(LND_IAU_Data%tmp2m_inc)) deallocate (LND_IAU_Data%tmp2m_inc) + if (allocated(LND_IAU_Data%spfh2m_inc)) deallocate (LND_IAU_Data%spfh2m_inc) + + if (allocated(iau_state%inc1%stc_inc)) deallocate(iau_state%inc1%stc_inc) + if (allocated(iau_state%inc1%slc_inc)) deallocate(iau_state%inc1%slc_inc) + if (allocated(iau_state%inc1%tmp2m_inc)) deallocate(iau_state%inc1%tmp2m_inc) + if (allocated(iau_state%inc1%spfh2m_inc)) deallocate(iau_state%inc1%spfh2m_inc) + + if (allocated(iau_state%inc2%stc_inc)) deallocate(iau_state%inc2%stc_inc) + if (allocated(iau_state%inc2%slc_inc)) deallocate(iau_state%inc2%slc_inc) + if (allocated(iau_state%inc2%tmp2m_inc)) deallocate(iau_state%inc2%tmp2m_inc) + if (allocated(iau_state%inc2%spfh2m_inc)) deallocate(iau_state%inc2%spfh2m_inc) + +end subroutine lnd_iau_mod_finalize + + subroutine lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) implicit none - ! integer, intent(in) :: me, mpi_root type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data character(len=*), intent(out) :: errmsg @@ -594,7 +642,7 @@ subroutine lnd_iau_mod_getiauforcing(LND_IAU_Control,LND_IAU_Data, errmsg, errfl LND_IAU_Data%in_interval=.false. else if (LND_IAU_Control%iau_filter_increments) call setiauforcing(LND_IAU_Control,LND_IAU_Data,iau_state%wt) - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt=',t1,LND_IAU_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt= ',t1,LND_IAU_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact LND_IAU_Data%in_interval=.true. endif return @@ -606,9 +654,9 @@ subroutine lnd_iau_mod_getiauforcing(LND_IAU_Control,LND_IAU_Data, errmsg, errfl ! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'no iau forcing',LND_IAU_Control%iaufhrs(1),LND_IAU_Control%fhour,LND_IAU_Control%iaufhrs(nfiles) LND_IAU_Data%in_interval=.false. else - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt=',t1,LND_IAU_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt= ',t1,LND_IAU_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact LND_IAU_Data%in_interval=.true. - do k=nfiles,1,-1 + do k=nfiles, 1, -1 if (LND_IAU_Control%iaufhrs(k) > LND_IAU_Control%fhour) then itnext=k endif @@ -618,15 +666,14 @@ subroutine lnd_iau_mod_getiauforcing(LND_IAU_Control,LND_IAU_Data, errmsg, errfl iau_state%hr1=iau_state%hr2 iau_state%hr2=LND_IAU_Control%iaufhrs(itnext) iau_state%inc1=iau_state%inc2 - ! if (do_lnd_iau_inc) then - ! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'reading next increment files',trim(LND_IAU_Control%iau_inc_files(itnext)), & - ! trim(LND_IAU_Control%iau_inc_files_sfc(itnext)) - ! call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(itnext)), errmsg, errflg, & - ! 'INPUT/'//trim(LND_IAU_Control%iau_inc_files_sfc(itnext))) - ! else - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'reading next lnd iau increment file',trim(LND_IAU_Control%iau_inc_files(itnext)) - call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(itnext)), errmsg, errflg) - ! endif + + ! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'reading next lnd iau increment file',trim(LND_IAU_Control%iau_inc_files(itnext)) + ! call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(itnext)), errmsg, errflg) + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'interpolating next lnd iau increment ', itnext !trim(LND_IAU_Control%iau_inc_files(itnext)) + call interp_inc_at_timestep(LND_IAU_Control, km, wk3_stc(itnext, :, :, :), iau_state%inc2%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(LND_IAU_Control, km, wk3_slc(itnext, :, :, :), iau_state%inc2%slc_inc, errmsg, errflg) + call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_t2m(itnext, :, :, :), iau_state%inc2%tmp2m_inc, errmsg, errflg) + call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_q2m(itnext, :, :, :), iau_state%inc2%spfh2m_inc, errmsg, errflg) endif call updateiauforcing(LND_IAU_Control,LND_IAU_Data,iau_state%wt) endif @@ -635,12 +682,12 @@ subroutine lnd_iau_mod_getiauforcing(LND_IAU_Control,LND_IAU_Data, errmsg, errfl end subroutine lnd_iau_mod_getiauforcing -subroutine updateiauforcing(LND_IAU_Control,LND_IAU_Data,wt) +subroutine updateiauforcing(LND_IAU_Control, LND_IAU_Data, wt) implicit none type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data - real(kind_phys) delt,wt + real(kind_phys) delt, wt integer i,j,k,l ! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'in updateiauforcing',nfiles,LND_IAU_Control%iaufhrs(1:nfiles) @@ -648,15 +695,6 @@ subroutine updateiauforcing(LND_IAU_Control,LND_IAU_Data,wt) do j = js,je do i = is,ie do k = 1,npz - ! LND_IAU_Data%ua_inc(i,j,k) =(delt*IAU_state%inc1%ua_inc(i,j,k) + (1.-delt)* IAU_state%inc2%ua_inc(i,j,k))*rdt*wt - ! LND_IAU_Data%va_inc(i,j,k) =(delt*IAU_state%inc1%va_inc(i,j,k) + (1.-delt)* IAU_state%inc2%va_inc(i,j,k))*rdt*wt - ! LND_IAU_Data%temp_inc(i,j,k) =(delt*IAU_state%inc1%temp_inc(i,j,k) + (1.-delt)* IAU_state%inc2%temp_inc(i,j,k))*rdt*wt - ! LND_IAU_Data%delp_inc(i,j,k) =(delt*IAU_state%inc1%delp_inc(i,j,k) + (1.-delt)* IAU_state%inc2%delp_inc(i,j,k))*rdt*wt - ! LND_IAU_Data%delz_inc(i,j,k) =(delt*IAU_state%inc1%delz_inc(i,j,k) + (1.-delt)* IAU_state%inc2%delz_inc(i,j,k))*rdt*wt - ! do l=1,ntracers - ! LND_IAU_Data%tracer_inc(i,j,k,l) =(delt*IAU_state%inc1%tracer_inc(i,j,k,l) + (1.-delt)* IAU_state%inc2%tracer_inc(i,j,k,l))*rdt*wt - ! enddo - ! enddo ! do k = 1,n_soill ! LND_IAU_Data%stc_inc(i,j,k) =(delt*IAU_state%inc1%stc_inc(i,j,k) + (1.-delt)* IAU_state%inc2%stc_inc(i,j,k))*rdt*wt LND_IAU_Data%slc_inc(i,j,k) =(delt*IAU_state%inc1%slc_inc(i,j,k) + (1.-delt)* IAU_state%inc2%slc_inc(i,j,k))*rdt*wt @@ -668,148 +706,219 @@ subroutine updateiauforcing(LND_IAU_Control,LND_IAU_Data,wt) end subroutine updateiauforcing - subroutine setiauforcing(LND_IAU_Control,LND_IAU_Data,wt) - - implicit none - type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control - type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data - real(kind_phys) delt, dt,wt - integer i,j,k,l,sphum -! this is only called if using 1 increment file - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'in lnd_iau setiauforcing',rdt - do j = js,je - do i = is,ie - do k = 1,npz - ! LND_IAU_Data%ua_inc(i,j,k) =wt*IAU_state%inc1%ua_inc(i,j,k)*rdt - ! LND_IAU_Data%va_inc(i,j,k) =wt*IAU_state%inc1%va_inc(i,j,k)*rdt - ! LND_IAU_Data%temp_inc(i,j,k) =wt*IAU_state%inc1%temp_inc(i,j,k)*rdt - ! LND_IAU_Data%delp_inc(i,j,k) =wt*IAU_state%inc1%delp_inc(i,j,k)*rdt - ! LND_IAU_Data%delz_inc(i,j,k) =wt*IAU_state%inc1%delz_inc(i,j,k)*rdt - ! do l = 1,ntracers - ! LND_IAU_Data%tracer_inc(i,j,k,l) =wt*IAU_state%inc1%tracer_inc(i,j,k,l)*rdt - ! enddo - ! enddo - ! do k = 1,n_soill ! - LND_IAU_Data%stc_inc(i,j,k) = wt*IAU_state%inc1%stc_inc(i,j,k)*rdt - LND_IAU_Data%slc_inc(i,j,k) = wt*IAU_state%inc1%slc_inc(i,j,k)*rdt - end do - LND_IAU_Data%tmp2m_inc(i,j,1) = wt*IAU_state%inc1%tmp2m_inc(i,j,1)*rdt - LND_IAU_Data%spfh2m_inc(i,j,1) = wt*IAU_state%inc1%spfh2m_inc(i,j,1)*rdt - enddo - enddo -! sphum=get_tracer_index(MODEL_ATMOS,'sphum') - - end subroutine setiauforcing - -subroutine read_iau_forcing(LND_IAU_Control, increments, fname, errmsg, errflg) !, fname_sfc) - type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control - type(iau_internal_data_type), intent(inout):: increments - character(len=*), intent(in) :: fname - ! character(len=*), intent(in), optional :: fname_sfc - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg -!locals - ! real, dimension(:,:,:), allocatable:: u_inc, v_inc - - integer:: i, j, k, l, npz - integer:: i1, i2, j1 - integer:: jbeg, jend - ! real(kind=R_GRID), dimension(2):: p1, p2, p3 - ! real(kind=R_GRID), dimension(3):: e1, e2, ex, ey + subroutine setiauforcing(LND_IAU_Control, LND_IAU_Data, wt) - ! logical :: found - integer :: is, ie, js, je, km_store - logical :: exists + implicit none + type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data + real(kind_phys) delt, dt,wt + integer i,j,k,l,sphum + ! this is only called if using 1 increment file + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'in lnd_iau setiauforcing rdt = ',rdt + do j = js,je + do i = is,ie + do k = 1,npz + ! do k = 1,n_soill ! + LND_IAU_Data%stc_inc(i,j,k) = wt*IAU_state%inc1%stc_inc(i,j,k)*rdt + LND_IAU_Data%slc_inc(i,j,k) = wt*IAU_state%inc1%slc_inc(i,j,k)*rdt + end do + LND_IAU_Data%tmp2m_inc(i,j,1) = wt*IAU_state%inc1%tmp2m_inc(i,j,1)*rdt + LND_IAU_Data%spfh2m_inc(i,j,1) = wt*IAU_state%inc1%spfh2m_inc(i,j,1)*rdt + enddo + enddo + ! sphum=get_tracer_index(MODEL_ATMOS,'sphum') - !Errors messages handled through CCPP error handling variables - errmsg = '' - errflg = 0 + end subroutine setiauforcing - is = LND_IAU_Control%isc - ie = is + LND_IAU_Control%nx-1 - js = LND_IAU_Control%jsc - je = js + LND_IAU_Control%ny-1 +subroutine read_iau_forcing_all_timesteps(LND_IAU_Control, fname, errmsg, errflg, & + wk3_out_stc, wk3_out_slc, wk3_out_t2m, wk3_out_q2m) !, fname_sfc) is, ie, js, je, ks,ke, + type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + character(len=*), intent(in) :: fname + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! integer, intent(in) :: is, ie, js, je, ks,ke + ! real(kind=4), intent(out) :: wk3_out(is:ie,js:je,ks:ke) + real(kind=4), intent(out) :: wk3_out_stc(1:im, jbeg:jend, 1:km) + real(kind=4), intent(out) :: wk3_out_slc(1:im, jbeg:jend, 1:km) + real(kind=4), intent(out) :: wk3_out_t2m(1:im, jbeg:jend, 1:1) + real(kind=4), intent(out) :: wk3_out_q2m(1:im, jbeg:jend, 1:1) + + integer:: i, j, k, l, npz + integer:: i1, i2, j1 + logical :: exists + integer :: ncid - deg2rad = pi/180. + character(len=32), dimension(4) :: stc_vars = [character(len=32) :: 'soilt1_inc', 'soilt2_inc', 'soilt3_inc', 'soilt4_inc'] + character(len=32), dimension(4) :: slc_vars = [character(len=32) :: 'slc1_inc', 'slc2_inc', 'slc3_inc', 'slc4_inc'] + character(len=32), :: t2m_vars = 'tmp2m_inc' + character(len=32), :: q2m_vars = 'spfh2m_inc' - npz = LND_IAU_Control%lsoil - - inquire (file=trim(fname), exist=exists) - if (exists) then - ! if( file_exist(fname) ) then + !Errors messages handled through CCPP error handling variables + errmsg = '' + errflg = 0 + + inquire (file=trim(fname), exist=exists) + if (exists) then +! if( file_exist(fname) ) then call open_ncfile( fname, ncid ) ! open the file - else + else ! call mpp_error(FATAL,'==> Error in read_iau_forcing: Expected file '& ! //trim(fname)//' for DA increment does not exist') errmsg = 'FATAL Error in read_iau_forcing: Expected file '//trim(fname)//' for DA increment does not exist' errflg = 1 return - endif + endif - ! Find bounding latitudes: - jbeg = jm-1; jend = 2 - do j=js,je - do i=is,ie - j1 = jdc(i,j) - jbeg = min(jbeg, j1) - jend = max(jend, j1+1) + do i = 1, size(stc_vars) + print *, trim(stc_vars(i)) + call check_var_exists(ncid, trim(stc_vars(i)), ierr) + if (ierr == 0) then + ! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) + call get_var3_r4( ncid, trim(stc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_stc(:, :, i) ) + else + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(stc_vars(i)),' found, assuming zero' + wk3_out = 0. + endif + enddo + do i = 1, size(slc_vars) + print *, trim(slc_vars(i)) + call check_var_exists(ncid, trim(slc_vars(i)), ierr) + if (ierr == 0) then + ! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) + call get_var3_r4( ncid, trim(slc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i) ) + else + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(slc_vars(i)),' found, assuming zero' + wk3_out = 0. + endif + enddo + print *, trim(t2m_vars) + call check_var_exists(ncid, trim(t2m_vars), ierr) + if (ierr == 0) then + ! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) + call get_var3_r4( ncid, trim(t2m_vars), 1,im, jbeg,jend, 1,1, wk3_out_t2m(:, :, :) ) + else + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(t2m_vars),' found, assuming zero' + wk3_out = 0. + endif + print *, trim(q2m_vars) + call check_var_exists(ncid, trim(q2m_vars), ierr) + if (ierr == 0) then + ! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) + call get_var3_r4( ncid, trim(q2m_vars), 1,im, jbeg,jend, 1,1, wk3_out_q2m(:, :, :) ) + else + if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(q2m_vars),' found, assuming zero' + wk3_out = 0. + endif + + call close_ncfile(ncid) + +end subroutine read_iau_forcing_all_timesteps + +subroutine interp_inc_at_timestep(LND_IAU_Control, km_in, wk3_in, var, errmsg, errflg) !field_name, , jbeg, jend) + ! interpolate increment from GSI gaussian grid to cubed sphere + ! everying is on the A-grid, earth relative + type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + ! character(len=*), intent(in) :: field_name + integer, intent(in) :: km_in !jbeg,jend + real(kind=4), intent(in) :: wk3_in(1:im,jbeg:jend, 1:km_in) + real, dimension(is:ie, js:je, 1:km), intent(inout) :: var + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + integer:: i1, i2, j1, k, j, i + + do k=1,km_in + do j=js,je + do i=is,ie + i1 = id1(i,j) + i2 = id2(i,j) + j1 = jdc(i,j) + var(i,j,k) = s2c(i,j,1)*wk3_in(i1,j1 ,k) + s2c(i,j,2)*wk3_in(i2,j1 ,k)+& + s2c(i,j,3)*wk3_in(i2,j1+1,k) + s2c(i,j,4)*wk3_in(i1,j1+1,k) + enddo enddo - enddo + enddo +end subroutine interp_inc_at_timestep - ! allocate ( wk3(1:im,jbeg:jend, 1:km) ) - ! read in 1 time level -! call interp_inc(LND_IAU_Control, 'T_inc',increments%temp_inc(:,:,:),jbeg,jend) -! call interp_inc(LND_IAU_Control, 'delp_inc',increments%delp_inc(:,:,:),jbeg,jend) -! call interp_inc(LND_IAU_Control, 'delz_inc',increments%delz_inc(:,:,:),jbeg,jend) -! call interp_inc(LND_IAU_Control, 'u_inc',increments%ua_inc(:,:,:),jbeg,jend) ! can these be treated as scalars? -! call interp_inc(LND_IAU_Control, 'v_inc',increments%va_inc(:,:,:),jbeg,jend) -! ! do l=1,ntracers -! ! call interp_inc(trim(tracer_names(l))//'_inc',increments%tracer_inc(:,:,:,l),jbeg,jend) -! ! enddo -! call close_ncfile(ncid) -! deallocate (wk3) - -! ! is_land = .true. -! if ( present(fname_sfc) ) then -! inquire (file=trim(fname_sfc), exist=exists) -! if (exists) then -! ! if( file_exist(fname_sfc) ) then -! call open_ncfile( fname_sfc, ncid ) ! open the file -! else -! ! call mpp_error(FATAL,'==> Error in read_iau_forcing sfc: Expected file '& -! ! //trim(fname_sfc)//' for DA increment does not exist') -! errmsg = 'FATAL Error in read_iau_forcing sfc: Expected file '//trim(fname_sfc)//' for DA increment does not exist' -! errflg = 1 -! return -! endif - km_store = km - km = 1 ! n_soill Currently each soil layer increment is saved separately - allocate ( wk3(1:im,jbeg:jend, 1:km) ) - ! call interp_inc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend) !TODO check var name - call interp_inc(LND_IAU_Control, 'soilt1_inc',increments%stc_inc(:,:,1),jbeg,jend) - call interp_inc(LND_IAU_Control, 'soilt2_inc',increments%stc_inc(:,:,2),jbeg,jend) - call interp_inc(LND_IAU_Control, 'soilt3_inc',increments%stc_inc(:,:,3),jbeg,jend) - call interp_inc(LND_IAU_Control, 'soilt4_inc',increments%stc_inc(:,:,4),jbeg,jend) - - call interp_inc(LND_IAU_Control, 'slc1_inc',increments%slc_inc(:,:,1),jbeg,jend) - call interp_inc(LND_IAU_Control, 'slc2_inc',increments%slc_inc(:,:,2),jbeg,jend) - call interp_inc(LND_IAU_Control, 'slc3_inc',increments%slc_inc(:,:,3),jbeg,jend) - call interp_inc(LND_IAU_Control, 'slc4_inc',increments%slc_inc(:,:,4),jbeg,jend) - - call interp_inc(LND_IAU_Control, 'tmp2m_inc',increments%tmp2m_inc(:,:,1),jbeg,jend) - call interp_inc(LND_IAU_Control, 'spfh2m_inc',increments%spfh2m_inc(:,:,1),jbeg,jend) - ! call interp_inc_sfc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend, n_soill) - call close_ncfile(ncid) - deallocate (wk3) - km = km_store - ! else - ! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'No IAU inc file for sfc, setting stc_inc=0.' - ! increments%stc_inc(:,:,:) = 0. - ! end if +subroutine read_iau_forcing(LND_IAU_Control, increments, fname, errmsg, errflg) !, fname_sfc) + type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + type(iau_internal_data_type), intent(inout):: increments + character(len=*), intent(in) :: fname +! character(len=*), intent(in), optional :: fname_sfc + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +!locals +! real, dimension(:,:,:), allocatable:: u_inc, v_inc + + integer:: i, j, k, l, npz + integer:: i1, i2, j1 + integer:: jbeg, jend +! real(kind=R_GRID), dimension(2):: p1, p2, p3 +! real(kind=R_GRID), dimension(3):: e1, e2, ex, ey + +! logical :: found + integer :: is, ie, js, je, km_store + logical :: exists + + !Errors messages handled through CCPP error handling variables + errmsg = '' + errflg = 0 + + is = LND_IAU_Control%isc + ie = is + LND_IAU_Control%nx-1 + js = LND_IAU_Control%jsc + je = js + LND_IAU_Control%ny-1 + + deg2rad = pi/180. + + npz = LND_IAU_Control%lsoil + + inquire (file=trim(fname), exist=exists) + if (exists) then +! if( file_exist(fname) ) then + call open_ncfile( fname, ncid ) ! open the file + else + ! call mpp_error(FATAL,'==> Error in read_iau_forcing: Expected file '& + ! //trim(fname)//' for DA increment does not exist') + errmsg = 'FATAL Error in read_iau_forcing: Expected file '//trim(fname)//' for DA increment does not exist' + errflg = 1 + return + endif + + ! Find bounding latitudes: + jbeg = jm-1; jend = 2 + do j=js,je + do i=is,ie + j1 = jdc(i,j) + jbeg = min(jbeg, j1) + jend = max(jend, j1+1) + enddo + enddo + + km_store = km + km = 1 ! n_soill Currently each soil layer increment is saved separately + allocate ( wk3(1:im,jbeg:jend, 1:km) ) + ! call interp_inc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend) !TODO check var name + call interp_inc(LND_IAU_Control, 'soilt1_inc',increments%stc_inc(:,:,1),jbeg,jend) + call interp_inc(LND_IAU_Control, 'soilt2_inc',increments%stc_inc(:,:,2),jbeg,jend) + call interp_inc(LND_IAU_Control, 'soilt3_inc',increments%stc_inc(:,:,3),jbeg,jend) + call interp_inc(LND_IAU_Control, 'soilt4_inc',increments%stc_inc(:,:,4),jbeg,jend) + + call interp_inc(LND_IAU_Control, 'slc1_inc',increments%slc_inc(:,:,1),jbeg,jend) + call interp_inc(LND_IAU_Control, 'slc2_inc',increments%slc_inc(:,:,2),jbeg,jend) + call interp_inc(LND_IAU_Control, 'slc3_inc',increments%slc_inc(:,:,3),jbeg,jend) + call interp_inc(LND_IAU_Control, 'slc4_inc',increments%slc_inc(:,:,4),jbeg,jend) + + call interp_inc(LND_IAU_Control, 'tmp2m_inc',increments%tmp2m_inc(:,:,1),jbeg,jend) + call interp_inc(LND_IAU_Control, 'spfh2m_inc',increments%spfh2m_inc(:,:,1),jbeg,jend) +! call interp_inc_sfc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend, n_soill) + call close_ncfile(ncid) + deallocate (wk3) + km = km_store end subroutine read_iau_forcing -subroutine interp_inc(LND_IAU_Control, field_name,var,jbeg,jend) +subroutine interp_inc(LND_IAU_Control, field_name, var, jbeg, jend) ! interpolate increment from GSI gaussian grid to cubed sphere ! everying is on the A-grid, earth relative type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 6493332d1..06e188364 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -13,8 +13,9 @@ module noahmpdrv use module_sf_noahmplsm ! 3.5.24 for use in IAU - use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type,& - lnd_iau_mod_set_control, lnd_iau_mod_init, lnd_iau_mod_getiauforcing !, & lnd_iau_mod_finalize + use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type, & + lnd_iau_mod_set_control, lnd_iau_mod_init, lnd_iau_mod_getiauforcing, & + lnd_iau_mod_finalize implicit none @@ -291,7 +292,7 @@ subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp ! endif ! endif - ! call lnd_iau_mod_finalize() !LND_IAU_Control%finalize() + call lnd_iau_mod_finalize() !LND_IAU_Control%finalize() end subroutine noahmpdrv_timestep_finalize From c0b760eff3cabf75717e27d59bb31164ddfbe9b3 Mon Sep 17 00:00:00 2001 From: tsga Date: Wed, 10 Apr 2024 15:00:53 +0000 Subject: [PATCH 006/141] debug --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 248 +++++++++--------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 4 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 4 +- 3 files changed, 132 insertions(+), 124 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index bb2592319..4734468de 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -91,7 +91,7 @@ module lnd_iau_mod integer:: jbeg, jend integer :: n_soill, n_snowl !1.27.24 soil and snow layers - logical :: do_lnd_iau_inc !do_lnd_iau_inc + logical :: do_lnd_iau !do_lnd_iau_inc integer :: is, ie, js, je integer :: npz !, ntracers @@ -145,7 +145,7 @@ module lnd_iau_mod integer :: lsoil !< number of soil layers ! this is the max dim (TBC: check it is consitent for noahmpdrv) integer :: lsnow_lsm !< maximum number of snow layers internal to land surface model - logical :: do_lnd_iau_inc + logical :: do_lnd_iau real(kind=kind_phys) :: iau_delthrs ! iau time interval (to scale increments) in hours character(len=240) :: iau_inc_files(7)! list of increment files real(kind=kind_phys) :: iaufhrs(7) ! forecast hours associated with increment files @@ -187,7 +187,7 @@ module lnd_iau_mod end type lnd_iau_control_type type(iau_state_type) :: IAU_state - public lnd_iau_control_type, lnd_iau_external_data_type, lnd_iau_mod_set_control, lnd_iau_mod_init, lnd_iau_mod_getiauforcing + public lnd_iau_control_type, lnd_iau_external_data_type, lnd_iau_mod_set_control, lnd_iau_mod_init, lnd_iau_mod_getiauforcing, lnd_iau_mod_finalize contains @@ -217,13 +217,13 @@ subroutine lnd_iau_mod_set_control(LND_IAU_Control,fn_nml,input_nml_file_i,me, m !> 3.9.24 these are not available through the CCPP interface so need to read them from namelist file !> vars to read from namelist - logical :: do_lnd_iau_inc = .false. + logical :: do_lnd_iau = .false. real(kind=kind_phys) :: lnd_iau_delthrs = 0 !< iau time interval (to scale increments) character(len=240) :: lnd_iau_inc_files(7) = '' !< list of increment files real(kind=kind_phys) :: lnd_iaufhrs(7) = -1 !< forecast hours associated with increment files logical :: lnd_iau_filter_increments = .false. !< filter IAU increments - NAMELIST /lnd_iau_nml/ do_lnd_iau_inc, lnd_iau_delthrs, lnd_iau_inc_files, lnd_iaufhrs, lnd_iau_filter_increments !, lnd_iau_drymassfixer & + NAMELIST /lnd_iau_nml/ do_lnd_iau, lnd_iau_delthrs, lnd_iau_inc_files, lnd_iaufhrs, lnd_iau_filter_increments !, lnd_iau_drymassfixer & !Errors messages handled through CCPP error handling variables errmsg = '' @@ -270,7 +270,7 @@ subroutine lnd_iau_mod_set_control(LND_IAU_Control,fn_nml,input_nml_file_i,me, m write(6, lnd_iau_nml) endif - LND_IAU_Control%do_lnd_iau_inc = do_lnd_iau_inc + LND_IAU_Control%do_lnd_iau = do_lnd_iau LND_IAU_Control%iau_delthrs = lnd_iau_delthrs LND_IAU_Control%iau_inc_files = lnd_iau_inc_files LND_IAU_Control%iaufhrs = lnd_iaufhrs @@ -340,7 +340,7 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errmsg = '' errflg = 0 - do_lnd_iau_inc = LND_IAU_Control%do_lnd_iau_inc + do_lnd_iau = LND_IAU_Control%do_lnd_iau n_soill = LND_IAU_Control%lsoil !4 for sfc updates ! n_snowl = LND_IAU_Control%lsnowl npz = LND_IAU_Control%lsoil @@ -561,10 +561,15 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, end subroutine lnd_iau_mod_init -subroutine lnd_iau_mod_finalize() +subroutine lnd_iau_mod_finalize(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) implicit none + type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + if (allocated (wk3_stc)) deallocate (wk3_stc) if (allocated (wk3_slc)) deallocate (wk3_slc) if (allocated (wk3_t2m)) deallocate (wk3_t2m) @@ -743,15 +748,16 @@ subroutine read_iau_forcing_all_timesteps(LND_IAU_Control, fname, errmsg, errflg real(kind=4), intent(out) :: wk3_out_t2m(1:im, jbeg:jend, 1:1) real(kind=4), intent(out) :: wk3_out_q2m(1:im, jbeg:jend, 1:1) - integer:: i, j, k, l, npz - integer:: i1, i2, j1 + integer :: i, j, k, l, npz + integer :: i1, i2, j1 logical :: exists integer :: ncid + integer :: ierr character(len=32), dimension(4) :: stc_vars = [character(len=32) :: 'soilt1_inc', 'soilt2_inc', 'soilt3_inc', 'soilt4_inc'] character(len=32), dimension(4) :: slc_vars = [character(len=32) :: 'slc1_inc', 'slc2_inc', 'slc3_inc', 'slc4_inc'] - character(len=32), :: t2m_vars = 'tmp2m_inc' - character(len=32), :: q2m_vars = 'spfh2m_inc' + character(len=32) :: t2m_vars = 'tmp2m_inc' + character(len=32) :: q2m_vars = 'spfh2m_inc' !Errors messages handled through CCPP error handling variables errmsg = '' @@ -777,7 +783,7 @@ subroutine read_iau_forcing_all_timesteps(LND_IAU_Control, fname, errmsg, errflg call get_var3_r4( ncid, trim(stc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_stc(:, :, i) ) else if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(stc_vars(i)),' found, assuming zero' - wk3_out = 0. + wk3_out_stc(:, :, i) = 0. endif enddo do i = 1, size(slc_vars) @@ -788,7 +794,7 @@ subroutine read_iau_forcing_all_timesteps(LND_IAU_Control, fname, errmsg, errflg call get_var3_r4( ncid, trim(slc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i) ) else if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(slc_vars(i)),' found, assuming zero' - wk3_out = 0. + wk3_out_slc(:, :, i) = 0. endif enddo print *, trim(t2m_vars) @@ -798,7 +804,7 @@ subroutine read_iau_forcing_all_timesteps(LND_IAU_Control, fname, errmsg, errflg call get_var3_r4( ncid, trim(t2m_vars), 1,im, jbeg,jend, 1,1, wk3_out_t2m(:, :, :) ) else if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(t2m_vars),' found, assuming zero' - wk3_out = 0. + wk3_out_t2m(:, :, :) = 0. endif print *, trim(q2m_vars) call check_var_exists(ncid, trim(q2m_vars), ierr) @@ -807,7 +813,7 @@ subroutine read_iau_forcing_all_timesteps(LND_IAU_Control, fname, errmsg, errflg call get_var3_r4( ncid, trim(q2m_vars), 1,im, jbeg,jend, 1,1, wk3_out_q2m(:, :, :) ) else if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(q2m_vars),' found, assuming zero' - wk3_out = 0. + wk3_out_q2m(:, :, :) = 0. endif call close_ncfile(ncid) @@ -840,111 +846,111 @@ subroutine interp_inc_at_timestep(LND_IAU_Control, km_in, wk3_in, var, errmsg, e enddo end subroutine interp_inc_at_timestep -subroutine read_iau_forcing(LND_IAU_Control, increments, fname, errmsg, errflg) !, fname_sfc) - type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control - type(iau_internal_data_type), intent(inout):: increments - character(len=*), intent(in) :: fname -! character(len=*), intent(in), optional :: fname_sfc - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg -!locals -! real, dimension(:,:,:), allocatable:: u_inc, v_inc - - integer:: i, j, k, l, npz - integer:: i1, i2, j1 - integer:: jbeg, jend -! real(kind=R_GRID), dimension(2):: p1, p2, p3 -! real(kind=R_GRID), dimension(3):: e1, e2, ex, ey - -! logical :: found - integer :: is, ie, js, je, km_store - logical :: exists - - !Errors messages handled through CCPP error handling variables - errmsg = '' - errflg = 0 - - is = LND_IAU_Control%isc - ie = is + LND_IAU_Control%nx-1 - js = LND_IAU_Control%jsc - je = js + LND_IAU_Control%ny-1 - - deg2rad = pi/180. - - npz = LND_IAU_Control%lsoil - - inquire (file=trim(fname), exist=exists) - if (exists) then -! if( file_exist(fname) ) then - call open_ncfile( fname, ncid ) ! open the file - else - ! call mpp_error(FATAL,'==> Error in read_iau_forcing: Expected file '& - ! //trim(fname)//' for DA increment does not exist') - errmsg = 'FATAL Error in read_iau_forcing: Expected file '//trim(fname)//' for DA increment does not exist' - errflg = 1 - return - endif - - ! Find bounding latitudes: - jbeg = jm-1; jend = 2 - do j=js,je - do i=is,ie - j1 = jdc(i,j) - jbeg = min(jbeg, j1) - jend = max(jend, j1+1) - enddo - enddo - - km_store = km - km = 1 ! n_soill Currently each soil layer increment is saved separately - allocate ( wk3(1:im,jbeg:jend, 1:km) ) - ! call interp_inc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend) !TODO check var name - call interp_inc(LND_IAU_Control, 'soilt1_inc',increments%stc_inc(:,:,1),jbeg,jend) - call interp_inc(LND_IAU_Control, 'soilt2_inc',increments%stc_inc(:,:,2),jbeg,jend) - call interp_inc(LND_IAU_Control, 'soilt3_inc',increments%stc_inc(:,:,3),jbeg,jend) - call interp_inc(LND_IAU_Control, 'soilt4_inc',increments%stc_inc(:,:,4),jbeg,jend) - - call interp_inc(LND_IAU_Control, 'slc1_inc',increments%slc_inc(:,:,1),jbeg,jend) - call interp_inc(LND_IAU_Control, 'slc2_inc',increments%slc_inc(:,:,2),jbeg,jend) - call interp_inc(LND_IAU_Control, 'slc3_inc',increments%slc_inc(:,:,3),jbeg,jend) - call interp_inc(LND_IAU_Control, 'slc4_inc',increments%slc_inc(:,:,4),jbeg,jend) - - call interp_inc(LND_IAU_Control, 'tmp2m_inc',increments%tmp2m_inc(:,:,1),jbeg,jend) - call interp_inc(LND_IAU_Control, 'spfh2m_inc',increments%spfh2m_inc(:,:,1),jbeg,jend) -! call interp_inc_sfc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend, n_soill) - call close_ncfile(ncid) - deallocate (wk3) - km = km_store - -end subroutine read_iau_forcing - -subroutine interp_inc(LND_IAU_Control, field_name, var, jbeg, jend) -! interpolate increment from GSI gaussian grid to cubed sphere -! everying is on the A-grid, earth relative - type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control - character(len=*), intent(in) :: field_name - real, dimension(is:ie,js:je,1:km), intent(inout) :: var - integer, intent(in) :: jbeg,jend - integer:: i1, i2, j1, k,j,i,ierr - call check_var_exists(ncid, field_name, ierr) - if (ierr == 0) then - call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) - else - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(field_name),' found, assuming zero' - wk3 = 0. - endif - do k=1,km - do j=js,je - do i=is,ie - i1 = id1(i,j) - i2 = id2(i,j) - j1 = jdc(i,j) - var(i,j,k) = s2c(i,j,1)*wk3(i1,j1 ,k) + s2c(i,j,2)*wk3(i2,j1 ,k)+& - s2c(i,j,3)*wk3(i2,j1+1,k) + s2c(i,j,4)*wk3(i1,j1+1,k) - enddo - enddo - enddo -end subroutine interp_inc +!subroutine read_iau_forcing(LND_IAU_Control, increments, fname, errmsg, errflg) !, fname_sfc) +! type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control +! type(iau_internal_data_type), intent(inout):: increments +! character(len=*), intent(in) :: fname +!! character(len=*), intent(in), optional :: fname_sfc +! character(len=*), intent(out) :: errmsg +! integer, intent(out) :: errflg +!!locals +!! real, dimension(:,:,:), allocatable:: u_inc, v_inc +! +! integer:: i, j, k, l, npz +! integer:: i1, i2, j1 +! integer:: jbeg, jend +!! real(kind=R_GRID), dimension(2):: p1, p2, p3 +!! real(kind=R_GRID), dimension(3):: e1, e2, ex, ey +! +!! logical :: found +! integer :: is, ie, js, je, km_store +! logical :: exists +! +! !Errors messages handled through CCPP error handling variables +! errmsg = '' +! errflg = 0 +! +! is = LND_IAU_Control%isc +! ie = is + LND_IAU_Control%nx-1 +! js = LND_IAU_Control%jsc +! je = js + LND_IAU_Control%ny-1 +! +! deg2rad = pi/180. +! +! npz = LND_IAU_Control%lsoil +! +! inquire (file=trim(fname), exist=exists) +! if (exists) then +!! if( file_exist(fname) ) then +! call open_ncfile( fname, ncid ) ! open the file +! else +! ! call mpp_error(FATAL,'==> Error in read_iau_forcing: Expected file '& +! ! //trim(fname)//' for DA increment does not exist') +! errmsg = 'FATAL Error in read_iau_forcing: Expected file '//trim(fname)//' for DA increment does not exist' +! errflg = 1 +! return +! endif +! +! ! Find bounding latitudes: +! jbeg = jm-1; jend = 2 +! do j=js,je +! do i=is,ie +! j1 = jdc(i,j) +! jbeg = min(jbeg, j1) +! jend = max(jend, j1+1) +! enddo +! enddo +! +! km_store = km +! km = 1 ! n_soill Currently each soil layer increment is saved separately +! allocate ( wk3(1:im,jbeg:jend, 1:km) ) +! ! call interp_inc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend) !TODO check var name +! call interp_inc(LND_IAU_Control, 'soilt1_inc',increments%stc_inc(:,:,1),jbeg,jend) +! call interp_inc(LND_IAU_Control, 'soilt2_inc',increments%stc_inc(:,:,2),jbeg,jend) +! call interp_inc(LND_IAU_Control, 'soilt3_inc',increments%stc_inc(:,:,3),jbeg,jend) +! call interp_inc(LND_IAU_Control, 'soilt4_inc',increments%stc_inc(:,:,4),jbeg,jend) +! +! call interp_inc(LND_IAU_Control, 'slc1_inc',increments%slc_inc(:,:,1),jbeg,jend) +! call interp_inc(LND_IAU_Control, 'slc2_inc',increments%slc_inc(:,:,2),jbeg,jend) +! call interp_inc(LND_IAU_Control, 'slc3_inc',increments%slc_inc(:,:,3),jbeg,jend) +! call interp_inc(LND_IAU_Control, 'slc4_inc',increments%slc_inc(:,:,4),jbeg,jend) +! +! call interp_inc(LND_IAU_Control, 'tmp2m_inc',increments%tmp2m_inc(:,:,1),jbeg,jend) +! call interp_inc(LND_IAU_Control, 'spfh2m_inc',increments%spfh2m_inc(:,:,1),jbeg,jend) +!! call interp_inc_sfc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend, n_soill) +! call close_ncfile(ncid) +! deallocate (wk3) +! km = km_store +! +!end subroutine read_iau_forcing +! +!subroutine interp_inc(LND_IAU_Control, field_name, var, jbeg, jend) +!! interpolate increment from GSI gaussian grid to cubed sphere +!! everying is on the A-grid, earth relative +! type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control +! character(len=*), intent(in) :: field_name +! real, dimension(is:ie,js:je,1:km), intent(inout) :: var +! integer, intent(in) :: jbeg,jend +! integer:: i1, i2, j1, k,j,i,ierr +! call check_var_exists(ncid, field_name, ierr) +! if (ierr == 0) then +! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) +! else +! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(field_name),' found, assuming zero' +! wk3 = 0. +! endif +! do k=1,km +! do j=js,je +! do i=is,ie +! i1 = id1(i,j) +! i2 = id2(i,j) +! j1 = jdc(i,j) +! var(i,j,k) = s2c(i,j,1)*wk3(i1,j1 ,k) + s2c(i,j,2)*wk3(i2,j1 ,k)+& +! s2c(i,j,3)*wk3(i2,j1+1,k) + s2c(i,j,4)*wk3(i1,j1+1,k) +! enddo +! enddo +! enddo +!end subroutine interp_inc !> This routine is copied from 'fv_treat_da_inc.F90 by Xi.Chen ! copying it here, due to inability to 'include' from the original module when the land iau mod is called through CCPP frameowrk diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 06e188364..3611a3e46 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -23,7 +23,7 @@ module noahmpdrv private - public :: noahmpdrv_init, noahmpdrv_run !, noahmpdrv_timestep_init + public :: noahmpdrv_init, noahmpdrv_run, noahmpdrv_timestep_init, noahmpdrv_timestep_finalize ! IAU data and control type (lnd_iau_control_type) :: LND_IAU_Control @@ -292,7 +292,7 @@ subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp ! endif ! endif - call lnd_iau_mod_finalize() !LND_IAU_Control%finalize() + call lnd_iau_mod_finalize(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !LND_IAU_Control%finalize() end subroutine noahmpdrv_timestep_finalize diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index e99535399..e3915e5e2 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = noahmpdrv type = scheme - dependencies = funcphys.f90,machine.F,sfc_diff.f,module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,set_soilveg.f + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F + dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90 + dependencies = ../Noah/set_soilveg.f dependencies = sim_nc_mod_lnd.F90,lnd_iau_mod.F90 ######################################################################## From 3afbaa2d75d37ecff0407fe78133fefaa972ad4a Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 18 Apr 2024 12:44:56 -0400 Subject: [PATCH 007/141] deallocate at noahmpdrv_finalize --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 299 ++---------------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 67 ++-- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 20 ++ 3 files changed, 87 insertions(+), 299 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 4734468de..395e2b011 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -1,40 +1,28 @@ !*********************************************************************** -!* GNU Lesser General Public License -!* -!* This file is part of the FV3 dynamical core. -!* -!* The FV3 dynamical core is free software: you can redistribute it -!* and/or modify it under the terms of the -!* GNU Lesser General Public License as published by the -!* Free Software Foundation, either version 3 of the License, or -!* (at your option) any later version. -!* -!* The FV3 dynamical core is distributed in the hope that it will be -!* useful, but WITHOUT ANYWARRANTY; without even the implied warranty -!* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -!* See the GNU General Public License for more details. -!* -!* You should have received a copy of the GNU Lesser General Public -!* License along with the FV3 dynamical core. -!* If not, see . +!> TODO: replace with appropriate licence for CCPP +!* GNU Lesser General Public License +!* . !*********************************************************************** -!> The routine 'remapcoeff is copied from 'fv_treat_da_inc.F90 by Xi.Chen -! and put at the end of this module because, due to the compile order in CCPP framework it wasn't possible to 'include' -! the original module when the land iau mod is called through CCPP frameowrk +!> @brief Land IAU (Incremental Analysis Update) module, +!> adopted from the FV3 IAU mode for the dyamical core +!> to be able to do IAU updates for NoahMP states, soil/snow temperature +! +!> REVISION HISTORY: +!> March, 2024: Tseganeh Z. Gichamo (EMC ): Modify for land ! - - -!------------------------------------------------------------------------------- -!> @brief incremental analysis update module +!> FV3 IAU mod +!> @date 09/13/2017 !> @author Xi.Chen - author of fv_treat_da_inc.F90 !> @author Philip Pegion -!> @date 09/13/2017 -! -!> REVISION HISTORY: !> 09/13/2017 - Initial Version based on fv_treat_da_inc.F90 !------------------------------------------------------------------------------- +!* Note: The routine 'remapcoeff is copied from 'fv_treat_da_inc.F90 by Xi.Chen +!* and put at the end of this module because, due to the compile order in CCPP framework it wasn't possible to 'include' +!* the original module when the land iau mod is called through CCPP frameowrk + + #ifdef OVERLOAD_R4 #define _GET_VAR1 get_var1_real #else @@ -43,35 +31,12 @@ module lnd_iau_mod -! use fms_mod, only: file_exist -! use mpp_mod, only: mpp_error, FATAL, NOTE, mpp_pe -! use mpp_domains_mod, only: domain2d -! use constants_mod, only: pi=>pi_8 -! use fv_arrays_mod, only: R_GRID !, & - ! fv_atmos_type, & - ! fv_grid_type, & - ! fv_grid_bounds_type, & -! use fv_mp_mod, only: is_master use sim_nc_mod_lnd, only: open_ncfile, & close_ncfile, & get_ncdim1, & get_var1_double, & get_var3_r4, & get_var1_real, check_var_exists -! #ifdef GFS_TYPES -! use GFS_typedefs, only: IPD_init_type => GFS_init_type, & -! LND_IAU_Control_type => GFS_control_type, & -! kind_phys, & -! IPD_Data_type => GFS_data_type -! #else -! use IPD_typedefs, only: IPD_init_type, LND_IAU_Control_type, & -! kind_phys => IPD_kind_phys -! #endif - -! use block_control_mod, only: block_control_type -! use fv_treat_da_inc_mod, only: remap_coef -! use tracer_manager_mod, only: get_tracer_names,get_tracer_index, get_number_tracers -! use field_manager_mod, only: MODEL_ATMOS use machine, only: kind_phys, kind_dyn use physcons, only: pi => con_pi @@ -81,9 +46,7 @@ module lnd_iau_mod private real,allocatable::s2c(:,:,:) -! real:: s2c(Atm(1)%bd%is:Atm(1)%bd%ie,Atm(1)%bd%js:Atm(1)%bd%je,4) -! integer, dimension(Atm(1)%bd%is:Atm(1)%bd%ie,Atm(1)%bd%js:Atm(1)%bd%je):: & -! id1, id2, jdc + integer,allocatable,dimension(:,:) :: id1,id2,jdc real :: deg2rad,dt,rdt @@ -91,24 +54,17 @@ module lnd_iau_mod integer:: jbeg, jend integer :: n_soill, n_snowl !1.27.24 soil and snow layers - logical :: do_lnd_iau !do_lnd_iau_inc + logical :: do_lnd_iau integer :: is, ie, js, je integer :: npz !, ntracers -! character(len=32), allocatable :: tracer_names(:) -! integer, allocatable :: tracer_indicies(:) ! real(kind=4), allocatable:: wk3(:, :,:,:) - real(kind=4), allocatable:: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :), wk3_t2m(:, :, :, :), wk3_q2m(:, :, :, :) + real(kind=4), allocatable:: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :), & + wk3_t2m(:, :, :, :), wk3_q2m(:, :, :, :) type iau_internal_data_type - ! real,allocatable :: ua_inc(:,:,:) - ! real,allocatable :: va_inc(:,:,:) - ! real,allocatable :: temp_inc(:,:,:) - ! real,allocatable :: delp_inc(:,:,:) - ! real,allocatable :: delz_inc(:,:,:) - ! real,allocatable :: tracer_inc(:,:,:,:) - real,allocatable :: stc_inc(:,:,:) + real,allocatable :: stc_inc(:,:,:) real,allocatable :: slc_inc(:,:,:) real,allocatable :: tmp2m_inc(:,:, :) real,allocatable :: spfh2m_inc(:,:, :) @@ -120,7 +76,6 @@ module lnd_iau_mod real,allocatable :: tmp2m_inc(:,:,:) real,allocatable :: spfh2m_inc(:,:,:) logical :: in_interval = .false. - ! logical :: drymassfixer = .false. end type lnd_iau_external_data_type type iau_state_type @@ -159,39 +114,17 @@ module lnd_iau_mod character(len=:), pointer, dimension(:) :: input_nml_file => null() ! null() !< character string containing full namelist - ! integer :: logunit - !--- calendars and time parameters and activation triggers - ! real(kind=kind_phys) :: dtf !< dynamics timestep in seconds - ! integer :: idat(1:8) !< initialization date and time - ! !< (yr, mon, day, t-zone, hr, min, sec, mil-sec) - ! integer :: jdat(1:8) !< current forecast date and time - ! !< (yr, mon, day, t-zone, hr, min, sec, mil-sec) - ! real(kind=kind_phys) :: sec !< seconds since model initialization - ! real(kind=kind_phys) :: phour !< previous forecast hour - ! real(kind=kind_phys) :: zhour !< previous hour diagnostic buckets emptied - ! integer :: kdt !< current forecast iteration - ! logical :: first_time_step !< flag signaling first time step for time integration routine end type lnd_iau_control_type type(iau_state_type) :: IAU_state - public lnd_iau_control_type, lnd_iau_external_data_type, lnd_iau_mod_set_control, lnd_iau_mod_init, lnd_iau_mod_getiauforcing, lnd_iau_mod_finalize + public lnd_iau_control_type, lnd_iau_external_data_type, lnd_iau_mod_set_control, & + lnd_iau_mod_init, lnd_iau_mod_getiauforcing, lnd_iau_mod_finalize contains -subroutine lnd_iau_mod_set_control(LND_IAU_Control,fn_nml,input_nml_file_i,me, mpi_root, isc, jsc, nx, ny, nblks, blksz, & +subroutine lnd_iau_mod_set_control(LND_IAU_Control,fn_nml,input_nml_file_i,me, mpi_root, & + isc, jsc, nx, ny, nblks, blksz, & lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) !nlunit type (lnd_iau_control_type), intent(inout) :: LND_IAU_Control @@ -215,7 +148,7 @@ subroutine lnd_iau_mod_set_control(LND_IAU_Control,fn_nml,input_nml_file_i,me, m integer :: input_nml_file_length !< length(number of lines) in namelist for internal reads - !> 3.9.24 these are not available through the CCPP interface so need to read them from namelist file + !> 3.9.24 these are not available through the CCPP interface so need to read from namelist file !> vars to read from namelist logical :: do_lnd_iau = .false. real(kind=kind_phys) :: lnd_iau_delthrs = 0 !< iau time interval (to scale increments) @@ -308,10 +241,7 @@ end subroutine lnd_iau_mod_set_control subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) !nlunit, ncols, IPD_Data,,Init_parm) ! integer, intent(in) :: me, mpi_root type (lnd_iau_control_type), intent(in) :: LND_IAU_Control - type (lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data - ! type (IPD_init_type), intent(in) :: Init_parm - ! type (IPD_Data_type), dimension(:), intent(in) :: IPD_Data - ! integer, intent(in) :: ncols + type (lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon real(kind_phys), dimension(:), intent(in) :: xlat ! latitude character(len=*), intent(out) :: errmsg @@ -319,17 +249,13 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, ! local character(len=128) :: fname - ! real, dimension(:,:,:), allocatable:: u_inc, v_inc real(kind=kind_dyn), allocatable:: lat(:), lon(:),agrid(:,:,:) real(kind=kind_phys) sx,wx,wt,normfact,dtp - integer:: ib, i, j, k, nstep, kstep integer:: i1, i2, j1 - logical:: found integer nfilesall integer, allocatable :: idt(:) - real (kind=kind_phys), allocatable :: Init_parm_xlon (:, :) real (kind=kind_phys), allocatable :: Init_parm_xlat (:, :) integer :: nlon, nlat @@ -363,20 +289,14 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, ib = ib+nlon ! enddo enddo - ! call get_number_tracers(MODEL_ATMOS, num_tracers=ntracers) - ! allocate (tracer_names(ntracers)) - ! allocate (tracer_indicies(ntracers)) - ! do i = 1, ntracers - ! call get_tracer_names(MODEL_ATMOS, i, tracer_names(i)) - ! tracer_indicies(i) = get_tracer_index(MODEL_ATMOS,tracer_names(i)) - ! enddo + allocate(s2c(is:ie,js:je,4)) allocate(id1(is:ie,js:je)) allocate(id2(is:ie,js:je)) allocate(jdc(is:ie,js:je)) allocate(agrid(is:ie,js:je,2)) -! determine number of increment files to read, and the valid forecast hours +! determine number of increment files to read, and the valid forecast hours nfilesall = size(LND_IAU_Control%iau_inc_files) nfiles = 0 if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print*,'in lnd_iau_init incfile1 iaufhr1 ', & @@ -474,12 +394,6 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, if (allocated(Init_parm_xlon)) deallocate(Init_parm_xlon) if (allocated(Init_parm_xlat)) deallocate(Init_parm_xlat) - ! allocate(LND_IAU_Data%ua_inc(is:ie, js:je, km)) - ! allocate(LND_IAU_Data%va_inc(is:ie, js:je, km)) - ! allocate(LND_IAU_Data%temp_inc(is:ie, js:je, km)) - ! allocate(LND_IAU_Data%delp_inc(is:ie, js:je, km)) - ! allocate(LND_IAU_Data%delz_inc(is:ie, js:je, km)) - ! allocate(LND_IAU_Data%tracer_inc(is:ie, js:je, km,ntracers)) allocate(LND_IAU_Data%stc_inc(is:ie, js:je, km)) allocate(LND_IAU_Data%slc_inc(is:ie, js:je, km)) allocate(LND_IAU_Data%tmp2m_inc(is:ie, js:je, 1)) @@ -513,7 +427,7 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, iau_state%wt_normfact = (2*nstep+1)/normfact endif -!3.22.24 MB wants to read all increments files at iau init +!3.22.24 Mike B wants to read all increments files at iau init time ! Find bounding latitudes: jbeg = jm-1 jend = 2 @@ -710,7 +624,6 @@ subroutine updateiauforcing(LND_IAU_Control, LND_IAU_Data, wt) enddo end subroutine updateiauforcing - subroutine setiauforcing(LND_IAU_Control, LND_IAU_Data, wt) implicit none @@ -846,123 +759,11 @@ subroutine interp_inc_at_timestep(LND_IAU_Control, km_in, wk3_in, var, errmsg, e enddo end subroutine interp_inc_at_timestep -!subroutine read_iau_forcing(LND_IAU_Control, increments, fname, errmsg, errflg) !, fname_sfc) -! type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control -! type(iau_internal_data_type), intent(inout):: increments -! character(len=*), intent(in) :: fname -!! character(len=*), intent(in), optional :: fname_sfc -! character(len=*), intent(out) :: errmsg -! integer, intent(out) :: errflg -!!locals -!! real, dimension(:,:,:), allocatable:: u_inc, v_inc -! -! integer:: i, j, k, l, npz -! integer:: i1, i2, j1 -! integer:: jbeg, jend -!! real(kind=R_GRID), dimension(2):: p1, p2, p3 -!! real(kind=R_GRID), dimension(3):: e1, e2, ex, ey -! -!! logical :: found -! integer :: is, ie, js, je, km_store -! logical :: exists -! -! !Errors messages handled through CCPP error handling variables -! errmsg = '' -! errflg = 0 -! -! is = LND_IAU_Control%isc -! ie = is + LND_IAU_Control%nx-1 -! js = LND_IAU_Control%jsc -! je = js + LND_IAU_Control%ny-1 -! -! deg2rad = pi/180. -! -! npz = LND_IAU_Control%lsoil -! -! inquire (file=trim(fname), exist=exists) -! if (exists) then -!! if( file_exist(fname) ) then -! call open_ncfile( fname, ncid ) ! open the file -! else -! ! call mpp_error(FATAL,'==> Error in read_iau_forcing: Expected file '& -! ! //trim(fname)//' for DA increment does not exist') -! errmsg = 'FATAL Error in read_iau_forcing: Expected file '//trim(fname)//' for DA increment does not exist' -! errflg = 1 -! return -! endif -! -! ! Find bounding latitudes: -! jbeg = jm-1; jend = 2 -! do j=js,je -! do i=is,ie -! j1 = jdc(i,j) -! jbeg = min(jbeg, j1) -! jend = max(jend, j1+1) -! enddo -! enddo -! -! km_store = km -! km = 1 ! n_soill Currently each soil layer increment is saved separately -! allocate ( wk3(1:im,jbeg:jend, 1:km) ) -! ! call interp_inc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend) !TODO check var name -! call interp_inc(LND_IAU_Control, 'soilt1_inc',increments%stc_inc(:,:,1),jbeg,jend) -! call interp_inc(LND_IAU_Control, 'soilt2_inc',increments%stc_inc(:,:,2),jbeg,jend) -! call interp_inc(LND_IAU_Control, 'soilt3_inc',increments%stc_inc(:,:,3),jbeg,jend) -! call interp_inc(LND_IAU_Control, 'soilt4_inc',increments%stc_inc(:,:,4),jbeg,jend) -! -! call interp_inc(LND_IAU_Control, 'slc1_inc',increments%slc_inc(:,:,1),jbeg,jend) -! call interp_inc(LND_IAU_Control, 'slc2_inc',increments%slc_inc(:,:,2),jbeg,jend) -! call interp_inc(LND_IAU_Control, 'slc3_inc',increments%slc_inc(:,:,3),jbeg,jend) -! call interp_inc(LND_IAU_Control, 'slc4_inc',increments%slc_inc(:,:,4),jbeg,jend) -! -! call interp_inc(LND_IAU_Control, 'tmp2m_inc',increments%tmp2m_inc(:,:,1),jbeg,jend) -! call interp_inc(LND_IAU_Control, 'spfh2m_inc',increments%spfh2m_inc(:,:,1),jbeg,jend) -!! call interp_inc_sfc('stc_inc',increments%stc_inc(:,:,:),jbeg,jend, n_soill) -! call close_ncfile(ncid) -! deallocate (wk3) -! km = km_store -! -!end subroutine read_iau_forcing -! -!subroutine interp_inc(LND_IAU_Control, field_name, var, jbeg, jend) -!! interpolate increment from GSI gaussian grid to cubed sphere -!! everying is on the A-grid, earth relative -! type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control -! character(len=*), intent(in) :: field_name -! real, dimension(is:ie,js:je,1:km), intent(inout) :: var -! integer, intent(in) :: jbeg,jend -! integer:: i1, i2, j1, k,j,i,ierr -! call check_var_exists(ncid, field_name, ierr) -! if (ierr == 0) then -! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) -! else -! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(field_name),' found, assuming zero' -! wk3 = 0. -! endif -! do k=1,km -! do j=js,je -! do i=is,ie -! i1 = id1(i,j) -! i2 = id2(i,j) -! j1 = jdc(i,j) -! var(i,j,k) = s2c(i,j,1)*wk3(i1,j1 ,k) + s2c(i,j,2)*wk3(i2,j1 ,k)+& -! s2c(i,j,3)*wk3(i2,j1+1,k) + s2c(i,j,4)*wk3(i1,j1+1,k) -! enddo -! enddo -! enddo -!end subroutine interp_inc - -!> This routine is copied from 'fv_treat_da_inc.F90 by Xi.Chen +!> This subroutine is copied from 'fv_treat_da_inc.F90 by Xi.Chen ! copying it here, due to inability to 'include' from the original module when the land iau mod is called through CCPP frameowrk -! -!> @author Xi.Chen -!> @date 02/12/2016 -! -! REVISION HISTORY: -! 02/12/2016 - Initial Version +!> @author Xi.Chen !> @date 02/12/2016 !============================================================================= !>@brief The subroutine 'remap_coef' calculates the coefficients for horizonal regridding. - subroutine remap_coef( is, ie, js, je, isd, ied, jsd, jed, & im, jm, lon, lat, id1, id2, jdc, s2c, agrid ) @@ -1040,42 +841,6 @@ subroutine remap_coef( is, ie, js, je, isd, ied, jsd, jed, & 5000 continue ! j-loop end subroutine remap_coef - -! subroutine interp_inc_sfc(LND_IAU_Control, field_name,var,jbeg,jend, k_lv) !is_land_in) -! ! interpolate increment from GSI gaussian grid to cubed sphere -! ! everying is on the A-grid, earth relative -! type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control -! character(len=*), intent(in) :: field_name -! integer, intent(in) :: jbeg, jend, k_lv -! real, dimension(is:ie,js:je,1:k_lv), intent(inout) :: var -! ! logical, intent(in), optional :: is_land_in -! ! logical :: is_land -! integer:: i1, i2, j1, k,j,i,ierr -! ! k_lv = km -! ! is_land = .false. -! ! if ( present(is_land_in) ) is_land = is_land_in -! ! if (is_land) k_lv = n_soill -! call check_var_exists(ncid, field_name, ierr) -! if (ierr == 0) then -! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,k_lv, wk3 ) !k, wk3 ) -! else -! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(field_name),' found, assuming zero' -! wk3 = 0. -! endif - -! do k=1,k_lv !km -! do j=js,je -! do i=is,ie -! i1 = id1(i,j) -! i2 = id2(i,j) -! j1 = jdc(i,j) -! var(i,j,k) = s2c(i,j,1)*wk3(i1,j1 ,k) + s2c(i,j,2)*wk3(i2,j1 ,k)+& -! s2c(i,j,3)*wk3(i2,j1+1,k) + s2c(i,j,4)*wk3(i1,j1+1,k) -! enddo -! enddo -! enddo - -! end subroutine interp_inc_sfc end module lnd_iau_mod diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 3611a3e46..e811d57f9 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -12,6 +12,7 @@ module noahmpdrv use module_sf_noahmplsm + ! 3.5.24 for use in IAU use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type, & lnd_iau_mod_set_control, lnd_iau_mod_init, lnd_iau_mod_getiauforcing, & @@ -23,7 +24,8 @@ module noahmpdrv private - public :: noahmpdrv_init, noahmpdrv_run, noahmpdrv_timestep_init, noahmpdrv_timestep_finalize + public :: noahmpdrv_init, noahmpdrv_run, & + noahmpdrv_timestep_init, noahmpdrv_timestep_finalize, noahmpdrv_finalize ! IAU data and control type (lnd_iau_control_type) :: LND_IAU_Control @@ -147,13 +149,6 @@ end subroutine noahmpdrv_init !! subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_root, stc, slc, errmsg, errflg) ! smc, t2mmp, q2mp, - ! lsnow_lsm, lsnowl, & - ! ncols, isc, jsc, nx, ny, nblks, - ! & - ! blksz, xlon, xlat, - ! & !& garea, iyrlen, julian, - ! vegtype, idveg, & - ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, use machine, only: kind_phys @@ -170,19 +165,9 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! integer, intent(in) :: lsnow_lsm - ! integer , intent(in) :: lsnowl ! lower bound for snow level arrays - ! integer, intent(in) :: ncols, isc, jsc, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks - ! integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz - ! real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon - ! real(kind_phys), dimension(:), intent(in) :: xlat ! latitude - - ! --- local variable - ! integer :: nb, im ! vertical soil layer dimension - ! IAU update real,allocatable :: stc_inc_flat(:,:) - real,allocatable :: slc_inc_flat(:,:) + ! real,allocatable :: slc_inc_flat(:,:) ! real,allocatable :: tmp2m_inc_flat(:) ! real,allocatable :: spfh2m_inc_flat(:) integer :: j, k, ib @@ -225,20 +210,19 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! local variable to copy blocked data LND_IAU_Data%stc_inc allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols - allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols + ! allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols ib = 1 do j = 1, LND_IAU_Control%ny !ny do k = 1, km stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) =LND_IAU_Data%stc_inc(:,j, k) - slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j, k) + ! slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j, k) enddo ! ib = 1 ! do j = 1, LND_IAU_Control%ny !ny ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) =LND_IAU_Data%tmp2m_inc(:,j, 1) ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1)=LND_IAU_Data%spfh2m_inc(:,j, 1) - ib = ib + LND_IAU_Control%nx !nlon enddo @@ -249,16 +233,17 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo endif endif !IAU increments are in units of 1/sec !LND_IAU_Control%dtp +!* only updating soil temp do k = 1, km stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !LND_IAU_Control%dtp - slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !LND_IAU_Control%dtp + ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !LND_IAU_Control%dtp enddo ! t2mmp = t2mmp + & ! tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb) + im-1)*delt !LND_IAU_Control%dtp ! q2mp = q2mp + & ! spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+ im-1)*delt !LND_IAU_Control%dtp - deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) + deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) endif @@ -268,7 +253,7 @@ end subroutine noahmpdrv_timestep_init !! \brief This subroutine is called after noahmpdrv_run !! to free up allocated memory !! \section arg_table_noahmpdrv_timestep_finalize Argument Table -!! \htmlinclude noahmpdrv_timestep_init.html +!! \htmlinclude noahmpdrv_timestep_finalize.html !! subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, @@ -284,17 +269,35 @@ subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp ! --- Initialize CCPP error handling variables errmsg = '' errflg = 0 + + !> note the IAU deallocate happens at the noahmpdrv_finalize - ! ! delt=GFS_Control%dtf - ! if ((LND_IAU_Control%dtp - delt) > 0.0001) then - ! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - ! print*, "Warning noahmpdrv_run delt ",delt,"different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp - ! endif - ! endif + end subroutine noahmpdrv_timestep_finalize + + !> \ingroup NoahMP_LSM +!! \brief This subroutine mirrors noahmpdrv_init +!! to free up allocated memory in IAU_init (noahmdrv_init) +!! \section arg_table_noahmpdrv_finalize Argument Table +!! \htmlinclude noahmpdrv_finalize.html +!! + subroutine noahmpdrv_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, + + use machine, only: kind_phys + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: j, k, ib + + ! --- Initialize CCPP error handling variables + errmsg = '' + errflg = 0 call lnd_iau_mod_finalize(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !LND_IAU_Control%finalize() - end subroutine noahmpdrv_timestep_finalize + end subroutine noahmpdrv_finalize !> \ingroup NoahMP_LSM !! \brief This subroutine is the main CCPP entry point for the NoahMP LSM. diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index e3915e5e2..04a847993 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -302,6 +302,26 @@ type = integer intent = out +####################################################################### +[ccpp-arg-table] + name = noahmpdrv_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + ####################################################################### [ccpp-arg-table] name = noahmpdrv_run From 8a8b17bb830a6b6b4fd4a184ea6b3e54c265329d Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 18 Apr 2024 12:58:00 -0400 Subject: [PATCH 008/141] comment nc mod --- physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 b/physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 index 9dcb096ef..6f2bd1ad2 100644 --- a/physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 +++ b/physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 @@ -19,6 +19,9 @@ !* If not, see . !*********************************************************************** +!> March 2024: This is a copy of S-J Lin's sim_nc_mod +!> renamed it sim_nc_mod_lnd to faciliate compilaton + !>@brief The module 'sim_nc' is a netcdf file reader. !>@details The code is necessary to circumvent issues with the FMS !! 'read_data' utility, which opens too many files and uses excessive From 9d9036f4f7fafcbfeab1b5aae79fd469cc52de06 Mon Sep 17 00:00:00 2001 From: tsga Date: Wed, 22 May 2024 18:30:45 +0000 Subject: [PATCH 009/141] mv config up --- config/ccpp_prebuild_config.py | 250 ----------------- driver/CCPP_driver.F90 | 254 ------------------ .../suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml | 96 ------- suites/suite_FV3_GFS_v17_p8_ugwpv1.xml | 95 ------- 4 files changed, 695 deletions(-) delete mode 100755 config/ccpp_prebuild_config.py delete mode 100644 driver/CCPP_driver.F90 delete mode 100644 suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml delete mode 100644 suites/suite_FV3_GFS_v17_p8_ugwpv1.xml diff --git a/config/ccpp_prebuild_config.py b/config/ccpp_prebuild_config.py deleted file mode 100755 index 6080e1769..000000000 --- a/config/ccpp_prebuild_config.py +++ /dev/null @@ -1,250 +0,0 @@ -#!/usr/bin/env python - -# CCPP prebuild config for GFDL Finite-Volume Cubed-Sphere Model (FV3) - - -############################################################################### -# Definitions # -############################################################################### - -HOST_MODEL_IDENTIFIER = "FV3" - -# Add all files with metadata tables on the host model side and in CCPP, -# relative to basedir = top-level directory of host model. This includes -# kind and type definitions used in CCPP physics. Also add any internal -# dependencies of these files to the list. -VARIABLE_DEFINITION_FILES = [ - # actual variable definition files - 'framework/src/ccpp_types.F90', - 'physics/physics/machine.F', - 'physics/physics/radsw_param.f', - 'physics/physics/radlw_param.f', - 'physics/physics/h2o_def.f', - 'physics/physics/radiation_surface.f', - 'physics/physics/module_ozphys.F90', - 'data/CCPP_typedefs.F90', - 'data/GFS_typedefs.F90', - 'data/CCPP_data.F90', - ] - -TYPEDEFS_NEW_METADATA = { - 'ccpp_types' : { - 'ccpp_t' : 'cdata', - 'ccpp_types' : '', - }, - 'machine' : { - 'machine' : '', - }, - 'module_radlw_parameters' : { - 'module_radsw_parameters' : '', - }, - 'module_radlw_parameters' : { - 'module_radlw_parameters' : '', - }, - 'module_ozphys' : { - 'module_ozphys' : '', - 'ty_ozphys' : '', - }, - 'CCPP_typedefs' : { - 'GFS_interstitial_type' : 'GFS_Interstitial(cdata%thrd_no)', - 'GFDL_interstitial_type' : 'GFDL_interstitial', - 'CCPP_typedefs' : '', - }, - 'CCPP_data' : { - 'CCPP_data' : '', - }, - 'GFS_typedefs' : { - 'GFS_control_type' : 'GFS_Control', - 'GFS_data_type' : 'GFS_Data(cdata%blk_no)', - 'GFS_diag_type' : 'GFS_Data(cdata%blk_no)%Intdiag', - 'GFS_tbd_type' : 'GFS_Data(cdata%blk_no)%Tbd', - 'GFS_sfcprop_type' : 'GFS_Data(cdata%blk_no)%Sfcprop', - 'GFS_coupling_type' : 'GFS_Data(cdata%blk_no)%Coupling', - 'GFS_statein_type' : 'GFS_Data(cdata%blk_no)%Statein', - 'GFS_cldprop_type' : 'GFS_Data(cdata%blk_no)%Cldprop', - 'GFS_radtend_type' : 'GFS_Data(cdata%blk_no)%Radtend', - 'GFS_grid_type' : 'GFS_Data(cdata%blk_no)%Grid', - 'GFS_stateout_type' : 'GFS_Data(cdata%blk_no)%Stateout', - 'GFS_typedefs' : '', - }, - } - -# Add all physics scheme files relative to basedir -SCHEME_FILES = [ - # Relative path to source (from where ccpp_prebuild.py is called) : [ list of physics sets in which scheme may be called ]; - # current restrictions are that each scheme can only belong to one physics set, and all schemes within one group in the - # suite definition file have to belong to the same physics set - 'physics/physics/GFS_DCNV_generic_pre.F90', - 'physics/physics/GFS_DCNV_generic_post.F90', - 'physics/physics/GFS_GWD_generic_pre.F90', - 'physics/physics/GFS_GWD_generic_post.F90', - 'physics/physics/GFS_MP_generic_pre.F90', - 'physics/physics/GFS_MP_generic_post.F90', - 'physics/physics/GFS_PBL_generic_pre.F90', - 'physics/physics/GFS_PBL_generic_post.F90', - 'physics/physics/GFS_SCNV_generic_pre.F90', - 'physics/physics/GFS_SCNV_generic_post.F90', - 'physics/physics/GFS_debug.F90', - 'physics/physics/GFS_phys_time_vary.fv3.F90', - 'physics/physics/GFS_rad_time_vary.fv3.F90', - 'physics/physics/GFS_radiation_surface.F90', - 'physics/physics/GFS_rrtmg_post.F90', - 'physics/physics/GFS_rrtmg_pre.F90', - 'physics/physics/GFS_rrtmg_setup.F90', - 'physics/physics/GFS_stochastics.F90', - 'physics/physics/GFS_suite_interstitial_rad_reset.F90', - 'physics/physics/GFS_suite_interstitial_phys_reset.F90', - 'physics/physics/GFS_suite_interstitial_1.F90', - 'physics/physics/GFS_suite_interstitial_2.F90', - 'physics/physics/GFS_suite_stateout_reset.F90', - 'physics/physics/GFS_suite_stateout_update.F90', - 'physics/physics/GFS_suite_interstitial_3.F90', - 'physics/physics/GFS_suite_interstitial_4.F90', - 'physics/physics/GFS_suite_interstitial_5.F90', - 'physics/physics/GFS_surface_generic_pre.F90', - 'physics/physics/GFS_surface_generic_post.F90', - 'physics/physics/GFS_surface_composites_pre.F90', - 'physics/physics/GFS_surface_composites_inter.F90', - 'physics/physics/GFS_surface_composites_post.F90', - 'physics/physics/GFS_surface_loop_control_part1.F90', - 'physics/physics/GFS_surface_loop_control_part2.F90', - 'physics/physics/GFS_time_vary_pre.fv3.F90', - 'physics/physics/GFS_physics_post.F90', - 'physics/physics/cires_ugwp.F90', - 'physics/physics/cires_ugwp_post.F90', - 'physics/physics/unified_ugwp.F90', - 'physics/physics/unified_ugwp_post.F90', - 'physics/physics/ugwpv1_gsldrag.F90', - 'physics/physics/ugwpv1_gsldrag_post.F90', - 'physics/physics/cnvc90.f', - 'physics/physics/cs_conv_pre.F90', - 'physics/physics/cs_conv.F90', - 'physics/physics/cs_conv_post.F90', - 'physics/physics/cs_conv_aw_adj.F90', - 'physics/physics/cu_ntiedtke_pre.F90', - 'physics/physics/cu_ntiedtke.F90', - 'physics/physics/cu_ntiedtke_post.F90', - 'physics/physics/dcyc2t3.f', - 'physics/physics/drag_suite.F90', - 'physics/physics/shoc.F90', - 'physics/physics/get_prs_fv3.F90', - 'physics/physics/get_phi_fv3.F90', - 'physics/physics/gfdl_cloud_microphys.F90', - 'physics/physics/fv_sat_adj.F90', - 'physics/physics/gfdl_sfc_layer.F90', - 'physics/physics/zhaocarr_gscond.f', - 'physics/physics/gwdc_pre.f', - 'physics/physics/gwdc.f', - 'physics/physics/gwdc_post.f', - 'physics/physics/gwdps.f', - 'physics/physics/h2ophys.f', - 'physics/physics/samfdeepcnv.f', - 'physics/physics/samfshalcnv.f', - 'physics/physics/sascnvn.F', - 'physics/physics/shalcnv.F', - 'physics/physics/maximum_hourly_diagnostics.F90', - 'physics/physics/m_micro.F90', - 'physics/physics/m_micro_pre.F90', - 'physics/physics/m_micro_post.F90', - 'physics/physics/cu_gf_driver_pre.F90', - 'physics/physics/cu_gf_driver.F90', - 'physics/physics/cu_gf_driver_post.F90', - 'physics/physics/cu_c3_driver_pre.F90', - 'physics/physics/cu_c3_driver.F90', - 'physics/physics/cu_c3_driver_post.F90', - 'physics/physics/hedmf.f', - 'physics/physics/moninshoc.f', - 'physics/physics/satmedmfvdif.F', - 'physics/physics/satmedmfvdifq.F', - 'physics/physics/shinhongvdif.F90', - 'physics/physics/ysuvdif.F90', - 'physics/physics/mynnedmf_wrapper.F90', - 'physics/physics/mynnsfc_wrapper.F90', - 'physics/physics/sgscloud_radpre.F90', - 'physics/physics/sgscloud_radpost.F90', - 'physics/physics/myjsfc_wrapper.F90', - 'physics/physics/myjpbl_wrapper.F90', - 'physics/physics/mp_thompson_pre.F90', - 'physics/physics/mp_thompson.F90', - 'physics/physics/mp_thompson_post.F90', - 'physics/physics/mp_nssl.F90', - 'physics/physics/zhaocarr_precpd.f', - 'physics/physics/radlw_main.F90', - 'physics/physics/radsw_main.F90', - 'physics/physics/rascnv.F90', - 'physics/physics/rayleigh_damp.f', - 'physics/physics/rrtmg_lw_post.F90', - 'physics/physics/rrtmg_lw_pre.F90', - 'physics/physics/rrtmg_sw_post.F90', - 'physics/physics/rad_sw_pre.F90', - 'physics/physics/sfc_diag.f', - 'physics/physics/sfc_diag_post.F90', - 'physics/physics/lsm_ruc.F90', - 'physics/physics/sfc_cice.f', - 'physics/physics/sfc_diff.f', - 'physics/physics/lsm_noah.f', - 'physics/physics/noahmpdrv.F90', - 'physics/physics/noahmpdrv_time_vary.F90', - 'physics/physics/flake_driver.F90', - 'physics/physics/clm_lake.f90', - 'physics/physics/sfc_nst_pre.f90', - 'physics/physics/sfc_nst.f90', - 'physics/physics/sfc_nst_post.f90', - 'physics/physics/sfc_ocean.F', - 'physics/physics/sfc_sice.f', - # HAFS FER_HIRES - 'physics/physics/mp_fer_hires.F90', - # SMOKE - 'physics/physics/smoke_dust/rrfs_smoke_wrapper.F90', - 'physics/physics/smoke_dust/rrfs_smoke_postpbl.F90', - # RRTMGP - 'physics/physics/rrtmgp_aerosol_optics.F90', - 'physics/physics/rrtmgp_lw_main.F90', - 'physics/physics/rrtmgp_sw_main.F90', - 'physics/physics/GFS_rrtmgp_setup.F90', - 'physics/physics/GFS_rrtmgp_pre.F90', - 'physics/physics/GFS_cloud_diagnostics.F90', - 'physics/physics/GFS_rrtmgp_cloud_mp.F90', - 'physics/physics/GFS_rrtmgp_cloud_overlap.F90', - 'physics/physics/GFS_rrtmgp_post.F90' - ] - -# Default build dir, relative to current working directory, -# if not specified as command-line argument -DEFAULT_BUILD_DIR = 'build' - -# Auto-generated makefile/cmakefile snippets that contain all type definitions -TYPEDEFS_MAKEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.mk' -TYPEDEFS_CMAKEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.cmake' -TYPEDEFS_SOURCEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.sh' - -# Auto-generated makefile/cmakefile snippets that contain all schemes -SCHEMES_MAKEFILE = '{build_dir}/physics/CCPP_SCHEMES.mk' -SCHEMES_CMAKEFILE = '{build_dir}/physics/CCPP_SCHEMES.cmake' -SCHEMES_SOURCEFILE = '{build_dir}/physics/CCPP_SCHEMES.sh' - -# Auto-generated makefile/cmakefile snippets that contain all caps -CAPS_MAKEFILE = '{build_dir}/physics/CCPP_CAPS.mk' -CAPS_CMAKEFILE = '{build_dir}/physics/CCPP_CAPS.cmake' -CAPS_SOURCEFILE = '{build_dir}/physics/CCPP_CAPS.sh' - -# Directory where to put all auto-generated physics caps -CAPS_DIR = '{build_dir}/physics' - -# Directory where the suite definition files are stored -SUITES_DIR = 'suites' - -# Directory where to write static API to -STATIC_API_DIR = '{build_dir}/physics' -STATIC_API_CMAKEFILE = '{build_dir}/physics/CCPP_STATIC_API.cmake' -STATIC_API_SOURCEFILE = '{build_dir}/physics/CCPP_STATIC_API.sh' - -# Directory for writing HTML pages generated from metadata files -# used by metadata2html.py for generating scientific documentation -METADATA_HTML_OUTPUT_DIR = '{build_dir}/physics/physics/docs' - -# HTML document containing the model-defined CCPP variables -HTML_VARTABLE_FILE = '{build_dir}/physics/CCPP_VARIABLES_FV3.html' - -# LaTeX document containing the provided vs requested CCPP variables -LATEX_VARTABLE_FILE = '{build_dir}/framework/doc/DevelopersGuide/CCPP_VARIABLES_FV3.tex' diff --git a/driver/CCPP_driver.F90 b/driver/CCPP_driver.F90 deleted file mode 100644 index 6c633fc4d..000000000 --- a/driver/CCPP_driver.F90 +++ /dev/null @@ -1,254 +0,0 @@ -module CCPP_driver - - use ccpp_types, only: ccpp_t - - use ccpp_static_api, only: ccpp_physics_init, & - ccpp_physics_timestep_init, & - ccpp_physics_run, & - ccpp_physics_timestep_finalize, & - ccpp_physics_finalize - - use CCPP_data, only: cdata_tile, & - cdata_domain, & - cdata_block, & - ccpp_suite, & - GFS_control, & - GFS_data - - implicit none - -!--------------------------------------------------------! -! Pointer to CCPP containers defined in CCPP_data ! -!--------------------------------------------------------! - type(ccpp_t), pointer :: cdata => null() - -!--------------------------------------------------------! -! Flag for non-uniform block sizes (last block smaller) ! -! and number of OpenMP threads (with special thread ! -! number nthrdsX in case of non-uniform block sizes) ! -!--------------------------------------------------------! - logical :: non_uniform_blocks - integer :: nthrds, nthrdsX - -!---------------- -! Public Entities -!---------------- -! functions - public CCPP_step -! module variables - public non_uniform_blocks - - CONTAINS -!******************************************************************************************* - -!------------------------------- -! CCPP step -!------------------------------- - subroutine CCPP_step (step, nblks, ierr) - -#ifdef _OPENMP - use omp_lib -#endif - - implicit none - - character(len=*), intent(in) :: step - integer, intent(in) :: nblks - integer, intent(out) :: ierr - ! Local variables - integer :: nb, nt, ntX - integer :: ierr2 - ! DH* 20210104 - remove kdt_rad when code to clear diagnostic buckets is removed - integer :: kdt_rad - - ierr = 0 - - if (trim(step)=="init") then - - ! Get and set number of OpenMP threads (module - ! variable) that are available to run physics -#ifdef _OPENMP - nthrds = omp_get_max_threads() -#else - nthrds = 1 -#endif - - ! For non-uniform blocksizes, we use index nthrds+1 - ! for the interstitial data type with different length - if (non_uniform_blocks) then - nthrdsX = nthrds+1 - else - nthrdsX = nthrds - end if - - ! For physics running over the entire domain, block and thread - ! number are not used; set to safe values - cdata_domain%blk_no = 1 - cdata_domain%thrd_no = 1 - - ! Allocate cdata structures for blocks and threads - if (.not.allocated(cdata_block)) allocate(cdata_block(1:nblks,1:nthrdsX)) - - ! Loop over all blocks and threads - do nt=1,nthrdsX - do nb=1,nblks - ! Assign the correct block and thread numbers - cdata_block(nb,nt)%blk_no = nb - cdata_block(nb,nt)%thrd_no = nt - end do - end do - - else if (trim(step)=="physics_init") then - - ! Since the physics init step is independent of the blocking structure, - ! we can use cdata_domain. And since we don't use threading on the host - ! model side, we can allow threading inside the physics init routines. - GFS_control%nthreads = nthrds - - call ccpp_physics_init(cdata_domain, suite_name=trim(ccpp_suite), ierr=ierr) - if (ierr/=0) then - write(0,'(a)') "An error occurred in ccpp_physics_init" - write(0,'(a)') trim(cdata_domain%errmsg) - return - end if - - ! Timestep init = time_vary - else if (trim(step)=="timestep_init") then - - ! Since the physics timestep init step is independent of the blocking structure, - ! we can use cdata_domain. And since we don't use threading on the host - ! model side, we can allow threading inside the timestep init (time_vary) routines. - GFS_control%nthreads = nthrds - - call ccpp_physics_timestep_init(cdata_domain, suite_name=trim(ccpp_suite), group_name="time_vary", ierr=ierr) - if (ierr/=0) then - write(0,'(a)') "An error occurred in ccpp_physics_timestep_init for group time_vary" - write(0,'(a)') trim(cdata_domain%errmsg) - return - end if - - ! call timestep_init for "physics" - call ccpp_physics_timestep_init(cdata_domain, suite_name=trim(ccpp_suite),group_name="physics", ierr=ierr) - if (ierr/=0) then - write(0,'(a)') "An error occurred in ccpp_physics_timestep_init for group physics" - write(0,'(a)') trim(cdata_domain%errmsg) - return - end if - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! DH* 20210104 - this block of code will be removed once the CCPP framework ! - ! fully supports handling diagnostics through its metadata, work in progress ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - !--- determine if radiation diagnostics buckets need to be cleared - if (nint(GFS_control%fhzero*3600) >= nint(max(GFS_control%fhswr,GFS_control%fhlwr))) then - if (mod(GFS_control%kdt,GFS_control%nszero) == 1) then - do nb = 1,nblks - call GFS_data(nb)%Intdiag%rad_zero(GFS_control) - end do - endif - else - kdt_rad = nint(min(GFS_control%fhswr,GFS_control%fhlwr)/GFS_control%dtp) - if (mod(GFS_control%kdt,kdt_rad) == 1) then - do nb = 1,nblks - call GFS_data(nb)%Intdiag%rad_zero(GFS_control) - enddo - endif - endif - - !--- determine if physics diagnostics buckets need to be cleared - if ((mod(GFS_control%kdt-1,GFS_control%nszero)) == 0) then - do nb = 1,nblks - call GFS_data(nb)%Intdiag%phys_zero(GFS_control) - end do - endif - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! *DH 20210104 ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! Radiation, physics and and stochastic physics - threaded regions using blocked data structures - else if (trim(step)=="radiation" .or. trim(step)=="physics" .or. trim(step)=="stochastics") then - - ! Set number of threads available to physics schemes to one, - ! because threads are used on the host model side for blocking - GFS_control%nthreads = 1 - -!$OMP parallel num_threads (nthrds) & -!$OMP default (shared) & -!$OMP private (nb,nt,ntX,ierr2) & -!$OMP reduction (+:ierr) -#ifdef _OPENMP - nt = omp_get_thread_num()+1 -#else - nt = 1 -#endif -!$OMP do schedule (dynamic,1) - do nb = 1,nblks - ! For non-uniform blocks, the last block has a different (shorter) - ! length than the other blocks; use special CCPP_Interstitial(nthrdsX) - if (non_uniform_blocks .and. nb==nblks) then - ntX = nthrdsX - else - ntX = nt - end if - !--- Call CCPP radiation/physics/stochastics group - call ccpp_physics_run(cdata_block(nb,ntX), suite_name=trim(ccpp_suite), group_name=trim(step), ierr=ierr2) - if (ierr2/=0) then - write(0,'(2a,3(a,i4),a)') "An error occurred in ccpp_physics_run for group ", trim(step), & - ", block ", nb, " and thread ", nt, " (ntX=", ntX, "):" - write(0,'(a)') trim(cdata_block(nb,ntX)%errmsg) - ierr = ierr + ierr2 - end if - end do -!$OMP end do - -!$OMP end parallel - if (ierr/=0) return - - ! Timestep finalize = time_vary - else if (trim(step)=="timestep_finalize") then - - ! Since the physics timestep finalize step is independent of the blocking structure, - ! we can use cdata_domain. And since we don't use threading on the host model side, - ! we can allow threading inside the timestep finalize (time_vary) routines. - GFS_control%nthreads = nthrds - - call ccpp_physics_timestep_finalize(cdata_domain, suite_name=trim(ccpp_suite), group_name="time_vary", ierr=ierr) - if (ierr/=0) then - write(0,'(a)') "An error occurred in ccpp_physics_timestep_finalize for group time_vary" - write(0,'(a)') trim(cdata_domain%errmsg) - return - end if - - ! Physics finalize - else if (trim(step)=="physics_finalize") then - - ! Since the physics finalize step is independent of the blocking structure, - ! we can use cdata_domain. And since we don't use threading on the host - ! model side, we can allow threading inside the physics finalize routines. - GFS_control%nthreads = nthrds - - call ccpp_physics_finalize(cdata_domain, suite_name=trim(ccpp_suite), ierr=ierr) - if (ierr/=0) then - write(0,'(a)') "An error occurred in ccpp_physics_finalize" - write(0,'(a)') trim(cdata_domain%errmsg) - return - end if - - ! Finalize - else if (trim(step)=="finalize") then - ! Deallocate cdata structure for blocks and threads - if (allocated(cdata_block)) deallocate(cdata_block) - - else - - write(0,'(2a)') 'Error, undefined CCPP step ', trim(step) - ierr = 1 - return - - end if - - end subroutine CCPP_step - -end module CCPP_driver diff --git a/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml b/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml deleted file mode 100644 index 011a93867..000000000 --- a/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml +++ /dev/null @@ -1,96 +0,0 @@ - - - - - - - GFS_time_vary_pre - GFS_rrtmg_setup - GFS_rad_time_vary - GFS_phys_time_vary - noahmpdrv_time_vary - - - - - GFS_suite_interstitial_rad_reset - GFS_rrtmg_pre - GFS_radiation_surface - rad_sw_pre - rrtmg_sw - rrtmg_sw_post - rrtmg_lw_pre - rrtmg_lw - rrtmg_lw_post - GFS_rrtmg_post - - - - - GFS_suite_interstitial_phys_reset - GFS_suite_stateout_reset - get_prs_fv3 - GFS_suite_interstitial_1 - GFS_surface_generic_pre - GFS_surface_composites_pre - dcyc2t3 - GFS_surface_composites_inter - GFS_suite_interstitial_2 - - - - sfc_diff - GFS_surface_loop_control_part1 - sfc_nst_pre - sfc_nst - sfc_nst_post - noahmpdrv - sfc_cice - sfc_sice - GFS_surface_loop_control_part2 - - - - GFS_surface_composites_post - sfc_diag - sfc_diag_post - GFS_surface_generic_post - GFS_PBL_generic_pre - satmedmfvdifq - GFS_PBL_generic_post - GFS_GWD_generic_pre - ugwpv1_gsldrag - ugwpv1_gsldrag_post - GFS_GWD_generic_post - GFS_suite_stateout_update - h2ophys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - samfdeepcnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - GFS_SCNV_generic_post - GFS_suite_interstitial_4 - cnvc90 - GFS_MP_generic_pre - mp_thompson_pre - - - mp_thompson - - - mp_thompson_post - GFS_MP_generic_post - maximum_hourly_diagnostics - - - - - GFS_stochastics - GFS_physics_post - - - - diff --git a/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml b/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml deleted file mode 100644 index bca1b018d..000000000 --- a/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml +++ /dev/null @@ -1,95 +0,0 @@ - - - - - - - GFS_time_vary_pre - GFS_rrtmg_setup - GFS_rad_time_vary - GFS_phys_time_vary - noahmpdrv_time_vary - - - - - GFS_suite_interstitial_rad_reset - GFS_rrtmg_pre - GFS_radiation_surface - rad_sw_pre - rrtmg_sw - rrtmg_sw_post - rrtmg_lw_pre - rrtmg_lw - rrtmg_lw_post - GFS_rrtmg_post - - - - - GFS_suite_interstitial_phys_reset - GFS_suite_stateout_reset - get_prs_fv3 - GFS_suite_interstitial_1 - GFS_surface_generic_pre - GFS_surface_composites_pre - dcyc2t3 - GFS_surface_composites_inter - GFS_suite_interstitial_2 - - - - sfc_diff - GFS_surface_loop_control_part1 - sfc_nst_pre - sfc_nst - sfc_nst_post - noahmpdrv - sfc_sice - GFS_surface_loop_control_part2 - - - - GFS_surface_composites_post - sfc_diag - sfc_diag_post - GFS_surface_generic_post - GFS_PBL_generic_pre - satmedmfvdifq - GFS_PBL_generic_post - GFS_GWD_generic_pre - ugwpv1_gsldrag - ugwpv1_gsldrag_post - GFS_GWD_generic_post - GFS_suite_stateout_update - h2ophys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - samfdeepcnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - GFS_SCNV_generic_post - GFS_suite_interstitial_4 - cnvc90 - GFS_MP_generic_pre - mp_thompson_pre - - - mp_thompson - - - mp_thompson_post - GFS_MP_generic_post - maximum_hourly_diagnostics - - - - - GFS_stochastics - GFS_physics_post - - - - From f04a01dd238d2d0d0d8fd1d5d0a87c79094999fc Mon Sep 17 00:00:00 2001 From: tsga Date: Wed, 22 May 2024 20:12:23 +0000 Subject: [PATCH 010/141] delte _time_vary mods --- .../Land/Noahmp/noahmpdrv_time_vary.F90 | 340 ------------------ .../Land/Noahmp/noahmpdrv_time_vary.meta | 230 ------------ 2 files changed, 570 deletions(-) delete mode 100644 physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.F90 delete mode 100644 physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.meta diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.F90 deleted file mode 100644 index ea9805cd4..000000000 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.F90 +++ /dev/null @@ -1,340 +0,0 @@ -#define CCPP -!> \file noahmpdrv_time_vary.F90 -!! This file contains the IAU Updates for the NoahMP land surface scheme driver. - -!>\defgroup NoahMP_LSM NoahMP LSM Model -!! \brief This is the NoahMP LSM the IAU Updates module - -!> This module contains the CCPP-compliant IAU Update module for NoahMP land surface model driver. -!> The noahmpdrv_time_vary module is an alternative to calling the IAU updates directly from within the noahmpdrv module -!> The current "CCPP_driver" module's ccpp_step(step="timestep_init") function call only handles group="time_vary" and not "physics" -! -module noahmpdrv_time_vary - - ! use module_sf_noahmplsm - ! 3.5.24 for use in IAU - use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type,& - lnd_iau_mod_set_control, lnd_iau_mod_init,lnd_iau_mod_getiauforcing - - implicit none - - private - - public :: noahmpdrv_time_vary_init, noahmpdrv_time_vary_timestep_init !, noahmpdrv_time_vary_run -! public :: noahmpdrv_time_vary_timestep_finalize, noahmpdrv_time_vary_finalize - - ! IAU data and control - type (lnd_iau_control_type) :: LND_IAU_Control - type (lnd_iau_external_data_type) :: LND_IAU_Data !(number of blocks):each proc holds nblks - - contains - -!> \ingroup NoahMP_LSM -!! \brief This subroutine is called during the CCPP initialization phase to -!! initialize Land IAU Control and Land IAU Data structures. -!! \section arg_table_noahmpdrv_time_vary_init Argument Table -!! \htmlinclude noahmpdrv_time_vary_init.html -!! - subroutine noahmpdrv_time_vary_init(lsm, lsm_noahmp, me, mpi_root, & - fn_nml, input_nml_file, isc, jsc, ncols, nx, ny, nblks, & - blksz, xlon, xlat, & - lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) - - use machine, only: kind_phys - !use GFS_typedefs, only: GFS_control_type - ! use GFS_typedefs, only: GFS_data_type - - implicit none - - integer, intent(in) :: lsm - integer, intent(in) :: lsm_noahmp - integer, intent(in) :: me ! mpi_rank - integer, intent(in) :: mpi_root ! = GFS_Control%master - character(*), intent(in) :: fn_nml - character(len=:), intent(in), dimension(:), pointer :: input_nml_file - integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks - integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz - real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon - real(kind_phys), dimension(:), intent(in) :: xlat ! latitude - integer, intent(in) :: lsoil, lsnow_lsm - real(kind=kind_phys), intent(in) :: dtp, fhour - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! type(gfs_data_type), dimension(:), intent(inout) :: GFS_Data ! !(one:) - ! type(gfs_control_type), intent(in) :: GFS_Control - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! 3.7.24 init iau for land - call lnd_iau_mod_set_control(LND_IAU_Control, fn_nml, input_nml_file, me, mpi_root, isc,jsc, nx, ny, nblks, blksz, & - lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) -! print*, 'proc errmsg, errflg after set control', me, errmsg, errflg -! print*, 'proc iau_control isc, nx, dtp fhour', me, LND_IAU_Control%isc, LND_IAU_Control%nx, & -! LND_IAU_Control%dtp, LND_IAU_Control%fhour -! print*, 'proc iau_control incfiles(1)', me, LND_IAU_Control%iau_inc_files(1) -! stop - call lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) - !print*, 'proc errmsg, errflg interval after lnd_iau_init ', me,trim(errmsg), errflg, LND_IAU_Data%in_interval - print*, 'proc nblks blksize(1) after lnd_iau_mod_init ', me,LND_IAU_Control%nblks, LND_IAU_Control%blksz(1) - - end subroutine noahmpdrv_time_vary_init - -!> \ingroup NoahMP_LSM -!! \brief This subroutine is called before noahmpdrv_run timestep to update -!! states with iau increments -!! \section arg_table_noahmpdrv_time_vary_timestep_init Argument Table -!! \htmlinclude noahmpdrv_time_vary_timestep_init.html -!! - subroutine noahmpdrv_time_vary_timestep_init (itime, fhour, delt, km, & !me, mpi_root, - stc, slc, errmsg, errflg) ! smc, t2mmp, q2mp, - - use machine, only: kind_phys - - implicit none - - ! integer, intent(in) :: me !mpi_rank - ! integer, intent(in) :: mpi_root ! = GFS_Control%master - integer , intent(in) :: itime !current forecast iteration - real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) - real(kind=kind_phys) , intent(in) :: delt ! time interval [s] - integer , intent(in) :: km !vertical soil layer dimension - real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] - real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! --- local variable - ! integer :: nb, im ! vertical soil layer dimension - - ! IAU update - real,allocatable :: stc_inc_flat(:,:) - real,allocatable :: slc_inc_flat(:,:) - ! real,allocatable :: tmp2m_inc_flat(:) - ! real,allocatable :: spfh2m_inc_flat(:) - integer :: j, k, ib - ! --- end declaration - - ! --- Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - !> update current forecast hour - ! GFS_control%jdat(:) = jdat(:) - LND_IAU_Control%fhour=fhour - - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",LND_IAU_Control%fhour, & - " delt ",delt," IauCont%dtp",LND_IAU_Control%dtp - endif - - !> 3.7.24 read iau increments - call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) - if (errflg .ne. 0) then - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" - print*, errmsg - endif - return - endif - - !> update with iau increments - if (LND_IAU_Data%in_interval) then - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*, "adding land iau increments " - endif - - if (LND_IAU_Control%lsoil .ne. km) then - write(errmsg,*) 'noahmpdrv_timestep_init: LND_IAU_Data%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km - errflg = 1 - return - endif - - ! local variable to copy blocked data LND_IAU_Data%stc_inc - allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols - allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols - ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols - ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols - ib = 1 - do j = 1, LND_IAU_Control%ny !ny - do k = 1, km - stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) =LND_IAU_Data%stc_inc(:,j, k) - slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j, k) - enddo - ! ib = 1 - ! do j = 1, LND_IAU_Control%ny !ny - ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) =LND_IAU_Data%tmp2m_inc(:,j, 1) - ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1)=LND_IAU_Data%spfh2m_inc(:,j, 1) - - ib = ib + LND_IAU_Control%nx !nlon - enddo - - ! delt=GFS_Control%dtf - if ((LND_IAU_Control%dtp - delt) > 0.0001) then - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*, "Warning noahmpdrv_timevary_tstep delt ",delt,"different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp - endif - endif - !IAU increments are in units of 1/sec !LND_IAU_Control%dtp - do k = 1, km - stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !LND_IAU_Control%dtp - slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !LND_IAU_Control%dtp - enddo - ! t2mmp = t2mmp + & - ! tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb) + im-1)*delt !LND_IAU_Control%dtp - ! q2mp = q2mp + & - ! spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+ im-1)*delt !LND_IAU_Control%dtp - - deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) - - endif - - end subroutine noahmpdrv_time_vary_timestep_init - - -! !> \ingroup NoahMP_LSM -! !! \brief -! !! \section arg_table_noahmpdrv_time_vary_run Argument Table -! !! \htmlinclude noahmpdrv_time_vary_run.html -! !! -! !! \section general_noahmpdrv_time_vary_run -! !! @{ -! !! - Initialize CCPP error handling variables. - -! subroutine noahmpdrv_time_vary_run(nb, im, km, lsnowl, itime, fhour, errmsg, errflg) -! ! ! --- inputs: -! ! ! --- in/outs: -! ! weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & -! ! ! --- Noah MP specific -! ! ! --- outputs: -! ! ) - -! use machine , only : kind_phys - -! implicit none - -! ! -! ! --- CCPP interface fields (in call order) -! ! -! integer , intent(in) :: nb !=cdata%blk_no, -! integer , intent(in) :: im ! horiz dimension and num of used pts -! integer , intent(in) :: km ! vertical soil layer dimension -! integer , intent(in) :: lsnowl ! lower bound for snow level arrays -! integer , intent(in) :: itime ! NOT USED current forecast iteration -! real(kind=kind_phys) , intent(in) :: fhour ! currentforecast time (hr) - -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! ground surface skin temperature [K] -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: tprcp ! total precipitation [m] -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: srflag ! snow/rain flag for precipitation -! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! total soil moisture content [m3/m3] -! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soil temp [K] -! ! real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc ! liquid soil moisture [m3/m3] -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: canopy ! canopy moisture content [mm] -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: trans ! total plant transpiration [m/s] -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: tsurf ! surface skin temperature [K] -! ! real(kind=kind_phys), dimension(:) , intent(inout) :: zorl ! surface roughness [cm] - -! character(len=*) , intent(out) :: errmsg -! integer , intent(out) :: errflg -! ! -! ! --- end declaration -! ! - -! ! -! ! --- Initialize CCPP error handling variables -! ! -! errmsg = '' -! errflg = 0 - -! ! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then -! ! print*,"nb ",nb," itime ",itime," GFScont%fhour ",fhour," iauCon%fhour",LND_IAU_Control%fhour," delt ",delt," iauCont%dtp",LND_IAU_Control%dtp -! ! endif -! ! ! 3.7.24 read iau increments -! ! call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) -! ! if (errflg .ne. 0) return -! ! ! update with iau increments -! ! if (LND_IAU_Data%in_interval) then -! ! if (LND_IAU_Control%lsoil .ne. km) then -! ! write(errmsg, *)'in noahmpdrv_run, lnd_iau_mod update increments:LND_IAU_Control%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km -! ! errflg = 1 -! ! return -! ! endif -! ! ! LND_IAU_Data%stc_inc(is:ie, js:je, km)) size of (nx, ny) -! ! ! xlatin(im) stc(im,km) slc() t2mmp(:) q2mp(im) km=n_soill, im = -! ! ! GFS_Control%blksz(cdata%blk_no) -! ! ! >> need to get (cdata%blk_no from function call - -! ! ! local variable to copy blocked data LND_IAU_Data%stc_inc -! ! allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols -! ! allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols -! ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols -! ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols -! ! ib = 1 -! ! do j = 1, LND_IAU_Control%ny !ny -! ! do k = 1, km -! ! stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%stc_inc(:,j,k) -! ! slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j,k) -! ! enddo -! ! ! ib = 1 -! ! ! do j = 1, LND_IAU_Control%ny !ny -! ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) = LND_IAU_Data%tmp2m_inc(:,j,1) -! ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) = LND_IAU_Data%spfh2m_inc(:,j,1) -! ! ib = ib + LND_IAU_Control%nx !nlon -! ! enddo - -! ! !IAU increments are in units of 1/sec !LND_IAU_Control%dtp -! ! ! delt=GFS_Control%dtf -! ! if ((LND_IAU_Control%dtp - delt) > 0.0001) then -! ! if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then -! ! print*, "Warning time step used in noahmpdrv_run delt ",delt," different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp -! ! endif -! ! endif -! ! do k = 1, km -! ! stc(:,k)=stc(:,k)+stc_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1, k)*delt !LND_IAU_Control%dtp -! ! slc(:,k)=slc(:,k)+slc_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1, k)*delt !LND_IAU_Control%dtp -! ! enddo -! ! t2mmp = t2mmp+tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1)*delt !LND_IAU_Control%dtp -! ! q2mp = q2mp +spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+im-1)*delt !LND_IAU_Control%dtp - -! ! deallocate(stc_inc_flat, slc_inc_flat, tmp2m_inc_flat, spfh2m_inc_flat) - -! ! end if -! end subroutine noahmpdrv_time_vary_run - -! subroutine noahmpdrv_time_vary_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, - - -! use machine, only: kind_phys - -! implicit none - -! character(len=*), intent(out) :: errmsg -! integer, intent(out) :: errflg - -! ! --- Initialize CCPP error handling variables -! errmsg = '' -! errflg = 0 - -! end subroutine noahmpdrv_time_vary_timestep_finalize - -! subroutine noahmpdrv_time_vary_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, - - -! use machine, only: kind_phys - -! implicit none - -! character(len=*), intent(out) :: errmsg -! integer, intent(out) :: errflg - -! ! --- Initialize CCPP error handling variables -! errmsg = '' -! errflg = 0 - -! end subroutine noahmpdrv_time_vary_finalize - -end module noahmpdrv_time_vary diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.meta deleted file mode 100644 index 246fe1f5e..000000000 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv_time_vary.meta +++ /dev/null @@ -1,230 +0,0 @@ -[ccpp-table-properties] - name = noahmpdrv_time_vary - type = scheme - dependencies = funcphys.f90, machine.F - dependencies = sim_nc_mod_lnd.F90, lnd_iau_mod.F90 - -######################################################################## -[ccpp-arg-table] - name = noahmpdrv_time_vary_init - type = scheme -[lsm] - standard_name = control_for_land_surface_scheme - long_name = flag for land surface model - units = flag - dimensions = () - type = integer - intent = in -[lsm_noahmp] - standard_name = identifier_for_noahmp_land_surface_scheme - long_name = flag for NOAH MP land surface model - units = flag - dimensions = () - type = integer - intent = in -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in -[mpi_root] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer - intent = in -[fn_nml] - standard_name = filename_of_namelist - long_name = namelist filename - units = none - type = character - dimensions = () - kind = len=* - intent = in -[input_nml_file] - standard_name = filename_of_internal_namelist - long_name = amelist filename for internal file reads - units = none - type = character - dimensions = (ccpp_constant_one:number_of_lines_in_internal_namelist) - kind = len=256 - intent = in -[isc] - standard_name = starting_x_index_for_this_mpi_rank - long_name = starting index in the x direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in -[jsc] - standard_name = starting_y_index_for_this_mpi_rank - long_name = starting index in the y direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in -[ncols] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nx] - standard_name = number_of_points_in_x_direction_for_this_mpi_rank - long_name = number of points in x direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in -[ny] - standard_name = number_of_points_in_y_direction_for_this_mpi_rank - long_name = number of points in y direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in -[nblks] - standard_name = ccpp_block_count - long_name = for explicit data blocking: number of blocks - units = count - dimensions = () - type = integer - intent = in -[blksz] - standard_name = ccpp_block_sizes - long_name = for explicit data blocking: block sizes of all blocks - units = count - dimensions = (ccpp_constant_one:ccpp_block_count) - type = integer - intent = in -[xlon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in -[xlat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in -[lsoil] - standard_name = vertical_dimension_of_soil - long_name = number of soil layers - units = count - dimensions = () - type = integer - intent = in -[lsnow_lsm] - standard_name = vertical_dimension_of_surface_snow - long_name = maximum number of snow layers for land surface model - units = count - dimensions = () - type = integer - intent = in -[dtp] - standard_name = timestep_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[fhour] - standard_name = forecast_time - long_name = current forecast time - units = h - dimensions = () - type = real - kind = kind_phys - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = noahmpdrv_time_vary_timestep_init - type = scheme -[itime] - standard_name = index_of_timestep - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in -[fhour] - standard_name = forecast_time - long_name = current forecast time - units = h - dimensions = () - type = real - kind = kind_phys - intent = in -[delt] - standard_name = timestep_for_dynamics - long_name = dynamics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[km] - standard_name = vertical_dimension_of_soil - long_name = soil vertical layer dimension - units = count - dimensions = () - type = integer - intent = in -[stc] - standard_name = soil_temperature - long_name = soil temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension_of_soil) - type = real - kind = kind_phys - intent = inout -[slc] - standard_name = volume_fraction_of_unfrozen_water_in_soil - long_name = liquid soil moisture - units = frac - dimensions = (horizontal_dimension,vertical_dimension_of_soil) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out From f8b96b546e914a9e2afec97c7284784505661ddd Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sat, 25 May 2024 15:30:16 -0400 Subject: [PATCH 011/141] add nc90 funcs, cleanup, add comments --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 726 +++++++++--------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 137 ++-- 2 files changed, 425 insertions(+), 438 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 395e2b011..d25aa3877 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -5,102 +5,78 @@ !*********************************************************************** !> @brief Land IAU (Incremental Analysis Update) module, -!> adopted from the FV3 IAU mode for the dyamical core -!> to be able to do IAU updates for NoahMP states, soil/snow temperature -! -!> REVISION HISTORY: -!> March, 2024: Tseganeh Z. Gichamo (EMC ): Modify for land -! -!> FV3 IAU mod -!> @date 09/13/2017 -!> @author Xi.Chen - author of fv_treat_da_inc.F90 -!> @author Philip Pegion -!> 09/13/2017 - Initial Version based on fv_treat_da_inc.F90 -!------------------------------------------------------------------------------- - -!* Note: The routine 'remapcoeff is copied from 'fv_treat_da_inc.F90 by Xi.Chen -!* and put at the end of this module because, due to the compile order in CCPP framework it wasn't possible to 'include' -!* the original module when the land iau mod is called through CCPP frameowrk +!> for the NoahMP soil/snow temperature (can be extended to include soil moisture) +!! \section land_iau_mod +!> - reads settings from namelist file (which indicates if IAU increments are available or not) +!> - reads in DA increments from GSI/JEDI DA at the start of (the DA) cycle +!> - interpolates increments to FV3 grid points (if increments are in Gaussian grid) +!> - interpolates temporally (with filter, weights if required by configuration) +!> - updates states with the interpolated increments -#ifdef OVERLOAD_R4 -#define _GET_VAR1 get_var1_real -#else -#define _GET_VAR1 get_var1_double -#endif - -module lnd_iau_mod +!> March, 2024: Tseganeh Z. Gichamo, (EMC) based on the FV3 IAU mod +!> by Xi.Chen and Philip Pegion, PSL +!------------------------------------------------------------------------------- - use sim_nc_mod_lnd, only: open_ncfile, & - close_ncfile, & - get_ncdim1, & - get_var1_double, & - get_var3_r4, & - get_var1_real, check_var_exists +module land_iau_mod use machine, only: kind_phys, kind_dyn use physcons, only: pi => con_pi + use netcdf implicit none private - real,allocatable::s2c(:,:,:) + real(kind=kind_phys),allocatable::s2c(:,:,:) integer,allocatable,dimension(:,:) :: id1,id2,jdc - real :: deg2rad,dt,rdt + real(kind=kind_phys) :: deg2rad,dt,rdt integer :: im,jm,km,nfiles,ncid integer:: jbeg, jend - integer :: n_soill, n_snowl !1.27.24 soil and snow layers - logical :: do_lnd_iau + integer :: n_soill, n_snowl !soil and snow layers + logical :: do_land_iau integer :: is, ie, js, je - integer :: npz !, ntracers - -! real(kind=4), allocatable:: wk3(:, :,:,:) - real(kind=4), allocatable:: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :), & - wk3_t2m(:, :, :, :), wk3_q2m(:, :, :, :) - - type iau_internal_data_type - real,allocatable :: stc_inc(:,:,:) - real,allocatable :: slc_inc(:,:,:) - real,allocatable :: tmp2m_inc(:,:, :) - real,allocatable :: spfh2m_inc(:,:, :) - end type iau_internal_data_type - - type lnd_iau_external_data_type - real,allocatable :: stc_inc(:,:,:) - real,allocatable :: slc_inc(:,:,:) - real,allocatable :: tmp2m_inc(:,:,:) - real,allocatable :: spfh2m_inc(:,:,:) + integer :: npz + + real(kind=kind_phys), allocatable:: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) + + type land_iau_internal_data_type + real(kind=kind_phys),allocatable :: stc_inc(:,:,:) + real(kind=kind_phys),allocatable :: slc_inc(:,:,:) + end type land_iau_internal_data_type + + type land_iau_external_data_type + real(kind=kind_phys),allocatable :: stc_inc(:,:,:) + real(kind=kind_phys),allocatable :: slc_inc(:,:,:) logical :: in_interval = .false. - end type lnd_iau_external_data_type + end type land_iau_external_data_type - type iau_state_type - type(iau_internal_data_type):: inc1 - type(iau_internal_data_type):: inc2 + type land_iau_state_type + type(land_iau_internal_data_type):: inc1 + type(land_iau_internal_data_type):: inc2 real(kind=kind_phys) :: hr1 real(kind=kind_phys) :: hr2 real(kind=kind_phys) :: wt real(kind=kind_phys) :: wt_normfact - end type iau_state_type + end type land_iau_state_type - type lnd_iau_control_type + type land_iau_control_type integer :: isc integer :: jsc integer :: nx integer :: ny integer :: nblks - ! integer :: blksz ! this could vary for the last block - integer, allocatable :: blksz(:) + integer, allocatable :: blksz(:) ! this could vary for the last block integer, allocatable :: blk_strt_indx(:) integer :: lsoil !< number of soil layers ! this is the max dim (TBC: check it is consitent for noahmpdrv) integer :: lsnow_lsm !< maximum number of snow layers internal to land surface model - logical :: do_lnd_iau + logical :: do_land_iau real(kind=kind_phys) :: iau_delthrs ! iau time interval (to scale increments) in hours character(len=240) :: iau_inc_files(7)! list of increment files real(kind=kind_phys) :: iaufhrs(7) ! forecast hours associated with increment files @@ -115,19 +91,19 @@ module lnd_iau_mod !< for use with internal file reads integer :: input_nml_file_length ! 3.9.24 these are not available through the CCPP interface so need to read from namelist file + !> these are not available through the CCPP interface so need to read them from namelist file !> vars to read from namelist - logical :: do_lnd_iau = .false. - real(kind=kind_phys) :: lnd_iau_delthrs = 0 !< iau time interval (to scale increments) - character(len=240) :: lnd_iau_inc_files(7) = '' !< list of increment files - real(kind=kind_phys) :: lnd_iaufhrs(7) = -1 !< forecast hours associated with increment files - logical :: lnd_iau_filter_increments = .false. !< filter IAU increments + logical :: do_land_iau = .false. + real(kind=kind_phys) :: land_iau_delthrs = 0 !< iau time interval (to scale increments) + character(len=240) :: land_iau_inc_files(7) = '' !< list of increment files + real(kind=kind_phys) :: land_iaufhrs(7) = -1 !< forecast hours associated with increment files + logical :: land_iau_filter_increments = .false. !< filter IAU increments - NAMELIST /lnd_iau_nml/ do_lnd_iau, lnd_iau_delthrs, lnd_iau_inc_files, lnd_iaufhrs, lnd_iau_filter_increments !, lnd_iau_drymassfixer & + NAMELIST /lnd_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iaufhrs, land_iau_filter_increments !, lnd_iau_drymassfixer & !Errors messages handled through CCPP error handling variables errmsg = '' @@ -181,7 +157,7 @@ subroutine lnd_iau_mod_set_control(LND_IAU_Control,fn_nml,input_nml_file_i,me, m errflg = 1 return else - LND_IAU_Control%fn_nml = trim(fn_nml) ! maynot need this + Land_IAU_Control%fn_nml = trim(fn_nml) ! maynot need this open (unit=nlunit, file=trim(fn_nml), action='READ', status='OLD', iostat=ios, iomsg=ioerrmsg) rewind(nlunit) read (nlunit, nml=lnd_iau_nml) @@ -203,53 +179,54 @@ subroutine lnd_iau_mod_set_control(LND_IAU_Control,fn_nml,input_nml_file_i,me, m write(6, lnd_iau_nml) endif - LND_IAU_Control%do_lnd_iau = do_lnd_iau - LND_IAU_Control%iau_delthrs = lnd_iau_delthrs - LND_IAU_Control%iau_inc_files = lnd_iau_inc_files - LND_IAU_Control%iaufhrs = lnd_iaufhrs - LND_IAU_Control%iau_filter_increments = lnd_iau_filter_increments - ! LND_IAU_Control%iau_drymassfixer = lnd_iau_drymassfixer - LND_IAU_Control%me = me - LND_IAU_Control%mpi_root = mpi_root - LND_IAU_Control%isc = isc - LND_IAU_Control%jsc = jsc - LND_IAU_Control%nx = nx - LND_IAU_Control%ny = ny - LND_IAU_Control%nblks = nblks - LND_IAU_Control%lsoil = lsoil - LND_IAU_Control%lsnow_lsm = lsnow_lsm - LND_IAU_Control%dtp = dtp - LND_IAU_Control%fhour = fhour - - LND_IAU_Control%input_nml_file = input_nml_file - LND_IAU_Control%input_nml_file_length = input_nml_file_length - - allocate(LND_IAU_Control%blksz(nblks)) - allocate(LND_IAU_Control%blk_strt_indx(nblks)) - !start index of each block, for flattened (ncol=nx*ny) arrays + Land_IAU_Control%do_land_iau = do_land_iau + Land_IAU_Control%iau_delthrs = land_iau_delthrs + Land_IAU_Control%iau_inc_files = land_iau_inc_files + Land_IAU_Control%iaufhrs = land_iaufhrs + Land_IAU_Control%iau_filter_increments = land_iau_filter_increments + ! Land_IAU_Control%iau_drymassfixer = lnd_iau_drymassfixer + Land_IAU_Control%me = me + Land_IAU_Control%mpi_root = mpi_root + Land_IAU_Control%isc = isc + Land_IAU_Control%jsc = jsc + Land_IAU_Control%nx = nx + Land_IAU_Control%ny = ny + Land_IAU_Control%nblks = nblks + Land_IAU_Control%lsoil = lsoil + Land_IAU_Control%lsnow_lsm = lsnow_lsm + Land_IAU_Control%dtp = dtp + Land_IAU_Control%fhour = fhour + + Land_IAU_Control%input_nml_file = input_nml_file + Land_IAU_Control%input_nml_file_length = input_nml_file_length + + allocate(Land_IAU_Control%blksz(nblks)) + allocate(Land_IAU_Control%blk_strt_indx(nblks)) + + ! Land_IAU_Control%blk_strt_indx: start index of each block, for flattened (ncol=nx*ny) arrays ! required in noahmpdriv_run to get subsection of the stc array for each - ! proc/thread + ! proces/thread ix = 1 do nb=1, nblks - LND_IAU_Control%blksz(nb) = blksz(nb) - LND_IAU_Control%blk_strt_indx(nb) = ix + Land_IAU_Control%blksz(nb) = blksz(nb) + Land_IAU_Control%blk_strt_indx(nb) = ix ix = ix + blksz(nb) enddo -end subroutine lnd_iau_mod_set_control +end subroutine land_iau_mod_set_control -subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) !nlunit, ncols, IPD_Data,,Init_parm) +subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errmsg, errflg) !nlunit, ncols, IPD_Data,,Init_parm) ! integer, intent(in) :: me, mpi_root - type (lnd_iau_control_type), intent(in) :: LND_IAU_Control - type (lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data - real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon - real(kind_phys), dimension(:), intent(in) :: xlat ! latitude + type (land_iau_control_type), intent(in) :: Land_IAU_Control + type (land_iau_external_data_type), intent(inout) :: Land_IAU_Data + real(kind=kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon + real(kind=kind_phys), dimension(:), intent(in) :: xlat ! latitude character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! local character(len=128) :: fname - real(kind=kind_dyn), allocatable:: lat(:), lon(:),agrid(:,:,:) + real(kind=kind_phys), allocatable:: lat(:), lon(:),agrid(:,:,:) real(kind=kind_phys) sx,wx,wt,normfact,dtp integer:: ib, i, j, k, nstep, kstep integer:: i1, i2, j1 @@ -261,24 +238,26 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, integer :: nlon, nlat ! integer :: nb, ix, nblks, blksz logical :: exists + ! necdf vars + integer :: ncid, dimid, varid, status, IDIM !Errors messages handled through CCPP error handling variables errmsg = '' errflg = 0 - do_lnd_iau = LND_IAU_Control%do_lnd_iau - n_soill = LND_IAU_Control%lsoil !4 for sfc updates -! n_snowl = LND_IAU_Control%lsnowl - npz = LND_IAU_Control%lsoil + do_land_iau = Land_IAU_Control%do_land_iau + n_soill = Land_IAU_Control%lsoil !4 for sfc updates +! n_snowl = Land_IAU_Control%lsnowl + npz = Land_IAU_Control%lsoil - is = LND_IAU_Control%isc - ie = is + LND_IAU_Control%nx-1 - js = LND_IAU_Control%jsc - je = js + LND_IAU_Control%ny-1 - nlon = LND_IAU_Control%nx - nlat = LND_IAU_Control%ny - !nblks = LND_IAU_Control%nblks - !blksz = LND_IAU_Control%blksz(1) + is = Land_IAU_Control%isc + ie = is + Land_IAU_Control%nx-1 + js = Land_IAU_Control%jsc + je = js + Land_IAU_Control%ny-1 + nlon = Land_IAU_Control%nx + nlat = Land_IAU_Control%ny + !nblks = Land_IAU_Control%nblks + !blksz = Land_IAU_Control%blksz(1) allocate(Init_parm_xlon(nlon,nlat), Init_parm_xlat(nlon,nlat)) ib = 1 @@ -297,69 +276,65 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, allocate(agrid(is:ie,js:je,2)) ! determine number of increment files to read, and the valid forecast hours - nfilesall = size(LND_IAU_Control%iau_inc_files) + nfilesall = size(Land_IAU_Control%iau_inc_files) nfiles = 0 - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print*,'in lnd_iau_init incfile1 iaufhr1 ', & - trim(LND_IAU_Control%iau_inc_files(1)),LND_IAU_Control%iaufhrs(1) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,'in land_iau_init incfile1 iaufhr1 ', & + trim(Land_IAU_Control%iau_inc_files(1)),Land_IAU_Control%iaufhrs(1) do k=1,nfilesall - if (trim(LND_IAU_Control%iau_inc_files(k)) .eq. '' .or. LND_IAU_Control%iaufhrs(k) .lt. 0) exit - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print *,k, " ", trim(adjustl(LND_IAU_Control%iau_inc_files(k))) + if (trim(Land_IAU_Control%iau_inc_files(k)) .eq. '' .or. Land_IAU_Control%iaufhrs(k) .lt. 0) exit + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,k, " ", trim(adjustl(Land_IAU_Control%iau_inc_files(k))) endif nfiles = nfiles + 1 enddo - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'nfiles = ',nfiles + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'nfiles = ',nfiles if (nfiles < 1) then return endif if (nfiles > 1) then allocate(idt(nfiles-1)) - idt = LND_IAU_Control%iaufhrs(2:nfiles)-LND_IAU_Control%iaufhrs(1:nfiles-1) + idt = Land_IAU_Control%iaufhrs(2:nfiles)-Land_IAU_Control%iaufhrs(1:nfiles-1) do k=1,nfiles-1 - if (idt(k) .ne. LND_IAU_Control%iaufhrs(2)-LND_IAU_Control%iaufhrs(1)) then - print *,'in lnd_iau_init: forecast intervals in iaufhrs must be constant' + if (idt(k) .ne. Land_IAU_Control%iaufhrs(2)-Land_IAU_Control%iaufhrs(1)) then + print *,'in land_iau_init: forecast intervals in iaufhrs must be constant' ! call mpp_error (FATAL,' forecast intervals in iaufhrs must be constant') - errmsg = 'Fatal error in lnd_iau_init. forecast intervals in iaufhrs must be constant' + errmsg = 'Fatal error in land_iau_init. forecast intervals in iaufhrs must be constant' errflg = 1 return endif enddo deallocate(idt) endif - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'lnd_iau interval = ',LND_IAU_Control%iau_delthrs,' hours' - dt = (LND_IAU_Control%iau_delthrs*3600.) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval = ',Land_IAU_Control%iau_delthrs,' hours' + dt = (Land_IAU_Control%iau_delthrs*3600.) rdt = 1.0/dt ! set up interpolation weights to go from GSI's gaussian grid to cubed sphere deg2rad = pi/180. - ! npz = LND_IAU_Control%levs - fname = 'INPUT/'//trim(LND_IAU_Control%iau_inc_files(1)) + ! npz = Land_IAU_Control%levs + fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1)) inquire (file=trim(fname), exist=exists) - if (exists) then - ! if( file_exist(fname) ) then - call open_ncfile( fname, ncid ) ! open the file -!TODO !change to Latitude - call get_ncdim1( ncid, 'longitude', im) - call get_ncdim1( ncid, 'latitude', jm) - ! call get_ncdim1( ncid, 'nsoill', km) + if (exists) then ! if( file_exist(fname) ) then + ! call open_ncfile( fname, ncid ) + status = nf90_open(trim(fname), NF90_NOWRITE, ncid) ! open the file + call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) + if (errflg .ne. 0) return + call get_nc_dimlen(ncid, "longitude", im, errflg, errmsg) + if (errflg .ne. 0) return + call get_nc_dimlen(ncid, "latitude", jm, errflg, errmsg) + if (errflg .ne. 0) return km = n_soill - ! if (km.ne.npz) then - ! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *, 'km = ', km - ! ! call mpp_error(FATAL, '==> Error in IAU_initialize: km is not equal to npz') - ! errmsg = 'Fatal Error in IAU_initialize: km is not equal to npz' - ! errflg = 1 - ! return - ! endif - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) write(*,*) fname, ' DA increment dimensions:', im,jm,km - - allocate ( lon(im) ) - allocate ( lat(jm) ) - - call _GET_VAR1 (ncid, 'longitude', im, lon ) - call _GET_VAR1 (ncid, 'latitude', jm, lat ) - call close_ncfile(ncid) - + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) write(*,*) fname, ' DA increment dimensions:', im,jm,km + allocate (lon(im) ) + allocate (lat(jm) ) + call get_var1d(ncid, im, "longitude", lon, errflg, errmsg) + if (errflg .ne. 0) return + call get_var1d(ncid, jm, "latitude", lat, errflg, errmsg) + if (errflg .ne. 0) return + status = nf90_close(ncid) + CALL netcdf_err(status, 'closing file: '//trim(fname) , errflg, errmsg) + if (errflg .ne. 0) return ! Convert to radians do i=1,im lon(i) = lon(i) * deg2rad @@ -368,18 +343,12 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, lat(j) = lat(j) * deg2rad enddo else - ! call mpp_error(FATAL,'==> Error in IAU_initialize: Expected file '& - ! //trim(fname)//' for DA increment does not exist') - errmsg = 'FATAL Error in IAU_initialize: Expected file '// trim(fname)//' for DA increment does not exist' + errmsg = 'FATAL Error in Land_IAU_initialize: Expected file '// trim(fname)//' for DA increment does not exist' errflg = 1 return endif ! Initialize lat-lon to Cubed bi-linear interpolation coeff: -! populate agrid -! print*,'is,ie,js,je=',is,ie,js,ie -! print*,'size xlon=',size(Init_parm%xlon(:,1)),size(Init_parm%xlon(1,:)) -! print*,'size agrid=',size(agrid(:,1,1)),size(agrid(1,:,1)),size(agrid(1,1,:)) do j = 1,size(Init_parm_xlon,2) do i = 1,size(Init_parm_xlon,1) ! print*,i,j,is-1+j,js-1+j @@ -394,22 +363,18 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, if (allocated(Init_parm_xlon)) deallocate(Init_parm_xlon) if (allocated(Init_parm_xlat)) deallocate(Init_parm_xlat) - allocate(LND_IAU_Data%stc_inc(is:ie, js:je, km)) - allocate(LND_IAU_Data%slc_inc(is:ie, js:je, km)) - allocate(LND_IAU_Data%tmp2m_inc(is:ie, js:je, 1)) - allocate(LND_IAU_Data%spfh2m_inc(is:ie, js:je, 1)) + allocate(Land_IAU_Data%stc_inc(is:ie, js:je, km)) + allocate(Land_IAU_Data%slc_inc(is:ie, js:je, km)) ! allocate arrays that will hold iau state - allocate (iau_state%inc1%stc_inc(is:ie, js:je, km)) - allocate (iau_state%inc1%slc_inc(is:ie, js:je, km)) - allocate (iau_state%inc1%tmp2m_inc(is:ie, js:je, 1)) - allocate (iau_state%inc1%spfh2m_inc (is:ie, js:je, 1)) - iau_state%hr1=LND_IAU_Control%iaufhrs(1) - iau_state%wt = 1.0 ! IAU increment filter weights (default 1.0) - iau_state%wt_normfact = 1.0 - if (LND_IAU_Control%iau_filter_increments) then + allocate (Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) + allocate (Land_IAU_state%inc1%slc_inc(is:ie, js:je, km)) + Land_IAU_state%hr1=Land_IAU_Control%iaufhrs(1) + Land_IAU_state%wt = 1.0 ! IAU increment filter weights (default 1.0) + Land_IAU_state%wt_normfact = 1.0 + if (Land_IAU_Control%iau_filter_increments) then ! compute increment filter weights, sum to obtain normalization factor - dtp=LND_IAU_Control%dtp - nstep = 0.5*LND_IAU_Control%iau_delthrs*3600/dtp + dtp=Land_IAU_Control%dtp + nstep = 0.5*Land_IAU_Control%iau_delthrs*3600/dtp ! compute normalization factor for filter weights normfact = 0. do k=1,2*nstep+1 @@ -422,12 +387,11 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, wt = 1.0 endif normfact = normfact + wt - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'filter wts',k,kstep,wt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'filter wts',k,kstep,wt enddo - iau_state%wt_normfact = (2*nstep+1)/normfact + Land_IAU_state%wt_normfact = (2*nstep+1)/normfact endif -!3.22.24 Mike B wants to read all increments files at iau init time ! Find bounding latitudes: jbeg = jm-1 jend = 2 @@ -438,107 +402,88 @@ subroutine lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, jend = max(jend, j1+1) enddo enddo - - ! call read_iau_forcing(LND_IAU_Control,iau_state%inc1,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(1)), errmsg, errflg) + + ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid allocate (wk3_stc(nfiles, 1:im,jbeg:jend, 1:km)) - allocate (wk3_slc(nfiles, 1:im,jbeg:jend, 1:km)) - allocate (wk3_t2m(nfiles, 1:im,jbeg:jend, 1:1)) - allocate (wk3_q2m(nfiles, 1:im,jbeg:jend, 1:1)) + allocate (wk3_slc(nfiles, 1:im,jbeg:jend, 1:km)) do k=1, nfiles - call read_iau_forcing_all_timesteps(LND_IAU_Control, 'INPUT/'//trim(LND_IAU_Control%iau_inc_files(k)), errmsg, errflg, & - wk3_stc(k, :, :, :), wk3_slc(k, :, :, :), wk3_t2m(k, :, :, :), wk3_q2m(k, :, :, :)) + call read_iau_forcing_all_timesteps(Land_IAU_Control, & + 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(k)), errmsg, errflg, & + wk3_stc(k, :, :, :), wk3_slc(k, :, :, :)) enddo - ! call interp_inc(LND_IAU_Control, 'soilt1_inc',increments%stc_inc(:,:,1),jbeg,jend) - ! call interp_inc(LND_IAU_Control, 'tmp2m_inc',increments%tmp2m_inc(:,:,1),jbeg,jend) - call interp_inc_at_timestep(LND_IAU_Control, km, wk3_stc(1, :, :, :), iau_state%inc1%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(LND_IAU_Control, km, wk3_slc(1, :, :, :), iau_state%inc1%slc_inc, errmsg, errflg) - call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_t2m(1, :, :, :), iau_state%inc1%tmp2m_inc, errmsg, errflg) - call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_q2m(1, :, :, :), iau_state%inc1%spfh2m_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(1, :, :, :), Land_IAU_state%inc1%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(1, :, :, :), Land_IAU_state%inc1%slc_inc, errmsg, errflg) if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window - call setiauforcing(LND_IAU_Control, LND_IAU_Data, iau_state%wt) + call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%wt) endif - if (nfiles.GT.1) then !have multiple files, but only read in 2 at a time and interpoalte between them - allocate (iau_state%inc2%stc_inc(is:ie, js:je, km)) - allocate (iau_state%inc2%slc_inc(is:ie, js:je, km)) - allocate (iau_state%inc2%tmp2m_inc(is:ie, js:je, 1)) - allocate (iau_state%inc2%spfh2m_inc(is:ie, js:je, 1)) - iau_state%hr2=LND_IAU_Control%iaufhrs(2) - - ! call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(2)), errmsg, errflg) - call interp_inc_at_timestep(LND_IAU_Control, km, wk3_stc(2, :, :, :), iau_state%inc2%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(LND_IAU_Control, km, wk3_slc(2, :, :, :), iau_state%inc2%slc_inc, errmsg, errflg) - call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_t2m(2, :, :, :), iau_state%inc2%tmp2m_inc, errmsg, errflg) - call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_q2m(2, :, :, :), iau_state%inc2%spfh2m_inc, errmsg, errflg) + if (nfiles.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them + allocate (Land_IAU_state%inc2%stc_inc(is:ie, js:je, km)) + allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) + Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(2, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(2, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) endif ! print*,'end of IAU init',dt,rdt -end subroutine lnd_iau_mod_init +end subroutine land_iau_mod_init -subroutine lnd_iau_mod_finalize(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) +subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) implicit none - type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control - type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data + type (land_iau_control_type), intent(in) :: Land_IAU_Control + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg if (allocated (wk3_stc)) deallocate (wk3_stc) if (allocated (wk3_slc)) deallocate (wk3_slc) - if (allocated (wk3_t2m)) deallocate (wk3_t2m) - if (allocated (wk3_q2m)) deallocate (wk3_q2m) - if (allocated(LND_IAU_Data%stc_inc)) deallocate (LND_IAU_Data%stc_inc) - if (allocated(LND_IAU_Data%slc_inc)) deallocate (LND_IAU_Data%slc_inc) - if (allocated(LND_IAU_Data%tmp2m_inc)) deallocate (LND_IAU_Data%tmp2m_inc) - if (allocated(LND_IAU_Data%spfh2m_inc)) deallocate (LND_IAU_Data%spfh2m_inc) + if (allocated(Land_IAU_Data%stc_inc)) deallocate (Land_IAU_Data%stc_inc) + if (allocated(Land_IAU_Data%slc_inc)) deallocate (Land_IAU_Data%slc_inc) - if (allocated(iau_state%inc1%stc_inc)) deallocate(iau_state%inc1%stc_inc) - if (allocated(iau_state%inc1%slc_inc)) deallocate(iau_state%inc1%slc_inc) - if (allocated(iau_state%inc1%tmp2m_inc)) deallocate(iau_state%inc1%tmp2m_inc) - if (allocated(iau_state%inc1%spfh2m_inc)) deallocate(iau_state%inc1%spfh2m_inc) + if (allocated(Land_IAU_state%inc1%stc_inc)) deallocate(Land_IAU_state%inc1%stc_inc) + if (allocated(Land_IAU_state%inc1%slc_inc)) deallocate(Land_IAU_state%inc1%slc_inc) - if (allocated(iau_state%inc2%stc_inc)) deallocate(iau_state%inc2%stc_inc) - if (allocated(iau_state%inc2%slc_inc)) deallocate(iau_state%inc2%slc_inc) - if (allocated(iau_state%inc2%tmp2m_inc)) deallocate(iau_state%inc2%tmp2m_inc) - if (allocated(iau_state%inc2%spfh2m_inc)) deallocate(iau_state%inc2%spfh2m_inc) + if (allocated(Land_IAU_state%inc2%stc_inc)) deallocate(Land_IAU_state%inc2%stc_inc) + if (allocated(Land_IAU_state%inc2%slc_inc)) deallocate(Land_IAU_state%inc2%slc_inc) -end subroutine lnd_iau_mod_finalize +end subroutine land_iau_mod_finalize - subroutine lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) + subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) implicit none - type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control - type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data + type (land_iau_control_type), intent(in) :: Land_IAU_Control + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg real(kind=kind_phys) t1,t2,sx,wx,wt,dtp - integer n,i,j,k,sphum,kstep,nstep,itnext + integer n,i,j,k,kstep,nstep,itnext - LND_IAU_Data%in_interval=.false. + Land_IAU_Data%in_interval=.false. if (nfiles.LE.0) then return endif if (nfiles .eq. 1) then - t1 = LND_IAU_Control%iaufhrs(1)-0.5*LND_IAU_Control%iau_delthrs - t2 = LND_IAU_Control%iaufhrs(1)+0.5*LND_IAU_Control%iau_delthrs + t1 = Land_IAU_Control%iaufhrs(1)-0.5*Land_IAU_Control%iau_delthrs + t2 = Land_IAU_Control%iaufhrs(1)+0.5*Land_IAU_Control%iau_delthrs else - t1 = LND_IAU_Control%iaufhrs(1) - t2 = LND_IAU_Control%iaufhrs(nfiles) + t1 = Land_IAU_Control%iaufhrs(1) + t2 = Land_IAU_Control%iaufhrs(nfiles) endif - if (LND_IAU_Control%iau_filter_increments) then + if (Land_IAU_Control%iau_filter_increments) then ! compute increment filter weight ! t1 is beginning of window, t2 end of window - ! LND_IAU_Control%fhour current time + ! Land_IAU_Control%fhour current time ! in window kstep=-nstep,nstep (2*nstep+1 total) - ! time step LND_IAU_Control%dtp - dtp=LND_IAU_Control%dtp - nstep = 0.5*LND_IAU_Control%iau_delthrs*3600/dtp + ! time step Land_IAU_Control%dtp + dtp=Land_IAU_Control%dtp + nstep = 0.5*Land_IAU_Control%iau_delthrs*3600/dtp ! compute normalized filter weight - kstep = ((LND_IAU_Control%fhour-t1) - 0.5*LND_IAU_Control%iau_delthrs)*3600./dtp - if (LND_IAU_Control%fhour >= t1 .and. LND_IAU_Control%fhour < t2) then + kstep = ((Land_IAU_Control%fhour-t1) - 0.5*Land_IAU_Control%iau_delthrs)*3600./dtp + if (Land_IAU_Control%fhour >= t1 .and. Land_IAU_Control%fhour < t2) then sx = acos(-1.)*kstep/nstep wx = acos(-1.)*kstep/(nstep+1) if (kstep .ne. 0) then @@ -546,131 +491,120 @@ subroutine lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errf else wt = 1. endif - iau_state%wt = iau_state%wt_normfact*wt - !if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'kstep,t1,t,t2,filter wt=',kstep,t1,LND_IAU_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact + Land_IAU_state%wt = Land_IAU_state%wt_normfact*wt + !if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'kstep,t1,t,t2,filter wt=',kstep,t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact else - iau_state%wt = 0. + Land_IAU_state%wt = 0. endif endif if (nfiles.EQ.1) then -! on check to see if we are in the IAU window, no need to update the -! tendencies since they are fixed over the window - if ( LND_IAU_Control%fhour < t1 .or. LND_IAU_Control%fhour >= t2 ) then -! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'no iau forcing',t1,LND_IAU_Control%fhour,t2 - LND_IAU_Data%in_interval=.false. + ! check to see if we are in the IAU window, + ! no need to update the states since they are fixed over the window + if ( Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2 ) then +! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',t1,Land_IAU_Control%fhour,t2 + Land_IAU_Data%in_interval=.false. else - if (LND_IAU_Control%iau_filter_increments) call setiauforcing(LND_IAU_Control,LND_IAU_Data,iau_state%wt) - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt= ',t1,LND_IAU_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact - LND_IAU_Data%in_interval=.true. + if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control,Land_IAU_Data,Land_IAU_state%wt) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact + Land_IAU_Data%in_interval=.true. endif return endif if (nfiles > 1) then itnext=2 - if (LND_IAU_Control%fhour < t1 .or. LND_IAU_Control%fhour >= t2) then -! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'no iau forcing',LND_IAU_Control%iaufhrs(1),LND_IAU_Control%fhour,LND_IAU_Control%iaufhrs(nfiles) - LND_IAU_Data%in_interval=.false. + if (Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2) then +! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',Land_IAU_Control%iaufhrs(1),Land_IAU_Control%fhour,Land_IAU_Control%iaufhrs(nfiles) + Land_IAU_Data%in_interval=.false. else - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt= ',t1,LND_IAU_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact - LND_IAU_Data%in_interval=.true. + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact + Land_IAU_Data%in_interval=.true. do k=nfiles, 1, -1 - if (LND_IAU_Control%iaufhrs(k) > LND_IAU_Control%fhour) then + if (Land_IAU_Control%iaufhrs(k) > Land_IAU_Control%fhour) then itnext=k endif enddo -! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'itnext=',itnext - if (LND_IAU_Control%fhour >= iau_state%hr2) then ! need to read in next increment file - iau_state%hr1=iau_state%hr2 - iau_state%hr2=LND_IAU_Control%iaufhrs(itnext) - iau_state%inc1=iau_state%inc2 +! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'itnext=',itnext + if (Land_IAU_Control%fhour >= Land_IAU_state%hr2) then ! need to read in next increment file + Land_IAU_state%hr1=Land_IAU_state%hr2 + Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(itnext) + Land_IAU_state%inc1=Land_IAU_state%inc2 - ! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'reading next lnd iau increment file',trim(LND_IAU_Control%iau_inc_files(itnext)) - ! call read_iau_forcing(LND_IAU_Control,iau_state%inc2,'INPUT/'//trim(LND_IAU_Control%iau_inc_files(itnext)), errmsg, errflg) - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'interpolating next lnd iau increment ', itnext !trim(LND_IAU_Control%iau_inc_files(itnext)) - call interp_inc_at_timestep(LND_IAU_Control, km, wk3_stc(itnext, :, :, :), iau_state%inc2%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(LND_IAU_Control, km, wk3_slc(itnext, :, :, :), iau_state%inc2%slc_inc, errmsg, errflg) - call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_t2m(itnext, :, :, :), iau_state%inc2%tmp2m_inc, errmsg, errflg) - call interp_inc_at_timestep(LND_IAU_Control, 1, wk3_q2m(itnext, :, :, :), iau_state%inc2%spfh2m_inc, errmsg, errflg) + ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'reading next lnd iau increment file',trim(Land_IAU_Control%iau_inc_files(itnext)) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'interpolating next lnd iau increment ', itnext !trim(Land_IAU_Control%iau_inc_files(itnext)) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(itnext, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(itnext, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, 1, wk3_t2m(itnext, :, :, :), Land_IAU_state%inc2%tmp2m_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, 1, wk3_q2m(itnext, :, :, :), Land_IAU_state%inc2%spfh2m_inc, errmsg, errflg) endif - call updateiauforcing(LND_IAU_Control,LND_IAU_Data,iau_state%wt) + call updateiauforcing(Land_IAU_Control,Land_IAU_Data,Land_IAU_state%wt) endif endif - ! sphum=get_tracer_index(MODEL_ATMOS,'sphum') - end subroutine lnd_iau_mod_getiauforcing + end subroutine land_iau_mod_getiauforcing -subroutine updateiauforcing(LND_IAU_Control, LND_IAU_Data, wt) +subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, wt) implicit none - type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control - type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data - real(kind_phys) delt, wt + type (land_iau_control_type), intent(in) :: Land_IAU_Control + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data + real(kind=kind_phys) delt, wt integer i,j,k,l -! if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'in updateiauforcing',nfiles,LND_IAU_Control%iaufhrs(1:nfiles) - delt = (iau_state%hr2-(LND_IAU_Control%fhour))/(IAU_state%hr2-IAU_state%hr1) +! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in updateiauforcing',nfiles,Land_IAU_Control%iaufhrs(1:nfiles) + delt = (Land_IAU_state%hr2-(Land_IAU_Control%fhour))/(Land_IAU_state%hr2-Land_IAU_state%hr1) do j = js,je do i = is,ie - do k = 1,npz - ! do k = 1,n_soill ! - LND_IAU_Data%stc_inc(i,j,k) =(delt*IAU_state%inc1%stc_inc(i,j,k) + (1.-delt)* IAU_state%inc2%stc_inc(i,j,k))*rdt*wt - LND_IAU_Data%slc_inc(i,j,k) =(delt*IAU_state%inc1%slc_inc(i,j,k) + (1.-delt)* IAU_state%inc2%slc_inc(i,j,k))*rdt*wt + do k = 1,npz ! do k = 1,n_soill ! + Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_state%inc1%stc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%stc_inc(i,j,k))*rdt*wt + Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_state%inc1%slc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%slc_inc(i,j,k))*rdt*wt end do - LND_IAU_Data%tmp2m_inc(i,j,1) =(delt*IAU_state%inc1%tmp2m_inc(i,j,1) + (1.-delt)* IAU_state%inc2%tmp2m_inc(i,j,1))*rdt*wt - LND_IAU_Data%spfh2m_inc(i,j,1) =(delt*IAU_state%inc1%spfh2m_inc(i,j,1) + (1.-delt)* IAU_state%inc2%spfh2m_inc(i,j,1))*rdt*wt + Land_IAU_Data%tmp2m_inc(i,j,1) =(delt*Land_IAU_state%inc1%tmp2m_inc(i,j,1) + (1.-delt)* Land_IAU_state%inc2%tmp2m_inc(i,j,1))*rdt*wt + Land_IAU_Data%spfh2m_inc(i,j,1) =(delt*Land_IAU_state%inc1%spfh2m_inc(i,j,1) + (1.-delt)* Land_IAU_state%inc2%spfh2m_inc(i,j,1))*rdt*wt enddo enddo end subroutine updateiauforcing - subroutine setiauforcing(LND_IAU_Control, LND_IAU_Data, wt) + subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, wt) implicit none - type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control - type(lnd_iau_external_data_type), intent(inout) :: LND_IAU_Data - real(kind_phys) delt, dt,wt - integer i,j,k,l,sphum + type (land_iau_control_type), intent(in) :: Land_IAU_Control + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data + real(kind=kind_phys) delt, dt,wt + integer i,j,k,l ! this is only called if using 1 increment file - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'in lnd_iau setiauforcing rdt = ',rdt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau setiauforcing rdt = ',rdt do j = js,je do i = is,ie - do k = 1,npz - ! do k = 1,n_soill ! - LND_IAU_Data%stc_inc(i,j,k) = wt*IAU_state%inc1%stc_inc(i,j,k)*rdt - LND_IAU_Data%slc_inc(i,j,k) = wt*IAU_state%inc1%slc_inc(i,j,k)*rdt + do k = 1,npz ! do k = 1,n_soill ! + Land_IAU_Data%stc_inc(i,j,k) = wt*Land_IAU_state%inc1%stc_inc(i,j,k)*rdt + Land_IAU_Data%slc_inc(i,j,k) = wt*Land_IAU_state%inc1%slc_inc(i,j,k)*rdt end do - LND_IAU_Data%tmp2m_inc(i,j,1) = wt*IAU_state%inc1%tmp2m_inc(i,j,1)*rdt - LND_IAU_Data%spfh2m_inc(i,j,1) = wt*IAU_state%inc1%spfh2m_inc(i,j,1)*rdt + Land_IAU_Data%tmp2m_inc(i,j,1) = wt*Land_IAU_state%inc1%tmp2m_inc(i,j,1)*rdt + Land_IAU_Data%spfh2m_inc(i,j,1) = wt*Land_IAU_state%inc1%spfh2m_inc(i,j,1)*rdt enddo enddo - ! sphum=get_tracer_index(MODEL_ATMOS,'sphum') end subroutine setiauforcing -subroutine read_iau_forcing_all_timesteps(LND_IAU_Control, fname, errmsg, errflg, & - wk3_out_stc, wk3_out_slc, wk3_out_t2m, wk3_out_q2m) !, fname_sfc) is, ie, js, je, ks,ke, - type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control +subroutine read_iau_forcing_all_timesteps(Land_IAU_Control, fname, errmsg, errflg, & + wk3_out_stc, wk3_out_slc) !, fname_sfc) is, ie, js, je, ks,ke, + type (land_iau_control_type), intent(in) :: Land_IAU_Control character(len=*), intent(in) :: fname character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! integer, intent(in) :: is, ie, js, je, ks,ke - ! real(kind=4), intent(out) :: wk3_out(is:ie,js:je,ks:ke) - real(kind=4), intent(out) :: wk3_out_stc(1:im, jbeg:jend, 1:km) - real(kind=4), intent(out) :: wk3_out_slc(1:im, jbeg:jend, 1:km) - real(kind=4), intent(out) :: wk3_out_t2m(1:im, jbeg:jend, 1:1) - real(kind=4), intent(out) :: wk3_out_q2m(1:im, jbeg:jend, 1:1) + real(kind=kind_phys), intent(out) :: wk3_out_stc(1:im, jbeg:jend, 1:km) + real(kind=kind_phys), intent(out) :: wk3_out_slc(1:im, jbeg:jend, 1:km) integer :: i, j, k, l, npz integer :: i1, i2, j1 logical :: exists - integer :: ncid + integer :: ncid, status, varid integer :: ierr character(len=32), dimension(4) :: stc_vars = [character(len=32) :: 'soilt1_inc', 'soilt2_inc', 'soilt3_inc', 'soilt4_inc'] character(len=32), dimension(4) :: slc_vars = [character(len=32) :: 'slc1_inc', 'slc2_inc', 'slc3_inc', 'slc4_inc'] - character(len=32) :: t2m_vars = 'tmp2m_inc' - character(len=32) :: q2m_vars = 'spfh2m_inc' !Errors messages handled through CCPP error handling variables errmsg = '' @@ -678,69 +612,56 @@ subroutine read_iau_forcing_all_timesteps(LND_IAU_Control, fname, errmsg, errflg inquire (file=trim(fname), exist=exists) if (exists) then -! if( file_exist(fname) ) then - call open_ncfile( fname, ncid ) ! open the file + status = nf90_open(trim(fname), NF90_NOWRITE, ncid) ! open the file + call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) + if (errflg .ne. 0) return else - ! call mpp_error(FATAL,'==> Error in read_iau_forcing: Expected file '& - ! //trim(fname)//' for DA increment does not exist') - errmsg = 'FATAL Error in read_iau_forcing: Expected file '//trim(fname)//' for DA increment does not exist' + errmsg = 'FATAL Error in land read_iau_forcing_all_timesteps: Expected file '//trim(fname)//' for DA increment does not exist' errflg = 1 return endif do i = 1, size(stc_vars) print *, trim(stc_vars(i)) - call check_var_exists(ncid, trim(stc_vars(i)), ierr) - if (ierr == 0) then - ! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) - call get_var3_r4( ncid, trim(stc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_stc(:, :, i) ) + ! call check_var_exists(ncid, trim(stc_vars(i)), ierr) + status = nf90_inq_varid(ncid, trim(stc_vars(i)), varid) + if (status == nf90_noerr) then !if (ierr == 0) then + call get_var3d_values(ncid, varid, 1,im, jbeg,jend, 1,1, wk3_out_stc(:, :, i), status) + call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg_out) + if (errflg .ne. 0) return else - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(stc_vars(i)),' found, assuming zero' + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, & + 'warning: no increment for ',trim(stc_vars(i)),' found, assuming zero' wk3_out_stc(:, :, i) = 0. endif enddo do i = 1, size(slc_vars) print *, trim(slc_vars(i)) - call check_var_exists(ncid, trim(slc_vars(i)), ierr) - if (ierr == 0) then - ! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) - call get_var3_r4( ncid, trim(slc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i) ) + status = nf90_inq_varid(ncid, trim(slc_vars(i)), varid) + if (status == nf90_noerr) then !if (ierr == 0) then + ! call get_var3_r4( ncid, trim(slc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i) ) + call get_var3d_values(ncid, varid, 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i), status) + call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg_out) + if (errflg .ne. 0) return else - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(slc_vars(i)),' found, assuming zero' + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,& + 'warning: no increment for ',trim(slc_vars(i)),' found, assuming zero' wk3_out_slc(:, :, i) = 0. endif enddo - print *, trim(t2m_vars) - call check_var_exists(ncid, trim(t2m_vars), ierr) - if (ierr == 0) then - ! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) - call get_var3_r4( ncid, trim(t2m_vars), 1,im, jbeg,jend, 1,1, wk3_out_t2m(:, :, :) ) - else - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(t2m_vars),' found, assuming zero' - wk3_out_t2m(:, :, :) = 0. - endif - print *, trim(q2m_vars) - call check_var_exists(ncid, trim(q2m_vars), ierr) - if (ierr == 0) then - ! call get_var3_r4( ncid, field_name, 1,im, jbeg,jend, 1,km, wk3 ) - call get_var3_r4( ncid, trim(q2m_vars), 1,im, jbeg,jend, 1,1, wk3_out_q2m(:, :, :) ) - else - if (LND_IAU_Control%me == LND_IAU_Control%mpi_root) print *,'warning: no increment for ',trim(q2m_vars),' found, assuming zero' - wk3_out_q2m(:, :, :) = 0. - endif call close_ncfile(ncid) end subroutine read_iau_forcing_all_timesteps -subroutine interp_inc_at_timestep(LND_IAU_Control, km_in, wk3_in, var, errmsg, errflg) !field_name, , jbeg, jend) +subroutine interp_inc_at_timestep(Land_IAU_Control, km_in, wk3_in, var, errmsg, errflg) !field_name, , jbeg, jend) ! interpolate increment from GSI gaussian grid to cubed sphere ! everying is on the A-grid, earth relative - type (LND_IAU_Control_type), intent(in) :: LND_IAU_Control + type (land_iau_control_type), intent(in) :: Land_IAU_Control ! character(len=*), intent(in) :: field_name integer, intent(in) :: km_in !jbeg,jend - real(kind=4), intent(in) :: wk3_in(1:im,jbeg:jend, 1:km_in) - real, dimension(is:ie, js:je, 1:km), intent(inout) :: var + real(kind=kind_phys), intent(in) :: wk3_in(1:im,jbeg:jend, 1:km_in) + real(kind=kind_phys), dimension(is:ie, js:je, 1:km), intent(inout) :: var character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -769,14 +690,14 @@ subroutine remap_coef( is, ie, js, je, isd, ied, jsd, jed, & integer, intent(in):: is, ie, js, je, isd, ied, jsd, jed integer, intent(in):: im, jm - real(kind=kind_dyn), intent(in):: lon(im), lat(jm) - real, intent(out):: s2c(is:ie,js:je,4) + real(kind=kind_phys), intent(in):: lon(im), lat(jm) + real(kind=kind_phys), intent(out):: s2c(is:ie,js:je,4) integer, intent(out), dimension(is:ie,js:je):: id1, id2, jdc - real(kind=kind_dyn), intent(in):: agrid(isd:ied,jsd:jed,2) + real(kind=kind_phys), intent(in):: agrid(isd:ied,jsd:jed,2) ! local: - real :: rdlon(im) - real :: rdlat(jm) - real:: a1, b1 + real(kind=kind_phys) :: rdlon(im) + real(kind=kind_phys) :: rdlat(jm) + real(kind=kind_phys):: a1, b1 integer i,j, i1, i2, jc, i0, j0 do i=1,im-1 rdlon(i) = 1. / (lon(i+1) - lon(i)) @@ -841,7 +762,100 @@ subroutine remap_coef( is, ie, js, je, isd, ied, jsd, jed, & 5000 continue ! j-loop end subroutine remap_coef + + SUBROUTINE NETCDF_ERR(ERR, STRING, errflg, errmsg_out) + + !-------------------------------------------------------------- + ! IF AT NETCDF CALL RETURNS AN ERROR, PRINT OUT A MESSAGE + ! AND STOP PROCESSING. + !-------------------------------------------------------------- + IMPLICIT NONE + + include 'mpif.h' + + INTEGER, INTENT(IN) :: ERR + CHARACTER(LEN=*), INTENT(IN) :: STRING + CHARACTER(LEN=80) :: ERRMSG + integer :: errflg + character(len=*) :: errmsg_out + + !Errors messages handled through CCPP error handling variables + errmsg_out = '' + errflg = 0 + + IF (ERR == NF90_NOERR) RETURN + ERRMSG = NF90_STRERROR(ERR) + PRINT*,'FATAL ERROR in Land IAU ', TRIM(STRING), ': ', TRIM(ERRMSG) + errmsg_out = 'FATAL ERROR in Land IAU ', TRIM(STRING), ': ', TRIM(ERRMSG) + ! CALL MPI_ABORT(MPI_COMM_WORLD, 999) + errflg = 1 + return + + END SUBROUTINE NETCDF_ERR + + subroutine get_nc_dimlen(ncid, dim_name, dim_len, errflg, errmsg_out ) + integer, intent(in):: ncid + character(len=*), intent(in):: dim_name + integer, intent(out):: dim_len + integer :: dimid + integer :: errflg + character(len=*) :: errmsg_out + + !Errors messages handled through CCPP error handling variables + errmsg_out = '' + errflg = 0 + + status = nf90_inq_dimid(ncid, dim_name, dimid) + CALL netcdf_err(status, 'reading dim id '//trim(dim_name), errflg, errmsg_out) + if (errflg .ne. 0) return + status = nf90_inquire_dimension(ncid, dimid, len = dim_len) + CALL netcdf_err(status, 'reading dim length '//trim(dim_name), errflg, errmsg_out) + + end subroutine get_nc_dimlen + ! status = nf90_inq_dimid(ncid, "longitude", dimid) + ! CALL netcdf_err(status, 'reading longitude dim id') + ! status = nf90_inquire_dimension(ncid, dimid, len = im) + ! CALL netcdf_err(status, 'reading dim longitude') + ! status = nf90_inq_dimid(ncid, "latitude", dimid) + ! CALL netcdf_err(status, 'reading latitude dim id') + ! status = nf90_inquire_dimension(ncid, dimid, len = jm) + ! CALL netcdf_err(status, 'reading dim latitude') + subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) + integer, intent(in):: ncid, dim_len + character(len=*), intent(in):: var_name + real(kind=kind_phys), intent(out):: var_arr(dim_len) + integer :: errflg + character(len=*) :: errmsg_out + integer :: var_id + + !Errors messages handled through CCPP error handling variables + errmsg_out = '' + errflg = 0 + + status = nf90_inq_varid(ncid, trim(var_name), varid) + CALL NETCDF_ERR(status, 'getting varid: '//trim(var_name), errflg, errmsg_out) + if (errflg .ne. 0) return + status = nf90_get_var(ncid, varid, var_arr) + CALL NETCDF_ERR(status, 'reading var: '//trim(var_name), errflg, errmsg_out) + + end subroutine get_var1d + + subroutine get_var3d_values(ncid, varid, is,ie, js,je, ks,ke, var3d, status) + integer, intent(in):: ncid, varid + integer, intent(in):: is, ie, js, je, ks,ke + real(kind=kind_phys), intent(out):: var3d(is:ie,js:je,ks:ke) + integer, intent(out):: status + ! integer, dimension(3):: start, nreco + ! start(1) = is; start(2) = js; start(3) = ks + ! nreco(1) = ie - is + 1 + ! nreco(2) = je - js + 1 + ! nreco(3) = ke - ks + 1 + + status = nf90_get_var(ncid, varid, var3d, & !start = start, count = nreco) + start = (/is, js, ks/), count = (/ie - is + 1, je - js + 1, ke - ks + 1/)) + + end subroutine get_var3d_values -end module lnd_iau_mod +end module land_iau_mod diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index d583a7ffa..ab3faf9d2 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -13,10 +13,10 @@ module noahmpdrv use module_sf_noahmplsm - ! 3.5.24 for use in IAU - use lnd_iau_mod, only: lnd_iau_control_type, lnd_iau_external_data_type, & - lnd_iau_mod_set_control, lnd_iau_mod_init, lnd_iau_mod_getiauforcing, & - lnd_iau_mod_finalize + ! Land IAU increments for soil temperature (can also do soil moisture increments if needed) + use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & + land_iau_mod_set_control, land_iau_mod_init, + land_iau_mod_getiauforcing, land_iau_mod_finalize implicit none @@ -27,9 +27,14 @@ module noahmpdrv public :: noahmpdrv_init, noahmpdrv_run, & noahmpdrv_timestep_init, noahmpdrv_timestep_finalize, noahmpdrv_finalize - ! IAU data and control - type (lnd_iau_control_type) :: LND_IAU_Control - type (lnd_iau_external_data_type) :: LND_IAU_Data !(number of blocks):each proc holds nblks + !> \Land IAU data and control + ! Land IAU Control holds settings' information, maily read from namelist (e.g., + ! block of global domain that belongs to a process , + ! whethrer to do IAU increment at this time step, + ! time step informatoin, etc) + type (land_iau_control_type) :: Land_IAU_Control + ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step + type (land_iau_external_data_type) :: Land_IAU_Data !(number of blocks):each proc holds nblks contains @@ -127,23 +132,18 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & pores (:) = maxsmc (:) resid (:) = drysmc (:) - ! 3.7.24 init iau for land - call lnd_iau_mod_set_control(LND_IAU_Control, fn_nml, input_nml_file, me, mpi_root, isc,jsc, nx, ny, nblks, blksz, & - lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) - ! print*, 'proc errmsg, errflg after set control', me, errmsg, errflg - ! print*, 'proc iau_control isc, nx, dtp fhour', me, LND_IAU_Control%isc, LND_IAU_Control%nx, & - ! LND_IAU_Control%dtp, LND_IAU_Control%fhour - ! print*, 'proc iau_control incfiles(1)', me, LND_IAU_Control%iau_inc_files(1) - - call lnd_iau_mod_init (LND_IAU_Control, LND_IAU_Data, xlon, xlat, errmsg, errflg) - !print*, 'proc errmsg, errflg interval after lnd_iau_init ', me,trim(errmsg), errflg, LND_IAU_Data%in_interval - ! print*, 'proc nblks blksize(1) after set init', me,LND_IAU_Control%nblks, LND_IAU_Control%blksz(1) + ! Read Land IAU settings + call land_iau_mod_set_control(Land_IAU_Control, fn_nml, input_nml_file, & + me, mpi_root, isc,jsc, nx, ny, nblks, blksz, & + lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) + ! Initialize IAU for land + call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errmsg, errflg) end subroutine noahmpdrv_init !> \ingroup NoahMP_LSM !! \brief This subroutine is called before noahmpdrv_run -!! to update states with iau increments +!! to update states with iau increments, if available !! \section arg_table_noahmpdrv_timestep_init Argument Table !! \htmlinclude noahmpdrv_timestep_init.html !! @@ -154,8 +154,6 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo implicit none - ! integer, intent(in) :: me !mpi_rank - ! integer, intent(in) :: mpi_root ! = GFS_Control%master integer , intent(in) :: itime !current forecast iteration real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) real(kind=kind_phys) , intent(in) :: delt ! time interval [s] @@ -168,8 +166,6 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! IAU update real,allocatable :: stc_inc_flat(:,:) ! real,allocatable :: slc_inc_flat(:,:) - ! real,allocatable :: tmp2m_inc_flat(:) - ! real,allocatable :: spfh2m_inc_flat(:) integer :: j, k, ib ! --- end declaration @@ -179,70 +175,59 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo !> update current forecast hour ! GFS_control%jdat(:) = jdat(:) - LND_IAU_Control%fhour=fhour + Land_IAU_Control%fhour=fhour - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",LND_IAU_Control%fhour, & - " delt ",delt," IauCont%dtp",LND_IAU_Control%dtp + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",Land_IAU_Control%fhour, & + " delt ",delt," IauCont%dtp",Land_IAU_Control%dtp endif - !> 3.7.24 read iau increments - call lnd_iau_mod_getiauforcing(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) + !> read iau increments + call land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) if (errflg .ne. 0) then - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" print*, errmsg endif return endif - !> update with iau increments - if (LND_IAU_Data%in_interval) then - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then + !> update land states with iau increments + if (Land_IAU_Data%in_interval) then + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print*, "adding land iau increments " endif - if (LND_IAU_Control%lsoil .ne. km) then - write(errmsg,*) 'noahmpdrv_timestep_init: LND_IAU_Data%lsoil ',LND_IAU_Control%lsoil,' not equal to km ',km + if (Land_IAU_Control%lsoil .ne. km) then + write(errmsg,*) 'noahmpdrv_timestep_init: Land_IAU_Data%lsoil ',Land_IAU_Control%lsoil,' not equal to km ',km errflg = 1 return endif - ! local variable to copy blocked data LND_IAU_Data%stc_inc - allocate(stc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols - ! allocate(slc_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny, km)) !GFS_Control%ncols - ! allocate(tmp2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols - ! allocate(spfh2m_inc_flat(LND_IAU_Control%nx * LND_IAU_Control%ny)) !GFS_Control%ncols + ! local variable to copy blocked data Land_IAU_Data%stc_inc + allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols + ! allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols ib = 1 - do j = 1, LND_IAU_Control%ny !ny + do j = 1, Land_IAU_Control%ny !ny do k = 1, km - stc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) =LND_IAU_Data%stc_inc(:,j, k) - ! slc_inc_flat(ib:ib+LND_IAU_Control%nx-1, k) = LND_IAU_Data%slc_inc(:,j, k) + stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) =Land_IAU_Data%stc_inc(:,j, k) + ! slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) enddo - ! ib = 1 - ! do j = 1, LND_IAU_Control%ny !ny - ! tmp2m_inc_flat(ib:ib+LND_IAU_Control%nx-1) =LND_IAU_Data%tmp2m_inc(:,j, 1) - ! spfh2m_inc_flat(ib:ib+LND_IAU_Control%nx-1)=LND_IAU_Data%spfh2m_inc(:,j, 1) - ib = ib + LND_IAU_Control%nx !nlon + ib = ib + Land_IAU_Control%nx !nlon enddo ! delt=GFS_Control%dtf - if ((LND_IAU_Control%dtp - delt) > 0.0001) then - if(LND_IAU_Control%me == LND_IAU_Control%mpi_root) then - print*, "Warning noahmpdrv_run delt ",delt,"different from LND_IAU_Control%dtp ",LND_IAU_Control%dtp + if ((Land_IAU_Control%dtp - delt) > 0.0001) then + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "Warning noahmpdrv_run delt ",delt,"different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp endif endif - !IAU increments are in units of 1/sec !LND_IAU_Control%dtp -!* only updating soil temp + !IAU increments are in units of 1/sec !Land_IAU_Control%dtp + !* only updating soil temp for now do k = 1, km - stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !LND_IAU_Control%dtp - ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !LND_IAU_Control%dtp + stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !Land_IAU_Control%dtp + ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !Land_IAU_Control%dtp enddo - ! t2mmp = t2mmp + & - ! tmp2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb) + im-1)*delt !LND_IAU_Control%dtp - ! q2mp = q2mp + & - ! spfh2m_inc_flat(LND_IAU_Control%blk_strt_indx(nb):LND_IAU_Control%blk_strt_indx(nb)+ im-1)*delt !LND_IAU_Control%dtp - deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) endif @@ -251,51 +236,41 @@ end subroutine noahmpdrv_timestep_init !> \ingroup NoahMP_LSM !! \brief This subroutine is called after noahmpdrv_run -!! to free up allocated memory +!! to free up allocated memory, if there are any +!! code to do any needed consistency check will go here !! \section arg_table_noahmpdrv_timestep_finalize Argument Table !! \htmlinclude noahmpdrv_timestep_finalize.html !! subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, - use machine, only: kind_phys - + use machine, only: kind_phys implicit none - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - - integer :: j, k, ib - ! --- Initialize CCPP error handling variables errmsg = '' - errflg = 0 - + errflg = 0 + !> note the IAU deallocate happens at the noahmpdrv_finalize end subroutine noahmpdrv_timestep_finalize !> \ingroup NoahMP_LSM !! \brief This subroutine mirrors noahmpdrv_init -!! to free up allocated memory in IAU_init (noahmdrv_init) +!! it calls land_iau_finalize which frees up allocated memory by IAU_init (in noahmdrv_init) !! \section arg_table_noahmpdrv_finalize Argument Table !! \htmlinclude noahmpdrv_finalize.html -!! subroutine noahmpdrv_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, - use machine, only: kind_phys - + use machine, only: kind_phys implicit none - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: j, k, ib - ! --- Initialize CCPP error handling variables errmsg = '' - errflg = 0 - - call lnd_iau_mod_finalize(LND_IAU_Control, LND_IAU_Data, errmsg, errflg) !LND_IAU_Control%finalize() + errflg = 0 + call land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !Land_IAU_Control%finalize() end subroutine noahmpdrv_finalize @@ -323,7 +298,7 @@ end subroutine noahmpdrv_finalize subroutine noahmpdrv_run & !................................... ! --- inputs: - (nb, im, km, lsnowl, itime, fhour, ps, u1, v1, t1, q1, soiltyp,soilcol,& + (im, km, lsnowl, itime, ps, u1, v1, t1, q1, soiltyp,soilcol,& vegtype, sigmaf, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & prsl1, prslk1, prslki, prsik1, zf,pblh, dry, wind, slopetyp,& shdmin, shdmax, snoalb, sfalb, flag_iter,con_g, & @@ -425,12 +400,10 @@ subroutine noahmpdrv_run & ! --- CCPP interface fields (in call order) ! - integer , intent(in) :: nb !=cdata%blk_no, integer , intent(in) :: im ! horiz dimension and num of used pts integer , intent(in) :: km ! vertical soil layer dimension integer , intent(in) :: lsnowl ! lower bound for snow level arrays integer , intent(in) :: itime ! NOT USED current forecast iteration - real(kind=kind_phys) , intent(in) :: fhour ! currentforecast time (hr) real(kind=kind_phys), dimension(:) , intent(in) :: ps ! surface pressure [Pa] real(kind=kind_phys), dimension(:) , intent(in) :: u1 ! u-component of wind [m/s] real(kind=kind_phys), dimension(:) , intent(in) :: v1 ! u-component of wind [m/s] From e535c80eab5a08bc717e80383b2c9c73ef552da6 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 31 May 2024 13:45:20 -0400 Subject: [PATCH 012/141] add soil temp adjustments --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 51 +++- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 279 +++++++++++++----- 2 files changed, 259 insertions(+), 71 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index d25aa3877..9a3fa8e7c 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -80,7 +80,8 @@ module land_iau_mod real(kind=kind_phys) :: iau_delthrs ! iau time interval (to scale increments) in hours character(len=240) :: iau_inc_files(7)! list of increment files real(kind=kind_phys) :: iaufhrs(7) ! forecast hours associated with increment files - logical :: iau_filter_increments + logical :: iau_filter_increments + integer :: lsoil_incr ! soil layers (from top) updated by DA !, iau_drymassfixer integer :: me !< MPI rank designator integer :: mpi_root !< MPI rank of master atmosphere processor @@ -131,8 +132,12 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me character(len=240) :: land_iau_inc_files(7) = '' !< list of increment files real(kind=kind_phys) :: land_iaufhrs(7) = -1 !< forecast hours associated with increment files logical :: land_iau_filter_increments = .false. !< filter IAU increments + + integer :: lsoil_incr = 4 - NAMELIST /lnd_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iaufhrs, land_iau_filter_increments !, lnd_iau_drymassfixer & + NAMELIST /lnd_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iaufhrs, & + land_iau_filter_increments, & !, lnd_iau_drymassfixer + lsoil_incr !Errors messages handled through CCPP error handling variables errmsg = '' @@ -185,6 +190,8 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%iaufhrs = land_iaufhrs Land_IAU_Control%iau_filter_increments = land_iau_filter_increments ! Land_IAU_Control%iau_drymassfixer = lnd_iau_drymassfixer + Land_IAU_Control%lsoil_incr = lsoil_incr + Land_IAU_Control%me = me Land_IAU_Control%mpi_root = mpi_root Land_IAU_Control%isc = isc @@ -763,6 +770,46 @@ subroutine remap_coef( is, ie, js, je, isd, ied, jsd, jed, & end subroutine remap_coef + !> Calculate soil mask for land on model grid. +!! Output is 1 - soil, 2 - snow-covered, 0 - land ice, -1 not land. +!! +!! @param[in] lensfc Number of land points for this tile +!! @param[in] veg_type_landice Value of vegetion class that indicates land-ice +!! @param[in] stype Soil type +!! @param[in] swe Model snow water equivalent +!! @param[in] vtype Model vegetation type +!! @param[out] mask Land mask for increments +!! @author Clara Draper @date March 2021 +!! @author Yuan Xue: introduce stype to make the mask calculation more generic +subroutine calculate_landinc_mask(swe,vtype,stype,lensfc,veg_type_landice,mask) + + implicit none + + integer, intent(in) :: lensfc, veg_type_landice + real, intent(in) :: swe(lensfc) + integer, intent(in) :: vtype(lensfc),stype(lensfc) + integer, intent(out) :: mask(lensfc) + + integer :: i + + mask = -1 ! not land + + ! land (but not land-ice) + do i=1,lensfc + if (stype(i) .GT. 0) then + if (swe(i) .GT. 0.001) then ! snow covered land + mask(i) = 2 + else ! non-snow covered land + mask(i) = 1 + endif + end if ! else should work here too + if ( vtype(i) == veg_type_landice ) then ! land-ice + mask(i) = 0 + endif + end do + +end subroutine calculate_landinc_mask + SUBROUTINE NETCDF_ERR(ERR, STRING, errflg, errmsg_out) !-------------------------------------------------------------- diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index ab3faf9d2..5bae760a6 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -16,7 +16,8 @@ module noahmpdrv ! Land IAU increments for soil temperature (can also do soil moisture increments if needed) use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & land_iau_mod_set_control, land_iau_mod_init, - land_iau_mod_getiauforcing, land_iau_mod_finalize + land_iau_mod_getiauforcing, land_iau_mod_finalize, & + calculate_landinc_mask implicit none @@ -147,92 +148,232 @@ end subroutine noahmpdrv_init !! \section arg_table_noahmpdrv_timestep_init Argument Table !! \htmlinclude noahmpdrv_timestep_init.html !! - subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_root, - stc, slc, errmsg, errflg) ! smc, t2mmp, q2mp, + !! For Noah-MP, the adjustment scheme shown below as of 11/09/2023: +!! Case 1: frozen ==> frozen, recalculate slc following opt_frz=1, smc remains +!! Case 2: unfrozen ==> frozen, recalculate slc following opt_frz=1, smc remains +!! Case 3: frozen ==> unfrozen, melt all soil ice (if any) +!! Case 4: unfrozen ==> unfrozen along with other cases, (e.g., soil temp=tfrz),do nothing +!! Note: For Case 3, Yuan Xue thoroughly evaluated a total of four options and +!! current option is found to be the best as of 11/09/2023 + +!! @param[in] isot Integer code for the soil type data set +!! @param[in] ivegsrc Integer code for the vegetation type data set +!! @param[in] lensfc Number of land points for this tile + +!! @param[in] lsoil_incr Number of soil layers (from top) to apply soil increments to + +!! @param[inout] smc_adj Analysis soil moisture states +!! @param[inout] slc_adj Analysis liquid soil moisture states +!! @param[in] stc_updated Integer to record whether STC in each grid cell was updated + +subroutine noahmpdrv_timestep_init (isot, ivegsrc, itime, fhour, delt, km, & !me, mpi_root, + soiltyp, vegtype, weasd, & + stc, slc, smc, errmsg, errflg) ! smc, t2mmp, q2mp, - use machine, only: kind_phys - - implicit none + use machine, only: kind_phys + use namelist_soilveg + ! use set_soilveg_snippet_mod, only: set_soilveg_noahmp + use noahmp_tables - integer , intent(in) :: itime !current forecast iteration - real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) - real(kind=kind_phys) , intent(in) :: delt ! time interval [s] - integer , intent(in) :: km !vertical soil layer dimension - real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] - real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + implicit none - ! IAU update - real,allocatable :: stc_inc_flat(:,:) - ! real,allocatable :: slc_inc_flat(:,:) - integer :: j, k, ib - ! --- end declaration + ! for soil temp/moisture consistency adjustment after DA update + integer, intent(in) :: isot, ivegsrc - ! --- Initialize CCPP error handling variables - errmsg = '' - errflg = 0 + integer , intent(in) :: itime !current forecast iteration + real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) + real(kind=kind_phys) , intent(in) :: delt ! time interval [s] + integer , intent(in) :: km !vertical soil layer dimension - !> update current forecast hour - ! GFS_control%jdat(:) = jdat(:) - Land_IAU_Control%fhour=fhour + integer , dimension(:) , intent(in) :: soiltyp ! soil type (integer index) + integer , dimension(:) , intent(in) :: vegtype ! vegetation type (integer index) + real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] + + real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] + real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' + real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! IAU update + real,allocatable :: stc_inc_flat(:,:) + ! real,allocatable :: slc_inc_flat(:,:) + integer :: lsoil_incr + ! integer :: veg_type_landice + + integer, allocatable :: mask_tile(:) + integer,allocatable :: stc_updated(:) + logical :: soil_freeze, soil_ice + integer :: n_freeze, n_thaw + integer :: soiltype, n_stc + real :: slc_new + + integer :: i, l, jj, k, ib + integer :: lensfc + + real (kind=kind_phys), dimension(max_soiltyp) :: maxsmc, bb, satpsi + ! real, dimension(30) :: maxsmc, bb, satpsi + real, parameter :: tfreez=273.16 !< con_t0c in physcons + real, parameter :: hfus=0.3336e06 !< latent heat of fusion(j/kg) + real, parameter :: grav=9.80616 !< gravity accel.(m/s2) + real :: smp !< for computing supercooled water + + integer :: nother, nsnowupd + integer :: nstcupd, nfrozen, nfrozen_upd + ! --- Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + !> update current forecast hour + ! GFS_control%jdat(:) = jdat(:) + Land_IAU_Control%fhour=fhour + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",Land_IAU_Control%fhour, & + " delt ",delt," IauCont%dtp",Land_IAU_Control%dtp + endif + + !> read iau increments + call land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) + if (errflg .ne. 0) then if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",Land_IAU_Control%fhour, & - " delt ",delt," IauCont%dtp",Land_IAU_Control%dtp - endif + print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" + print*, errmsg + endif + return + endif - !> read iau increments - call land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) - if (errflg .ne. 0) then - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" - print*, errmsg - endif + !> update land states with iau increments + if (Land_IAU_Data%in_interval) then + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "adding land iau increments " + endif + + if (Land_IAU_Control%lsoil .ne. km) then + write(errmsg,*) 'noahmpdrv_timestep_init: Land_IAU_Data%lsoil ',Land_IAU_Control%lsoil,' not equal to km ',km + errflg = 1 return endif - !> update land states with iau increments - if (Land_IAU_Data%in_interval) then - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "adding land iau increments " - endif + ! local variable to copy blocked data Land_IAU_Data%stc_inc + allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols + ! allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols + allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) + stc_updated = 0 + ib = 1 + do j = 1, Land_IAU_Control%ny !ny + do k = 1, km + stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) =Land_IAU_Data%stc_inc(:,j, k) + ! slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) + enddo + ib = ib + Land_IAU_Control%nx !nlon + enddo - if (Land_IAU_Control%lsoil .ne. km) then - write(errmsg,*) 'noahmpdrv_timestep_init: Land_IAU_Data%lsoil ',Land_IAU_Control%lsoil,' not equal to km ',km - errflg = 1 - return + ! delt=GFS_Control%dtf + if ((Land_IAU_Control%dtp - delt) > 0.0001) then + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "Warning noahmpdrv_run delt ",delt,"different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp endif + endif - ! local variable to copy blocked data Land_IAU_Data%stc_inc - allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols - ! allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols - ib = 1 - do j = 1, Land_IAU_Control%ny !ny - do k = 1, km - stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) =Land_IAU_Data%stc_inc(:,j, k) - ! slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) + !IAU increments are in units of 1/sec !Land_IAU_Control%dtp + !* only updating soil temp for now + lsoil_incr = Land_IAU_Control%lsoil_incr + lensfc = Land_IAU_Control%nx * Land_IAU_Control%ny + + print*,'adjusting first ', lsoil_incr, ' surface layers only' + ! initialize variables for counts statitics to be zeros + nother = 0 ! grid cells not land + nsnowupd = 0 ! grid cells with snow (temperature not yet updated) + nstcupd = 0 ! grid cells that are updated + nfrozen = 0 ! not update as frozen soil + nfrozen_upd = 0 ! not update as frozen soil + + allocate(mask_tile(lensfc)) + call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, & !veg_type_landice, + mask_tile) + + ij_loop : do ij = 1, lensfc + ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land + if (mask_tile(ij) == 1) then + soil_freeze=.false. + soil_ice=.false. + do k = 1, lsoil_incr ! k = 1, km + if ( stc(ij,k) < tfreez) soil_freeze=.true. + if ( smc(ij,k) - slc(ij,k) > 0.001 ) soil_ice=.true. + + stc(ij,k) = stc(ij,k) + stc_inc_flat(ij,k)*delt !Land_IAU_Control%dtp + + if (k==1) then + stc_updated(ij) = 1 + nstcupd = nstcupd + 1 + endif + if ( (stc(ij,k) < tfreez) .and. (.not. soil_freeze) .and. (k==1) )& + nfrozen_upd = nfrozen_upd + 1 + ! moisture updates not done if this layer or any above is frozen + if ( soil_freeze .or. soil_ice ) then + if (k==1) nfrozen = nfrozen+1 + endif enddo - ib = ib + Land_IAU_Control%nx !nlon - enddo - - ! delt=GFS_Control%dtf - if ((Land_IAU_Control%dtp - delt) > 0.0001) then - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "Warning noahmpdrv_run delt ",delt,"different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp - endif + endif ! if soil/snow point + enddo ij_loop + ! do k = 1, km + ! stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !Land_IAU_Control%dtp + ! ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !Land_IAU_Control%dtp + ! enddo + deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) + + ! add (consistency) adjustments for updated soil temp and moisture + + ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) + call read_mp_table_parameters(errmsg, errflg) + maxsmc(1:slcats) = smcmax_table(1:slcats) + bb(1:slcats) = bexp_table(1:slcats) + satpsi(1:slcats) = psisat_table(1:slcats) + + if (errflg .ne. 0) then + print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' + errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' + return + endif + n_stc = 0 + do i=1,lensfc + if (stc_updated(i) == 1 ) then ! soil-only location + n_stc = n_stc+1 + soiltype = soiltyp(i) + do l = 1, lsoil_incr + !case 1: frz ==> frz, recalculate slc, smc remains + !case 2: unfrz ==> frz, recalculate slc, smc remains + !both cases are considered in the following if case + if (stc(i,l) .LT. tfreez )then + !recompute supercool liquid water,smc_anl remain unchanged + smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) + slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) + slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) + endif + !case 3: frz ==> unfrz, melt all soil ice (if any) + if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck + slc(i,l)=smc(i,l) + endif + enddo endif - !IAU increments are in units of 1/sec !Land_IAU_Control%dtp - !* only updating soil temp for now - do k = 1, km - stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !Land_IAU_Control%dtp - ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !Land_IAU_Control%dtp - enddo - deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) + enddo + + deallocate(stc_updated) + allocate(mask_tile) - endif + write(*,'(a,i2)') ' statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me + write(*,'(a,i8)') ' soil grid total', lensfc + write(*,'(a,i8)') ' soil grid cells stc updated = ',nstcupd + write(*,'(a,i8)') ' soil grid cells not updated, frozen = ',nfrozen + write(*,'(a,i8)') ' soil grid cells update, became frozen = ',nfrozen_upd + write(*,'(a,i8)') ' (not updated yet) snow grid cells = ', nsnowupd + write(*,'(a,i8)') ' grid cells, without soil or snow = ', nother + write(*,'(a,i8)') ' soil grid cells with stc update', n_stc + + endif - end subroutine noahmpdrv_timestep_init +end subroutine noahmpdrv_timestep_init !> \ingroup NoahMP_LSM !! \brief This subroutine is called after noahmpdrv_run From 25358b9fa552ee21d6d9f7c4e328b5bc80c258c8 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 13 Jun 2024 11:26:56 -0400 Subject: [PATCH 013/141] read fv3 increments --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 275 ++++++++++++------ physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 12 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 6 + 3 files changed, 207 insertions(+), 86 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 9a3fa8e7c..fefcd53c2 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -69,6 +69,7 @@ module land_iau_mod integer :: jsc integer :: nx integer :: ny + integer :: tile_num integer :: nblks integer, allocatable :: blksz(:) ! this could vary for the last block integer, allocatable :: blk_strt_indx(:) @@ -91,6 +92,8 @@ module land_iau_mod character(len=:), pointer, dimension(:) :: input_nml_file => null() ! null() integer :: input_nml_file_length !< length(number of lines) in namelist for internal reads - + !> these are not available through the CCPP interface so need to read them from namelist file !> vars to read from namelist @@ -132,12 +135,12 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me character(len=240) :: land_iau_inc_files(7) = '' !< list of increment files real(kind=kind_phys) :: land_iaufhrs(7) = -1 !< forecast hours associated with increment files logical :: land_iau_filter_increments = .false. !< filter IAU increments - + logical :: gaussian_inc_file = .false. integer :: lsoil_incr = 4 NAMELIST /lnd_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iaufhrs, & land_iau_filter_increments, & !, lnd_iau_drymassfixer - lsoil_incr + lsoil_incr, gaussian_inc_file !Errors messages handled through CCPP error handling variables errmsg = '' @@ -198,6 +201,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%jsc = jsc Land_IAU_Control%nx = nx Land_IAU_Control%ny = ny + Land_IAU_Control%tile_num = tile_num Land_IAU_Control%nblks = nblks Land_IAU_Control%lsoil = lsoil Land_IAU_Control%lsnow_lsm = lsnow_lsm @@ -206,6 +210,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%input_nml_file = input_nml_file Land_IAU_Control%input_nml_file_length = input_nml_file_length + Land_IAU_Control%gaussian_inc_file = gaussian_inc_file allocate(Land_IAU_Control%blksz(nblks)) allocate(Land_IAU_Control%blk_strt_indx(nblks)) @@ -316,60 +321,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms dt = (Land_IAU_Control%iau_delthrs*3600.) rdt = 1.0/dt -! set up interpolation weights to go from GSI's gaussian grid to cubed sphere - deg2rad = pi/180. - - ! npz = Land_IAU_Control%levs - fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1)) - inquire (file=trim(fname), exist=exists) - if (exists) then ! if( file_exist(fname) ) then - ! call open_ncfile( fname, ncid ) - status = nf90_open(trim(fname), NF90_NOWRITE, ncid) ! open the file - call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) - if (errflg .ne. 0) return - call get_nc_dimlen(ncid, "longitude", im, errflg, errmsg) - if (errflg .ne. 0) return - call get_nc_dimlen(ncid, "latitude", jm, errflg, errmsg) - if (errflg .ne. 0) return - km = n_soill - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) write(*,*) fname, ' DA increment dimensions:', im,jm,km - allocate (lon(im) ) - allocate (lat(jm) ) - call get_var1d(ncid, im, "longitude", lon, errflg, errmsg) - if (errflg .ne. 0) return - call get_var1d(ncid, jm, "latitude", lat, errflg, errmsg) - if (errflg .ne. 0) return - status = nf90_close(ncid) - CALL netcdf_err(status, 'closing file: '//trim(fname) , errflg, errmsg) - if (errflg .ne. 0) return - ! Convert to radians - do i=1,im - lon(i) = lon(i) * deg2rad - enddo - do j=1,jm - lat(j) = lat(j) * deg2rad - enddo - else - errmsg = 'FATAL Error in Land_IAU_initialize: Expected file '// trim(fname)//' for DA increment does not exist' - errflg = 1 - return - endif - -! Initialize lat-lon to Cubed bi-linear interpolation coeff: - do j = 1,size(Init_parm_xlon,2) - do i = 1,size(Init_parm_xlon,1) - ! print*,i,j,is-1+j,js-1+j - agrid(is-1+i,js-1+j,1)=Init_parm_xlon(i,j) - agrid(is-1+i,js-1+j,2)=Init_parm_xlat(i,j) - enddo - enddo - call remap_coef( is, ie, js, je, is, ie, js, je, & - im, jm, lon, lat, id1, id2, jdc, s2c, & - agrid) - deallocate ( lon, lat,agrid ) - if (allocated(Init_parm_xlon)) deallocate(Init_parm_xlon) - if (allocated(Init_parm_xlat)) deallocate(Init_parm_xlat) - allocate(Land_IAU_Data%stc_inc(is:ie, js:je, km)) allocate(Land_IAU_Data%slc_inc(is:ie, js:je, km)) ! allocate arrays that will hold iau state @@ -410,27 +361,111 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms enddo enddo - ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid - allocate (wk3_stc(nfiles, 1:im,jbeg:jend, 1:km)) - allocate (wk3_slc(nfiles, 1:im,jbeg:jend, 1:km)) - do k=1, nfiles - call read_iau_forcing_all_timesteps(Land_IAU_Control, & - 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(k)), errmsg, errflg, & - wk3_stc(k, :, :, :), wk3_slc(k, :, :, :)) - enddo + if (Land_IAU_Control%gaussian_inc_file) then + !set up interpolation weights to go from GSI's gaussian grid to cubed sphere + deg2rad = pi/180. + ! npz = Land_IAU_Control%levs + fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1)) + inquire (file=trim(fname), exist=exists) + if (exists) then ! if( file_exist(fname) ) then + ! call open_ncfile( fname, ncid ) + status = nf90_open(trim(fname), NF90_NOWRITE, ncid) ! open the file + call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) + if (errflg .ne. 0) return + call get_nc_dimlen(ncid, "longitude", im, errflg, errmsg) + if (errflg .ne. 0) return + call get_nc_dimlen(ncid, "latitude", jm, errflg, errmsg) + if (errflg .ne. 0) return + km = n_soill + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) write(*,*) fname, ' DA increment dimensions:', im,jm,km + allocate (lon(im) ) + allocate (lat(jm) ) + call get_var1d(ncid, im, "longitude", lon, errflg, errmsg) + if (errflg .ne. 0) return + call get_var1d(ncid, jm, "latitude", lat, errflg, errmsg) + if (errflg .ne. 0) return + status = nf90_close(ncid) + CALL netcdf_err(status, 'closing file: '//trim(fname) , errflg, errmsg) + if (errflg .ne. 0) return + ! Convert to radians + do i=1,im + lon(i) = lon(i) * deg2rad + enddo + do j=1,jm + lat(j) = lat(j) * deg2rad + enddo + else + errmsg = 'FATAL Error in Land_IAU_initialize: Expected file '// trim(fname)//' for DA increment does not exist' + errflg = 1 + return + endif + + ! Initialize lat-lon to Cubed bi-linear interpolation coeff: + do j = 1,size(Init_parm_xlon,2) + do i = 1,size(Init_parm_xlon,1) + ! print*,i,j,is-1+j,js-1+j + agrid(is-1+i,js-1+j,1)=Init_parm_xlon(i,j) + agrid(is-1+i,js-1+j,2)=Init_parm_xlat(i,j) + enddo + enddo + call remap_coef( is, ie, js, je, is, ie, js, je, & + im, jm, lon, lat, id1, id2, jdc, s2c, & + agrid) + + if (allocated(lon)) deallocate (lon) + if (allocated(lat)) deallocate (lat) + if (allocated(agrid)) deallocate (agrid) + if (allocated(Init_parm_xlon)) deallocate(Init_parm_xlon) + if (allocated(Init_parm_xlat)) deallocate(Init_parm_xlat) + + ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid + allocate (wk3_stc(nfiles, 1:im,jbeg:jend, 1:km)) + allocate (wk3_slc(nfiles, 1:im,jbeg:jend, 1:km)) + do k=1, nfiles + call read_iau_forcing_all_timesteps(Land_IAU_Control, & + 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(k)), errmsg, errflg, & + wk3_stc(k, :, :, :), wk3_slc(k, :, :, :)) + enddo + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(1, :, :, :), Land_IAU_state%inc1%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(1, :, :, :), Land_IAU_state%inc1%slc_inc, errmsg, errflg) + if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window + call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%wt) + endif + if (nfiles.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them + allocate (Land_IAU_state%inc2%stc_inc(is:ie, js:je, km)) + allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) + Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(2, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(2, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) + endif + else ! increment files in fv3 tiles + ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid + ! increments already in the fv3 modele grid--no need for interpolation + ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid + allocate (wk3_stc(nfiles, 1:im,jbeg:jend, 1:km)) + allocate (wk3_slc(nfiles, 1:im,jbeg:jend, 1:km)) + do k=1, nfiles + call read_iau_forcing_fv3(Land_IAU_Control, & + 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(k)), errmsg, errflg, & + + Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) + enddo + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(1, :, :, :), Land_IAU_state%inc1%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(1, :, :, :), Land_IAU_state%inc1%slc_inc, errmsg, errflg) + if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window + call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%wt) + endif + if (nfiles.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them + allocate (Land_IAU_state%inc2%stc_inc(is:ie, js:je, km)) + allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) + Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(2, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(2, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) + endif - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(1, :, :, :), Land_IAU_state%inc1%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(1, :, :, :), Land_IAU_state%inc1%slc_inc, errmsg, errflg) - if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window - call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%wt) - endif - if (nfiles.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them - allocate (Land_IAU_state%inc2%stc_inc(is:ie, js:je, km)) - allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) - Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(2, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(2, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) endif + + ! print*,'end of IAU init',dt,rdt end subroutine land_iau_mod_init @@ -599,8 +634,8 @@ subroutine read_iau_forcing_all_timesteps(Land_IAU_Control, fname, errmsg, errfl wk3_out_stc, wk3_out_slc) !, fname_sfc) is, ie, js, je, ks,ke, type (land_iau_control_type), intent(in) :: Land_IAU_Control character(len=*), intent(in) :: fname - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg real(kind=kind_phys), intent(out) :: wk3_out_stc(1:im, jbeg:jend, 1:km) real(kind=kind_phys), intent(out) :: wk3_out_slc(1:im, jbeg:jend, 1:km) @@ -623,7 +658,7 @@ subroutine read_iau_forcing_all_timesteps(Land_IAU_Control, fname, errmsg, errfl call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) if (errflg .ne. 0) return else - errmsg = 'FATAL Error in land read_iau_forcing_all_timesteps: Expected file '//trim(fname)//' for DA increment does not exist' + errmsg = 'FATAL Error in land iau read_iau_forcing_all_timesteps: Expected file '//trim(fname)//' for DA increment does not exist' errflg = 1 return endif @@ -661,6 +696,80 @@ subroutine read_iau_forcing_all_timesteps(Land_IAU_Control, fname, errmsg, errfl end subroutine read_iau_forcing_all_timesteps +subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errmsg, errflg) + + type (land_iau_control_type), intent(in) :: Land_IAU_Control + ! character(len=*), intent(in) :: fname + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg + real(kind=kind_phys), intent(out) :: stc_inc_out(1:im, jbeg:jend, 1:km) + real(kind=kind_phys), intent(out) :: slc_inc_out(1:im, jbeg:jend, 1:km) + + integer :: i, j, k, l, npz + integer :: i1, i2, j1 + logical :: exists + integer :: ncid, status, varid + integer :: ierr + character(len=500) :: fname + character(len=2) :: tile_str + + character(len=32), dimension(4) :: stc_vars = [character(len=32) :: 'soilt1_inc', 'soilt2_inc', 'soilt3_inc', 'soilt4_inc'] + character(len=32), dimension(4) :: slc_vars = [character(len=32) :: 'slc1_inc', 'slc2_inc', 'slc3_inc', 'slc4_inc'] + + !Errors messages handled through CCPP error handling variables + errmsg = '' + errflg = 0 + + write(tile_str, '(I0)') Land_IAU_Control%tile_num + + fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1))//".tile"//tile_str//".nc" + + inquire (file=trim(fname), exist=exists) + if (exists) then + status = nf90_open(trim(fname), NF90_NOWRITE, ncid) ! open the file + call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) + if (errflg .ne. 0) return + else + errmsg = 'FATAL Error in land iau read_iau_forcing_fv3: Expected file '//trim(fname)//' for DA increment does not exist' + errflg = 1 + return + endif + + do i = 1, size(stc_vars) + print *, trim(stc_vars(i)) + ! call check_var_exists(ncid, trim(stc_vars(i)), ierr) + status = nf90_inq_varid(ncid, trim(stc_vars(i)), varid) + if (status == nf90_noerr) then !if (ierr == 0) then + ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) + call get_var3d_values(ncid, varid, 1,im, jbeg,jend, 1,1, wk3_out_stc(:, :, i), status) + call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg_out) + if (errflg .ne. 0) return + else + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, & + 'warning: no increment for ',trim(stc_vars(i)),' found, assuming zero' + wk3_out_stc(:, :, i) = 0. + endif + enddo + do i = 1, size(slc_vars) + print *, trim(slc_vars(i)) + status = nf90_inq_varid(ncid, trim(slc_vars(i)), varid) + if (status == nf90_noerr) then !if (ierr == 0) then + ! call get_var3_r4( ncid, trim(slc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i) ) + call get_var3d_values(ncid, varid, 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i), status) + call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg_out) + if (errflg .ne. 0) return + else + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,& + 'warning: no increment for ',trim(slc_vars(i)),' found, assuming zero' + wk3_out_slc(:, :, i) = 0. + endif + enddo + + call close_ncfile(ncid) + + +end subroutine read_iau_forcing_fv3 + subroutine interp_inc_at_timestep(Land_IAU_Control, km_in, wk3_in, var, errmsg, errflg) !field_name, , jbeg, jend) ! interpolate increment from GSI gaussian grid to cubed sphere ! everying is on the A-grid, earth relative @@ -670,8 +779,8 @@ subroutine interp_inc_at_timestep(Land_IAU_Control, km_in, wk3_in, var, errmsg, real(kind=kind_phys), intent(in) :: wk3_in(1:im,jbeg:jend, 1:km_in) real(kind=kind_phys), dimension(is:ie, js:je, 1:km), intent(inout) :: var - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg integer:: i1, i2, j1, k, j, i do k=1,km_in diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 5bae760a6..b95d62a13 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -51,8 +51,8 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & do_mynnsfclay,do_mynnedmf, & errmsg, errflg, & mpi_root, & - fn_nml, input_nml_file, isc, jsc, ncols, nx, ny, nblks, & - blksz, xlon, xlat, & + fn_nml, input_nml_file, isc, jsc, ncols, nx, ny, tile_num, & + nblks, blksz, xlon, xlat, & lsoil, lsnow_lsm, dtp, fhour) use machine, only: kind_phys @@ -78,9 +78,13 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & character(*), intent(in) :: fn_nml character(len=:), intent(in), dimension(:), pointer :: input_nml_file integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks + integer, intent(in) :: tile_num !GFS_control_type%tile_num integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon real(kind_phys), dimension(:), intent(in) :: xlat ! latitude + + + integer, intent(in) :: lsoil, lsnow_lsm real(kind=kind_phys), intent(in) :: dtp, fhour ! type(gfs_data_type), dimension(:), intent(inout) :: GFS_Data ! !(one:) @@ -135,7 +139,7 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & ! Read Land IAU settings call land_iau_mod_set_control(Land_IAU_Control, fn_nml, input_nml_file, & - me, mpi_root, isc,jsc, nx, ny, nblks, blksz, & + me, mpi_root, isc,jsc, nx, ny, tile_num, nblks, blksz, & lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) ! Initialize IAU for land call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errmsg, errflg) @@ -279,6 +283,8 @@ subroutine noahmpdrv_timestep_init (isot, ivegsrc, itime, fhour, delt, km, & !IAU increments are in units of 1/sec !Land_IAU_Control%dtp !* only updating soil temp for now lsoil_incr = Land_IAU_Control%lsoil_incr + +!---this should be ncol?? as last block may be shorter (check blksz)? lensfc = Land_IAU_Control%nx * Land_IAU_Control%ny print*,'adjusting first ', lsoil_incr, ' surface layers only' diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 2f2ccba2f..2d500d060 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -155,6 +155,12 @@ dimensions = () type = integer intent = in + [tile_num] + standard_name = index_of_cubed_sphere_tile + long_name = tile number + units = none + dimensions = () + type = integer [nblks] standard_name = ccpp_block_count long_name = for explicit data blocking: number of blocks From df9f6409eeb55cae857642695401e9c21fdaef72 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 17 Jun 2024 10:10:41 -0400 Subject: [PATCH 014/141] update driver_timestepinit --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 109 +++++++++++------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 7 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 46 +++++++- 3 files changed, 117 insertions(+), 45 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index fefcd53c2..b200da916 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -440,32 +440,31 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms endif else ! increment files in fv3 tiles ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid - ! increments already in the fv3 modele grid--no need for interpolation - ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid - allocate (wk3_stc(nfiles, 1:im,jbeg:jend, 1:km)) - allocate (wk3_slc(nfiles, 1:im,jbeg:jend, 1:km)) - do k=1, nfiles - call read_iau_forcing_fv3(Land_IAU_Control, & - 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(k)), errmsg, errflg, & - - Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) - enddo - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(1, :, :, :), Land_IAU_state%inc1%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(1, :, :, :), Land_IAU_state%inc1%slc_inc, errmsg, errflg) + ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) + ! allocate (wk3_slc(n_t, 1:im,jbeg:jend, 1:km)) + call read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errflg) + ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) + + ! increments already in the fv3 modele grid--no need for interpolation + Land_IAU_state%inc1%stc_inc(:, :, :) = wk3_stc(1, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) + Land_IAU_state%inc1%slc_inc(:, :, :) = wk3_slc(1, :, :, :) + ! call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(1, :, :, :), Land_IAU_state%inc1%stc_inc, errmsg, errflg) + ! call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(1, :, :, :), Land_IAU_state%inc1%slc_inc, errmsg, errflg) if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%wt) endif if (nfiles.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them allocate (Land_IAU_state%inc2%stc_inc(is:ie, js:je, km)) allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) - Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(2, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(2, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) + Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) + + Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(2, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) + Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(2, :, :, :) + ! call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(2, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) + ! call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(2, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) endif - endif - ! print*,'end of IAU init',dt,rdt end subroutine land_iau_mod_init @@ -574,11 +573,14 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e Land_IAU_state%inc1=Land_IAU_state%inc2 ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'reading next lnd iau increment file',trim(Land_IAU_Control%iau_inc_files(itnext)) - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'interpolating next lnd iau increment ', itnext !trim(Land_IAU_Control%iau_inc_files(itnext)) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(itnext, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(itnext, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) - call interp_inc_at_timestep(Land_IAU_Control, 1, wk3_t2m(itnext, :, :, :), Land_IAU_state%inc2%tmp2m_inc, errmsg, errflg) - call interp_inc_at_timestep(Land_IAU_Control, 1, wk3_q2m(itnext, :, :, :), Land_IAU_state%inc2%spfh2m_inc, errmsg, errflg) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'copying/interpolating next lnd iau increment ', itnext !trim(Land_IAU_Control%iau_inc_files(itnext)) + if (Land_IAU_Control%gaussian_inc_file) then + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(itnext, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) + call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(itnext, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) + else + Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) + ` Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) + endif endif call updateiauforcing(Land_IAU_Control,Land_IAU_Data,Land_IAU_state%wt) endif @@ -602,8 +604,6 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, wt) Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_state%inc1%stc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%stc_inc(i,j,k))*rdt*wt Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_state%inc1%slc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%slc_inc(i,j,k))*rdt*wt end do - Land_IAU_Data%tmp2m_inc(i,j,1) =(delt*Land_IAU_state%inc1%tmp2m_inc(i,j,1) + (1.-delt)* Land_IAU_state%inc2%tmp2m_inc(i,j,1))*rdt*wt - Land_IAU_Data%spfh2m_inc(i,j,1) =(delt*Land_IAU_state%inc1%spfh2m_inc(i,j,1) + (1.-delt)* Land_IAU_state%inc2%spfh2m_inc(i,j,1))*rdt*wt enddo enddo end subroutine updateiauforcing @@ -623,8 +623,6 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, wt) Land_IAU_Data%stc_inc(i,j,k) = wt*Land_IAU_state%inc1%stc_inc(i,j,k)*rdt Land_IAU_Data%slc_inc(i,j,k) = wt*Land_IAU_state%inc1%slc_inc(i,j,k)*rdt end do - Land_IAU_Data%tmp2m_inc(i,j,1) = wt*Land_IAU_state%inc1%tmp2m_inc(i,j,1)*rdt - Land_IAU_Data%spfh2m_inc(i,j,1) = wt*Land_IAU_state%inc1%spfh2m_inc(i,j,1)*rdt enddo enddo @@ -702,16 +700,17 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm ! character(len=*), intent(in) :: fname character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg - real(kind=kind_phys), intent(out) :: stc_inc_out(1:im, jbeg:jend, 1:km) - real(kind=kind_phys), intent(out) :: slc_inc_out(1:im, jbeg:jend, 1:km) + real(kind=kind_phys), allocatable intent(out) :: stc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) + real(kind=kind_phys), allocatable intent(out) :: slc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) - integer :: i, j, k, l, npz - integer :: i1, i2, j1 + integer :: i, it !j, k, l, npz, logical :: exists integer :: ncid, status, varid integer :: ierr character(len=500) :: fname character(len=2) :: tile_str + integer :: n_t, n_y, n_x + ! integer :: isc, jsc character(len=32), dimension(4) :: stc_vars = [character(len=32) :: 'soilt1_inc', 'soilt2_inc', 'soilt3_inc', 'soilt4_inc'] character(len=32), dimension(4) :: slc_vars = [character(len=32) :: 'slc1_inc', 'slc2_inc', 'slc3_inc', 'slc4_inc'] @@ -723,6 +722,8 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm write(tile_str, '(I0)') Land_IAU_Control%tile_num fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1))//".tile"//tile_str//".nc" + ! isc = Land_IAU_Control%isc + ! jsc = Land_IAU_Control%jsc inquire (file=trim(fname), exist=exists) if (exists) then @@ -734,34 +735,60 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm errflg = 1 return endif + ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) + call get_nc_dimlen(ncid, "Time", n_t, errflg, errmsg) + if (errflg .ne. 0) return + call get_nc_dimlen(ncid, "yaxis_1", n_y, errflg, errmsg) + if (errflg .ne. 0) return + call get_nc_dimlen(ncid, "xaxis_1", n_x, errflg, errmsg) + if (errflg .ne. 0) return + + if (n_x .lt. Land_IAU_Control%nx) then + errmsg = 'Error in land iau read_iau_forcing_fv3: Land_IAU_Control%nx bigger than dim xaxis_1 in file '//trim(fname) + errflg = 1 + return + endif + if (n_y .lt. Land_IAU_Control%ny) then + errmsg = 'Error in land iau read_iau_forcing_fv3: Land_IAU_Control%ny bigger than dim yaxis_1 in file '//trim(fname) + errflg = 1 + return + endif + + allocate(stc_inc_out(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) + allocate(slc_inc_out(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) do i = 1, size(stc_vars) print *, trim(stc_vars(i)) ! call check_var_exists(ncid, trim(stc_vars(i)), ierr) status = nf90_inq_varid(ncid, trim(stc_vars(i)), varid) if (status == nf90_noerr) then !if (ierr == 0) then - ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) - call get_var3d_values(ncid, varid, 1,im, jbeg,jend, 1,1, wk3_out_stc(:, :, i), status) - call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg_out) - if (errflg .ne. 0) return + do it = 1, n_t + ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) + call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, stc_inc_out(it,:, :, i), status) + ! call get_var3d_values(ncid, varid, 1,im, jbeg,jend, it, 1, stc_inc_out(it,:, :, i), status) + call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg_out) + if (errflg .ne. 0) return + enddo else if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, & 'warning: no increment for ',trim(stc_vars(i)),' found, assuming zero' - wk3_out_stc(:, :, i) = 0. + stc_inc_out(:, :, :, i) = 0. endif enddo do i = 1, size(slc_vars) print *, trim(slc_vars(i)) status = nf90_inq_varid(ncid, trim(slc_vars(i)), varid) if (status == nf90_noerr) then !if (ierr == 0) then - ! call get_var3_r4( ncid, trim(slc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i) ) - call get_var3d_values(ncid, varid, 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i), status) - call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg_out) - if (errflg .ne. 0) return + do it = 1, n_t + call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, slc_inc_out(it, :, :, i), status) + ! call get_var3d_values(ncid, varid, 1,im, jbeg,jend, it, 1, slc_inc_out(it, :, :, i), status) + call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg_out) + if (errflg .ne. 0) return + end do else if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,& 'warning: no increment for ',trim(slc_vars(i)),' found, assuming zero' - wk3_out_slc(:, :, i) = 0. + slc_inc_out(:, :, :, i) = 0. endif enddo @@ -890,7 +917,7 @@ end subroutine remap_coef !! @param[out] mask Land mask for increments !! @author Clara Draper @date March 2021 !! @author Yuan Xue: introduce stype to make the mask calculation more generic -subroutine calculate_landinc_mask(swe,vtype,stype,lensfc,veg_type_landice,mask) +subroutine calculate_landinc_mask(swe,vtype,stype,lensfc,veg_type_landice, mask) implicit none diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index b95d62a13..ad6d9f2f9 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -170,9 +170,9 @@ end subroutine noahmpdrv_init !! @param[inout] slc_adj Analysis liquid soil moisture states !! @param[in] stc_updated Integer to record whether STC in each grid cell was updated -subroutine noahmpdrv_timestep_init (isot, ivegsrc, itime, fhour, delt, km, & !me, mpi_root, - soiltyp, vegtype, weasd, & - stc, slc, smc, errmsg, errflg) ! smc, t2mmp, q2mp, +subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_root, + isot, ivegsrc, soiltyp, vegtype, weasd, & + stc, slc, smc, errmsg, errflg) ! smc, t2mmp, q2mp, use machine, only: kind_phys use namelist_soilveg @@ -295,6 +295,7 @@ subroutine noahmpdrv_timestep_init (isot, ivegsrc, itime, fhour, delt, km, & nfrozen = 0 ! not update as frozen soil nfrozen_upd = 0 ! not update as frozen soil +!TODO---if only fv3 increment files are used, this can be read from file allocate(mask_tile(lensfc)) call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, & !veg_type_landice, mask_tile) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 2d500d060..d561a0fd0 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -155,7 +155,7 @@ dimensions = () type = integer intent = in - [tile_num] +[tile_num] standard_name = index_of_cubed_sphere_tile long_name = tile number units = none @@ -256,6 +256,42 @@ dimensions = () type = integer intent = in +[isot] + standard_name = control_for_soil_type_dataset + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in +[ivegsrc] + standard_name = control_for_vegetation_dataset + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent= in +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent= in +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [stc] standard_name = soil_temperature long_name = soil temperature @@ -272,6 +308,14 @@ type = real kind = kind_phys intent = inout +[smc] + standard_name = volume_fraction_of_condensed_water_in_soil + long_name = total soil moisture + units = frac + dimensions = (horizontal_loop_extent,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From ea2f78bdd69f52af0a3d8c7e4f80967d55dea945 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 17 Jun 2024 10:21:09 -0400 Subject: [PATCH 015/141] remove duplicte names --- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index d561a0fd0..aa27f29fc 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -376,13 +376,6 @@ [ccpp-arg-table] name = noahmpdrv_run type = scheme -[nb] - standard_name = ccpp_block_number - long_name = number of block for explicit data blocking in CCPP - units = index - dimensions = () - type = integer - intent = in [im] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -411,14 +404,6 @@ dimensions = () type = integer intent = in -[fhour] - standard_name = forecast_time - long_name = current forecast time - units = h - dimensions = () - type = real - kind = kind_phys - intent = in [ps] standard_name = surface_air_pressure long_name = surface pressure From 4737da1fd24465d80fd31b5d923980ad09aa65a7 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 17 Jun 2024 10:25:51 -0400 Subject: [PATCH 016/141] remove duplicte names --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 28 ++++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index ad6d9f2f9..dcfe53146 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -9,35 +9,35 @@ !! as diagnotics calculation. !> This module contains the CCPP-compliant NoahMP land surface model driver. -module noahmpdrv + module noahmpdrv - use module_sf_noahmplsm + use module_sf_noahmplsm - ! Land IAU increments for soil temperature (can also do soil moisture increments if needed) - use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & + ! Land IAU increments for soil temperature (can also do soil moisture increments if needed) + use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & land_iau_mod_set_control, land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, & calculate_landinc_mask - implicit none + implicit none - integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS + integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS - private + private - public :: noahmpdrv_init, noahmpdrv_run, & + public :: noahmpdrv_init, noahmpdrv_run, & noahmpdrv_timestep_init, noahmpdrv_timestep_finalize, noahmpdrv_finalize - !> \Land IAU data and control - ! Land IAU Control holds settings' information, maily read from namelist (e.g., + !> \Land IAU data and control + ! Land IAU Control holds settings' information, maily read from namelist (e.g., ! block of global domain that belongs to a process , ! whethrer to do IAU increment at this time step, ! time step informatoin, etc) - type (land_iau_control_type) :: Land_IAU_Control - ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step - type (land_iau_external_data_type) :: Land_IAU_Data !(number of blocks):each proc holds nblks + type (land_iau_control_type) :: Land_IAU_Control + ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step + type (land_iau_external_data_type) :: Land_IAU_Data !(number of blocks):each proc holds nblks - contains + contains !> \ingroup NoahMP_LSM !! \brief This subroutine is called during the CCPP initialization phase and calls set_soilveg() to From bb042f3bbbf7833377578ef7261fc9de9ddb5ea0 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 17 Jun 2024 10:30:34 -0400 Subject: [PATCH 017/141] remove duplicte names --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 32 ++++++++++---------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index dcfe53146..280f616c3 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -11,33 +11,33 @@ !> This module contains the CCPP-compliant NoahMP land surface model driver. module noahmpdrv - use module_sf_noahmplsm + use module_sf_noahmplsm - ! Land IAU increments for soil temperature (can also do soil moisture increments if needed) - use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & + ! Land IAU increments for soil temperature (can also do soil moisture increments if needed) + use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & land_iau_mod_set_control, land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, & calculate_landinc_mask - implicit none + implicit none - integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS + integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS - private + private - public :: noahmpdrv_init, noahmpdrv_run, & + public :: noahmpdrv_init, noahmpdrv_run, & noahmpdrv_timestep_init, noahmpdrv_timestep_finalize, noahmpdrv_finalize - !> \Land IAU data and control - ! Land IAU Control holds settings' information, maily read from namelist (e.g., - ! block of global domain that belongs to a process , - ! whethrer to do IAU increment at this time step, - ! time step informatoin, etc) - type (land_iau_control_type) :: Land_IAU_Control - ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step - type (land_iau_external_data_type) :: Land_IAU_Data !(number of blocks):each proc holds nblks + !> \Land IAU data and control + ! Land IAU Control holds settings' information, maily read from namelist (e.g., + ! block of global domain that belongs to a process , + ! whethrer to do IAU increment at this time step, + ! time step informatoin, etc) + type (land_iau_control_type) :: Land_IAU_Control + ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step + type (land_iau_external_data_type) :: Land_IAU_Data !(number of blocks):each proc holds nblks - contains + contains !> \ingroup NoahMP_LSM !! \brief This subroutine is called during the CCPP initialization phase and calls set_soilveg() to From 2975f64b8460caf15eacda6b7041c56113b2a6e6 Mon Sep 17 00:00:00 2001 From: tsga Date: Mon, 17 Jun 2024 18:38:09 +0000 Subject: [PATCH 018/141] fix arg_table_noahmpdrv_finalize --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 3 ++- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index b95d62a13..3574997ba 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -402,11 +402,12 @@ subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp end subroutine noahmpdrv_timestep_finalize - !> \ingroup NoahMP_LSM + !> \ingroup NoahMP_LSM !! \brief This subroutine mirrors noahmpdrv_init !! it calls land_iau_finalize which frees up allocated memory by IAU_init (in noahmdrv_init) !! \section arg_table_noahmpdrv_finalize Argument Table !! \htmlinclude noahmpdrv_finalize.html +!! subroutine noahmpdrv_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, use machine, only: kind_phys diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 2d500d060..3cf4def3c 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -155,12 +155,13 @@ dimensions = () type = integer intent = in - [tile_num] +[tile_num] standard_name = index_of_cubed_sphere_tile long_name = tile number units = none dimensions = () type = integer + intent = in [nblks] standard_name = ccpp_block_count long_name = for explicit data blocking: number of blocks From d009364a2fb4f52764dacbcb11871aeacd7d10ab Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 17 Jun 2024 16:09:30 -0400 Subject: [PATCH 019/141] debug --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index b200da916..9dae88e33 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -969,7 +969,7 @@ SUBROUTINE NETCDF_ERR(ERR, STRING, errflg, errmsg_out) IF (ERR == NF90_NOERR) RETURN ERRMSG = NF90_STRERROR(ERR) PRINT*,'FATAL ERROR in Land IAU ', TRIM(STRING), ': ', TRIM(ERRMSG) - errmsg_out = 'FATAL ERROR in Land IAU ', TRIM(STRING), ': ', TRIM(ERRMSG) + errmsg_out = 'FATAL ERROR in Land IAU '//TRIM(STRING), ': '//TRIM(ERRMSG) ! CALL MPI_ABORT(MPI_COMM_WORLD, 999) errflg = 1 return From ae680688888fbc424f1ebcdf031ef11e57489dd6 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 18 Jun 2024 09:58:03 -0400 Subject: [PATCH 020/141] fix error about horizontal dimention --- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 44361d81f..0b9e17f97 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -275,21 +275,21 @@ standard_name = soil_type_classification long_name = soil type at each grid cell units = index - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = integer intent= in [vegtype] standard_name = vegetation_type_classification long_name = vegetation type at each grid cell units = index - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = integer intent= in [weasd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land units = mm - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -313,7 +313,7 @@ standard_name = volume_fraction_of_condensed_water_in_soil long_name = total soil moisture units = frac - dimensions = (horizontal_loop_extent,vertical_dimension_of_soil) + dimensions = (horizontal_dimension,vertical_dimension_of_soil) type = real kind = kind_phys intent = inout From 04e246dcdde0f4d713410afe0cf19e5007c5fdc7 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 18 Jun 2024 10:33:39 -0400 Subject: [PATCH 021/141] fix error about horizontal dimention --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 9dae88e33..618a92362 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -969,7 +969,7 @@ SUBROUTINE NETCDF_ERR(ERR, STRING, errflg, errmsg_out) IF (ERR == NF90_NOERR) RETURN ERRMSG = NF90_STRERROR(ERR) PRINT*,'FATAL ERROR in Land IAU ', TRIM(STRING), ': ', TRIM(ERRMSG) - errmsg_out = 'FATAL ERROR in Land IAU '//TRIM(STRING), ': '//TRIM(ERRMSG) + errmsg_out = 'FATAL ERROR in Land IAU '//TRIM(STRING)//': '//TRIM(ERRMSG) ! CALL MPI_ABORT(MPI_COMM_WORLD, 999) errflg = 1 return @@ -983,6 +983,7 @@ subroutine get_nc_dimlen(ncid, dim_name, dim_len, errflg, errmsg_out ) integer :: dimid integer :: errflg character(len=*) :: errmsg_out + integer :: status !Errors messages handled through CCPP error handling variables errmsg_out = '' @@ -1009,7 +1010,7 @@ subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) real(kind=kind_phys), intent(out):: var_arr(dim_len) integer :: errflg character(len=*) :: errmsg_out - integer :: var_id + integer :: varid !Errors messages handled through CCPP error handling variables errmsg_out = '' @@ -1019,6 +1020,7 @@ subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) CALL NETCDF_ERR(status, 'getting varid: '//trim(var_name), errflg, errmsg_out) if (errflg .ne. 0) return status = nf90_get_var(ncid, varid, var_arr) + ! start = (/1/), count = (/dim_len/)) CALL NETCDF_ERR(status, 'reading var: '//trim(var_name), errflg, errmsg_out) end subroutine get_var1d From 264eaf30f725beb5d0a70d8202dae952573b1b86 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 18 Jun 2024 10:58:31 -0400 Subject: [PATCH 022/141] fix netcdf error --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 618a92362..7a70c8c37 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -579,7 +579,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(itnext, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) else Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - ` Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) + Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) endif endif call updateiauforcing(Land_IAU_Control,Land_IAU_Data,Land_IAU_state%wt) @@ -667,7 +667,7 @@ subroutine read_iau_forcing_all_timesteps(Land_IAU_Control, fname, errmsg, errfl status = nf90_inq_varid(ncid, trim(stc_vars(i)), varid) if (status == nf90_noerr) then !if (ierr == 0) then call get_var3d_values(ncid, varid, 1,im, jbeg,jend, 1,1, wk3_out_stc(:, :, i), status) - call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg_out) + call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg) if (errflg .ne. 0) return else if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, & @@ -681,7 +681,7 @@ subroutine read_iau_forcing_all_timesteps(Land_IAU_Control, fname, errmsg, errfl if (status == nf90_noerr) then !if (ierr == 0) then ! call get_var3_r4( ncid, trim(slc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i) ) call get_var3d_values(ncid, varid, 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i), status) - call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg_out) + call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg) if (errflg .ne. 0) return else if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,& @@ -700,8 +700,8 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm ! character(len=*), intent(in) :: fname character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg - real(kind=kind_phys), allocatable intent(out) :: stc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) - real(kind=kind_phys), allocatable intent(out) :: slc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) + real(kind=kind_phys), allocatable, intent(out) :: stc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) + real(kind=kind_phys), allocatable, intent(out) :: slc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) integer :: i, it !j, k, l, npz, logical :: exists @@ -1010,7 +1010,7 @@ subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) real(kind=kind_phys), intent(out):: var_arr(dim_len) integer :: errflg character(len=*) :: errmsg_out - integer :: varid + integer :: varid, status !Errors messages handled through CCPP error handling variables errmsg_out = '' From fb21cc0b8bfb2d8126f97e877804d4e92615feac Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 18 Jun 2024 11:11:33 -0400 Subject: [PATCH 023/141] fix netcdf error --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 7a70c8c37..ce9e092c6 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -766,7 +766,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, stc_inc_out(it,:, :, i), status) ! call get_var3d_values(ncid, varid, 1,im, jbeg,jend, it, 1, stc_inc_out(it,:, :, i), status) - call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg_out) + call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg) if (errflg .ne. 0) return enddo else @@ -782,7 +782,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm do it = 1, n_t call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, slc_inc_out(it, :, :, i), status) ! call get_var3d_values(ncid, varid, 1,im, jbeg,jend, it, 1, slc_inc_out(it, :, :, i), status) - call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg_out) + call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg) if (errflg .ne. 0) return end do else From 9675dc804a473ca9cec30c14151d07b1ea40b2bf Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 18 Jun 2024 11:52:38 -0400 Subject: [PATCH 024/141] fix smc adjustment error --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 20 +++++++++---------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index ce9e092c6..f9c767c18 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -99,7 +99,7 @@ module land_iau_mod type(land_iau_state_type) :: Land_IAU_state public land_iau_control_type, land_iau_external_data_type, land_iau_mod_set_control, & - land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize + land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, calculate_landinc_mask contains diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 9eb3671a4..cb38dbfb4 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -15,8 +15,8 @@ module noahmpdrv ! Land IAU increments for soil temperature (can also do soil moisture increments if needed) use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & - land_iau_mod_set_control, land_iau_mod_init, - land_iau_mod_getiauforcing, land_iau_mod_finalize, & + land_iau_mod_set_control, land_iau_mod_init, & + land_iau_mod_getiauforcing, land_iau_mod_finalize, & calculate_landinc_mask implicit none @@ -212,10 +212,10 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo integer :: soiltype, n_stc real :: slc_new - integer :: i, l, jj, k, ib + integer :: i, j, ij, l, k, ib integer :: lensfc - real (kind=kind_phys), dimension(max_soiltyp) :: maxsmc, bb, satpsi + ! real (kind=kind_phys), dimension(max_soiltyp) :: maxsmc, bb, satpsi ! real, dimension(30) :: maxsmc, bb, satpsi real, parameter :: tfreez=273.16 !< con_t0c in physcons real, parameter :: hfus=0.3336e06 !< latent heat of fusion(j/kg) @@ -262,7 +262,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! local variable to copy blocked data Land_IAU_Data%stc_inc allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols ! allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols - allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) + allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) stc_updated = 0 ib = 1 do j = 1, Land_IAU_Control%ny !ny @@ -330,13 +330,13 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! enddo deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) - ! add (consistency) adjustments for updated soil temp and moisture +! (consistency) adjustments for updated soil temp and moisture ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) call read_mp_table_parameters(errmsg, errflg) - maxsmc(1:slcats) = smcmax_table(1:slcats) - bb(1:slcats) = bexp_table(1:slcats) - satpsi(1:slcats) = psisat_table(1:slcats) + ! maxsmc(1:slcats) = smcmax_table(1:slcats) + ! bb(1:slcats) = bexp_table(1:slcats) + ! satpsi(1:slcats) = psisat_table(1:slcats) if (errflg .ne. 0) then print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' @@ -367,7 +367,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo enddo deallocate(stc_updated) - allocate(mask_tile) + deallocate(mask_tile) write(*,'(a,i2)') ' statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me write(*,'(a,i8)') ' soil grid total', lensfc From 619fbc5659fa874c74cda50d59b47828ffad2395 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 18 Jun 2024 12:18:24 -0400 Subject: [PATCH 025/141] fix smc adjustment error --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index f9c767c18..452afc429 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -690,7 +690,8 @@ subroutine read_iau_forcing_all_timesteps(Land_IAU_Control, fname, errmsg, errfl endif enddo - call close_ncfile(ncid) + status =nf90_close(ncid) + call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) end subroutine read_iau_forcing_all_timesteps @@ -792,7 +793,8 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm endif enddo - call close_ncfile(ncid) + status =nf90_close(ncid) + call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) end subroutine read_iau_forcing_fv3 From bc0e3eafd5821aff984ae73d97266026045715bd Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 19 Jun 2024 13:21:56 -0400 Subject: [PATCH 026/141] fix namelist typo --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 452afc429..0acf4ee0b 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -133,14 +133,14 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me logical :: do_land_iau = .false. real(kind=kind_phys) :: land_iau_delthrs = 0 !< iau time interval (to scale increments) character(len=240) :: land_iau_inc_files(7) = '' !< list of increment files - real(kind=kind_phys) :: land_iaufhrs(7) = -1 !< forecast hours associated with increment files + real(kind=kind_phys) :: land_iau_fhrs(7) = -1 !< forecast hours associated with increment files logical :: land_iau_filter_increments = .false. !< filter IAU increments - logical :: gaussian_inc_file = .false. + logical :: land_iau_gaussian_inc_file = .false. integer :: lsoil_incr = 4 - NAMELIST /lnd_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iaufhrs, & - land_iau_filter_increments, & !, lnd_iau_drymassfixer - lsoil_incr, gaussian_inc_file + NAMELIST /lnd_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, land_iau_gaussian_inc_file, & + land_iau_filter_increments, & + lsoil_incr, !Errors messages handled through CCPP error handling variables errmsg = '' @@ -190,9 +190,9 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%do_land_iau = do_land_iau Land_IAU_Control%iau_delthrs = land_iau_delthrs Land_IAU_Control%iau_inc_files = land_iau_inc_files - Land_IAU_Control%iaufhrs = land_iaufhrs + Land_IAU_Control%iaufhrs = land_iau_fhrs Land_IAU_Control%iau_filter_increments = land_iau_filter_increments - ! Land_IAU_Control%iau_drymassfixer = lnd_iau_drymassfixer + Land_IAU_Control%gaussian_inc_file = land_iau_gaussian_inc_file Land_IAU_Control%lsoil_incr = lsoil_incr Land_IAU_Control%me = me @@ -210,7 +210,6 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%input_nml_file = input_nml_file Land_IAU_Control%input_nml_file_length = input_nml_file_length - Land_IAU_Control%gaussian_inc_file = gaussian_inc_file allocate(Land_IAU_Control%blksz(nblks)) allocate(Land_IAU_Control%blk_strt_indx(nblks)) From 7208087b09aaf75da24e3e146c8a03a4453ecd4b Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 19 Jun 2024 14:50:54 -0400 Subject: [PATCH 027/141] fix netcdf dim error --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 0acf4ee0b..ed94e835e 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -140,7 +140,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me NAMELIST /lnd_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, land_iau_gaussian_inc_file, & land_iau_filter_increments, & - lsoil_incr, + lsoil_incr !Errors messages handled through CCPP error handling variables errmsg = '' @@ -359,6 +359,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms jend = max(jend, j1+1) enddo enddo + print*, "proc ", Land_IAU_Control%me, " im ", im, " jbeg jend ", jbeg, jend if (Land_IAU_Control%gaussian_inc_file) then !set up interpolation weights to go from GSI's gaussian grid to cubed sphere From c5e52ddc9fa1bede49dde455d1f1320c17b20360 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 19 Jun 2024 16:27:36 -0400 Subject: [PATCH 028/141] fix netcdf dim error --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 137 +++++++++++------- 1 file changed, 88 insertions(+), 49 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index ed94e835e..62e1d6311 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -33,7 +33,7 @@ module land_iau_mod integer,allocatable,dimension(:,:) :: id1,id2,jdc real(kind=kind_phys) :: deg2rad,dt,rdt - integer :: im,jm,km,nfiles,ncid + integer :: im, jm, km, nfiles, ntimes, ncid integer:: jbeg, jend integer :: n_soill, n_snowl !soil and snow layers @@ -242,7 +242,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms integer:: ib, i, j, k, nstep, kstep integer:: i1, i2, j1 logical:: found - integer nfilesall + integer nfilesall, ntimesall integer, allocatable :: idt(:) real (kind=kind_phys), allocatable :: Init_parm_xlon (:, :) real (kind=kind_phys), allocatable :: Init_parm_xlat (:, :) @@ -286,40 +286,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms allocate(jdc(is:ie,js:je)) allocate(agrid(is:ie,js:je,2)) -! determine number of increment files to read, and the valid forecast hours - nfilesall = size(Land_IAU_Control%iau_inc_files) - nfiles = 0 - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,'in land_iau_init incfile1 iaufhr1 ', & - trim(Land_IAU_Control%iau_inc_files(1)),Land_IAU_Control%iaufhrs(1) - do k=1,nfilesall - if (trim(Land_IAU_Control%iau_inc_files(k)) .eq. '' .or. Land_IAU_Control%iaufhrs(k) .lt. 0) exit - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,k, " ", trim(adjustl(Land_IAU_Control%iau_inc_files(k))) - endif - nfiles = nfiles + 1 - enddo - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'nfiles = ',nfiles - if (nfiles < 1) then - return - endif - if (nfiles > 1) then - allocate(idt(nfiles-1)) - idt = Land_IAU_Control%iaufhrs(2:nfiles)-Land_IAU_Control%iaufhrs(1:nfiles-1) - do k=1,nfiles-1 - if (idt(k) .ne. Land_IAU_Control%iaufhrs(2)-Land_IAU_Control%iaufhrs(1)) then - print *,'in land_iau_init: forecast intervals in iaufhrs must be constant' - ! call mpp_error (FATAL,' forecast intervals in iaufhrs must be constant') - errmsg = 'Fatal error in land_iau_init. forecast intervals in iaufhrs must be constant' - errflg = 1 - return - endif - enddo - deallocate(idt) - endif - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval = ',Land_IAU_Control%iau_delthrs,' hours' - dt = (Land_IAU_Control%iau_delthrs*3600.) - rdt = 1.0/dt - allocate(Land_IAU_Data%stc_inc(is:ie, js:je, km)) allocate(Land_IAU_Data%slc_inc(is:ie, js:je, km)) ! allocate arrays that will hold iau state @@ -348,20 +314,41 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms enddo Land_IAU_state%wt_normfact = (2*nstep+1)/normfact endif - - ! Find bounding latitudes: - jbeg = jm-1 - jend = 2 - do j=js,je - do i=is,ie - j1 = jdc(i,j) - jbeg = min(jbeg, j1) - jend = max(jend, j1+1) - enddo - enddo - print*, "proc ", Land_IAU_Control%me, " im ", im, " jbeg jend ", jbeg, jend - if (Land_IAU_Control%gaussian_inc_file) then + if (Land_IAU_Control%gaussian_inc_file) then + ! determine number of increment files to read, and the valid forecast hours + nfilesall = size(Land_IAU_Control%iau_inc_files) + nfiles = 0 + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,'in land_iau_init incfile1 iaufhr1 ', & + trim(Land_IAU_Control%iau_inc_files(1)),Land_IAU_Control%iaufhrs(1) + do k=1,nfilesall + if (trim(Land_IAU_Control%iau_inc_files(k)) .eq. '' .or. Land_IAU_Control%iaufhrs(k) .lt. 0) exit + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,k, " ", trim(adjustl(Land_IAU_Control%iau_inc_files(k))) + endif + nfiles = nfiles + 1 + enddo + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'nfiles = ',nfiles + if (nfiles < 1) then + return + endif + if (nfiles > 1) then + allocate(idt(nfiles-1)) + idt = Land_IAU_Control%iaufhrs(2:nfiles)-Land_IAU_Control%iaufhrs(1:nfiles-1) + do k=1,nfiles-1 + if (idt(k) .ne. Land_IAU_Control%iaufhrs(2)-Land_IAU_Control%iaufhrs(1)) then + print *,'in land_iau_init: forecast intervals in iaufhrs must be constant' + ! call mpp_error (FATAL,' forecast intervals in iaufhrs must be constant') + errmsg = 'Fatal error in land_iau_init. forecast intervals in iaufhrs must be constant' + errflg = 1 + return + endif + enddo + deallocate(idt) + endif + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval = ',Land_IAU_Control%iau_delthrs,' hours' + dt = (Land_IAU_Control%iau_delthrs*3600.) + rdt = 1.0/dt !set up interpolation weights to go from GSI's gaussian grid to cubed sphere deg2rad = pi/180. ! npz = Land_IAU_Control%levs @@ -411,6 +398,18 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms call remap_coef( is, ie, js, je, is, ie, js, je, & im, jm, lon, lat, id1, id2, jdc, s2c, & agrid) + + ! Find bounding latitudes: + jbeg = jm-1 + jend = 2 + do j=js,je + do i=is,ie + j1 = jdc(i,j) + jbeg = min(jbeg, j1) + jend = max(jend, j1+1) + enddo + enddo + print*, "proc ", Land_IAU_Control%me, " im ", im, " jbeg jend ", jbeg, jend if (allocated(lon)) deallocate (lon) if (allocated(lat)) deallocate (lat) @@ -439,6 +438,46 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(2, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) endif else ! increment files in fv3 tiles + if (trim(Land_IAU_Control%iau_inc_files(1)) .eq. '' .or. Land_IAU_Control%iaufhrs(1) .lt. 0) then ! only 1 file expected + print*, "warning! in Land IAU but increment file name is empty or iaufhrs(1) is negative" + return + endif + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,"increment file ", trim(adjustl(Land_IAU_Control%iau_inc_files(1))) + endif + + ! determine number of increment files to read, and the valid forecast hours + ntimesall = size(Land_IAU_Control%iaufhrs) + ntimes = 0 + do k=1,ntimesall + if (Land_IAU_Control%iaufhrs(k) .lt. 0) exit + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,k, " fhour ", Land_IAU_Control%iaufhrs(k) + endif + ntimes = ntimes + 1 + enddo + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'ntimes = ',ntimes + if (ntimes < 1) then + return + endif + if (ntimes > 1) then + allocate(idt(ntimes-1)) + idt = Land_IAU_Control%iaufhrs(2:ntimes)-Land_IAU_Control%iaufhrs(1:ntimes-1) + do k=1,ntimes-1 + if (idt(k) .ne. Land_IAU_Control%iaufhrs(2)-Land_IAU_Control%iaufhrs(1)) then + print *,'in land_iau_init: forecast intervals in iaufhrs must be constant' + ! call mpp_error (FATAL,' forecast intervals in iaufhrs must be constant') + errmsg = 'Fatal error in land_iau_init. forecast intervals in iaufhrs must be constant' + errflg = 1 + return + endif + enddo + deallocate(idt) + endif + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval = ',Land_IAU_Control%iau_delthrs,' hours' + dt = (Land_IAU_Control%iau_delthrs*3600.) + rdt = 1.0/dt + ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) ! allocate (wk3_slc(n_t, 1:im,jbeg:jend, 1:km)) From 08c49a6d5bfb509af87e9a2fad5bfbc3c2f831ca Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 20 Jun 2024 12:52:50 -0400 Subject: [PATCH 029/141] remove Gaussian files --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 566 ++++-------------- 1 file changed, 123 insertions(+), 443 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 62e1d6311..1f1cb85a0 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -10,7 +10,7 @@ !! \section land_iau_mod !> - reads settings from namelist file (which indicates if IAU increments are available or not) !> - reads in DA increments from GSI/JEDI DA at the start of (the DA) cycle -!> - interpolates increments to FV3 grid points (if increments are in Gaussian grid) +!> - maps increments to FV3 grid points belonging to mpi process !> - interpolates temporally (with filter, weights if required by configuration) !> - updates states with the interpolated increments @@ -28,21 +28,7 @@ module land_iau_mod private - real(kind=kind_phys),allocatable::s2c(:,:,:) - - integer,allocatable,dimension(:,:) :: id1,id2,jdc - - real(kind=kind_phys) :: deg2rad,dt,rdt - integer :: im, jm, km, nfiles, ntimes, ncid - integer:: jbeg, jend - - integer :: n_soill, n_snowl !soil and snow layers - logical :: do_land_iau - - integer :: is, ie, js, je - integer :: npz - - real(kind=kind_phys), allocatable:: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) + real(kind=kind_phys), allocatable :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) type land_iau_internal_data_type real(kind=kind_phys),allocatable :: stc_inc(:,:,:) @@ -52,16 +38,17 @@ module land_iau_mod type land_iau_external_data_type real(kind=kind_phys),allocatable :: stc_inc(:,:,:) real(kind=kind_phys),allocatable :: slc_inc(:,:,:) - logical :: in_interval = .false. + logical :: in_interval = .false. end type land_iau_external_data_type type land_iau_state_type - type(land_iau_internal_data_type):: inc1 - type(land_iau_internal_data_type):: inc2 - real(kind=kind_phys) :: hr1 - real(kind=kind_phys) :: hr2 - real(kind=kind_phys) :: wt - real(kind=kind_phys) :: wt_normfact + type(land_iau_internal_data_type) :: inc1 + type(land_iau_internal_data_type) :: inc2 + real(kind=kind_phys) :: hr1 + real(kind=kind_phys) :: hr2 + real(kind=kind_phys) :: wt + real(kind=kind_phys) :: wt_normfact + real(kind=kind_phys) :: rdt end type land_iau_state_type type land_iau_control_type @@ -74,7 +61,7 @@ module land_iau_mod integer, allocatable :: blksz(:) ! this could vary for the last block integer, allocatable :: blk_strt_indx(:) - integer :: lsoil !< number of soil layers + integer :: lsoil !< number of soil layers ! this is the max dim (TBC: check it is consitent for noahmpdrv) integer :: lsnow_lsm !< maximum number of snow layers internal to land surface model logical :: do_land_iau @@ -108,7 +95,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) !nlunit type (land_iau_control_type), intent(inout) :: Land_IAU_Control - character(*), intent(in) :: fn_nml !< namelist filename for surface data cycling + character(*), intent(in) :: fn_nml !< namelist filename for surface data cycling character(len=:), intent(in), dimension(:), pointer :: input_nml_file_i integer, intent(in) :: me, mpi_root !< MPI rank of master atmosphere processor integer, intent(in) :: isc, jsc, nx, ny, tile_num, nblks, lsoil, lsnow_lsm @@ -125,7 +112,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me character(len=512) :: ioerrmsg !character(len=32) :: fn_nml = "input.nml" character(len=:), pointer, dimension(:) :: input_nml_file => null() - integer :: input_nml_file_length !< length(number of lines) in namelist for internal reads + integer :: input_nml_file_length !< length(number of lines) in namelist for internal reads !> these are not available through the CCPP interface so need to read them from namelist file @@ -135,10 +122,10 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me character(len=240) :: land_iau_inc_files(7) = '' !< list of increment files real(kind=kind_phys) :: land_iau_fhrs(7) = -1 !< forecast hours associated with increment files logical :: land_iau_filter_increments = .false. !< filter IAU increments - logical :: land_iau_gaussian_inc_file = .false. + !logical :: land_iau_gaussian_inc_file = .false. integer :: lsoil_incr = 4 - NAMELIST /lnd_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, land_iau_gaussian_inc_file, & + NAMELIST /lnd_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, & !land_iau_gaussian_inc_file, & land_iau_filter_increments, & lsoil_incr @@ -230,27 +217,29 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms ! integer, intent(in) :: me, mpi_root type (land_iau_control_type), intent(in) :: Land_IAU_Control type (land_iau_external_data_type), intent(inout) :: Land_IAU_Data - real(kind=kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon - real(kind=kind_phys), dimension(:), intent(in) :: xlat ! latitude - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + real(kind=kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon + real(kind=kind_phys), dimension(:), intent(in) :: xlat ! latitude + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! local - character(len=128) :: fname - real(kind=kind_phys), allocatable:: lat(:), lon(:),agrid(:,:,:) - real(kind=kind_phys) sx,wx,wt,normfact,dtp - integer:: ib, i, j, k, nstep, kstep - integer:: i1, i2, j1 - logical:: found - integer nfilesall, ntimesall - integer, allocatable :: idt(:) - real (kind=kind_phys), allocatable :: Init_parm_xlon (:, :) - real (kind=kind_phys), allocatable :: Init_parm_xlat (:, :) - integer :: nlon, nlat + character(len=128) :: fname + real(kind=kind_phys) :: sx, wx, wt, normfact, dtp + integer :: k, nstep, kstep + integer :: nfilesall, ntimesall + integer, allocatable :: idt(:) + integer :: nlon, nlat ! integer :: nb, ix, nblks, blksz - logical :: exists - ! necdf vars - integer :: ncid, dimid, varid, status, IDIM + logical :: exists + integer :: ncid, dimid, varid, status, IDIM + + real(kind=kind_phys) :: dt, rdt + integer :: im, jm, km, nfiles, ntimes + + integer :: n_soill, n_snowl !soil and snow layers + logical :: do_land_iau + integer :: is, ie, js, je + integer :: npz !Errors messages handled through CCPP error handling variables errmsg = '' @@ -270,22 +259,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms !nblks = Land_IAU_Control%nblks !blksz = Land_IAU_Control%blksz(1) - allocate(Init_parm_xlon(nlon,nlat), Init_parm_xlat(nlon,nlat)) - ib = 1 - do j = 1, nlat !ny - ! do i = 1, nx - Init_parm_xlon (:,j) = xlon(ib:ib+nlon-1) - Init_parm_xlat (:,j) = xlat(ib:ib+nlon-1) - ib = ib+nlon - ! enddo - enddo - - allocate(s2c(is:ie,js:je,4)) - allocate(id1(is:ie,js:je)) - allocate(id2(is:ie,js:je)) - allocate(jdc(is:ie,js:je)) - allocate(agrid(is:ie,js:je,2)) - allocate(Land_IAU_Data%stc_inc(is:ie, js:je, km)) allocate(Land_IAU_Data%slc_inc(is:ie, js:je, km)) ! allocate arrays that will hold iau state @@ -314,196 +287,70 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errms enddo Land_IAU_state%wt_normfact = (2*nstep+1)/normfact endif - - if (Land_IAU_Control%gaussian_inc_file) then - ! determine number of increment files to read, and the valid forecast hours - nfilesall = size(Land_IAU_Control%iau_inc_files) - nfiles = 0 - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,'in land_iau_init incfile1 iaufhr1 ', & - trim(Land_IAU_Control%iau_inc_files(1)),Land_IAU_Control%iaufhrs(1) - do k=1,nfilesall - if (trim(Land_IAU_Control%iau_inc_files(k)) .eq. '' .or. Land_IAU_Control%iaufhrs(k) .lt. 0) exit - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,k, " ", trim(adjustl(Land_IAU_Control%iau_inc_files(k))) - endif - nfiles = nfiles + 1 - enddo - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'nfiles = ',nfiles - if (nfiles < 1) then - return - endif - if (nfiles > 1) then - allocate(idt(nfiles-1)) - idt = Land_IAU_Control%iaufhrs(2:nfiles)-Land_IAU_Control%iaufhrs(1:nfiles-1) - do k=1,nfiles-1 - if (idt(k) .ne. Land_IAU_Control%iaufhrs(2)-Land_IAU_Control%iaufhrs(1)) then - print *,'in land_iau_init: forecast intervals in iaufhrs must be constant' - ! call mpp_error (FATAL,' forecast intervals in iaufhrs must be constant') - errmsg = 'Fatal error in land_iau_init. forecast intervals in iaufhrs must be constant' - errflg = 1 - return - endif - enddo - deallocate(idt) - endif - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval = ',Land_IAU_Control%iau_delthrs,' hours' - dt = (Land_IAU_Control%iau_delthrs*3600.) - rdt = 1.0/dt - !set up interpolation weights to go from GSI's gaussian grid to cubed sphere - deg2rad = pi/180. - ! npz = Land_IAU_Control%levs - fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1)) - inquire (file=trim(fname), exist=exists) - if (exists) then ! if( file_exist(fname) ) then - ! call open_ncfile( fname, ncid ) - status = nf90_open(trim(fname), NF90_NOWRITE, ncid) ! open the file - call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) - if (errflg .ne. 0) return - call get_nc_dimlen(ncid, "longitude", im, errflg, errmsg) - if (errflg .ne. 0) return - call get_nc_dimlen(ncid, "latitude", jm, errflg, errmsg) - if (errflg .ne. 0) return - km = n_soill - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) write(*,*) fname, ' DA increment dimensions:', im,jm,km - allocate (lon(im) ) - allocate (lat(jm) ) - call get_var1d(ncid, im, "longitude", lon, errflg, errmsg) - if (errflg .ne. 0) return - call get_var1d(ncid, jm, "latitude", lat, errflg, errmsg) - if (errflg .ne. 0) return - status = nf90_close(ncid) - CALL netcdf_err(status, 'closing file: '//trim(fname) , errflg, errmsg) - if (errflg .ne. 0) return - ! Convert to radians - do i=1,im - lon(i) = lon(i) * deg2rad - enddo - do j=1,jm - lat(j) = lat(j) * deg2rad - enddo - else - errmsg = 'FATAL Error in Land_IAU_initialize: Expected file '// trim(fname)//' for DA increment does not exist' - errflg = 1 - return - endif - ! Initialize lat-lon to Cubed bi-linear interpolation coeff: - do j = 1,size(Init_parm_xlon,2) - do i = 1,size(Init_parm_xlon,1) - ! print*,i,j,is-1+j,js-1+j - agrid(is-1+i,js-1+j,1)=Init_parm_xlon(i,j) - agrid(is-1+i,js-1+j,2)=Init_parm_xlat(i,j) - enddo - enddo - call remap_coef( is, ie, js, je, is, ie, js, je, & - im, jm, lon, lat, id1, id2, jdc, s2c, & - agrid) - - ! Find bounding latitudes: - jbeg = jm-1 - jend = 2 - do j=js,je - do i=is,ie - j1 = jdc(i,j) - jbeg = min(jbeg, j1) - jend = max(jend, j1+1) - enddo - enddo - print*, "proc ", Land_IAU_Control%me, " im ", im, " jbeg jend ", jbeg, jend + ! increment files in fv3 tiles + if (trim(Land_IAU_Control%iau_inc_files(1)) .eq. '' .or. Land_IAU_Control%iaufhrs(1) .lt. 0) then ! only 1 file expected + print*, "warning! in Land IAU but increment file name is empty or iaufhrs(1) is negative" + return + endif + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,"increment file ", trim(adjustl(Land_IAU_Control%iau_inc_files(1))) + endif - if (allocated(lon)) deallocate (lon) - if (allocated(lat)) deallocate (lat) - if (allocated(agrid)) deallocate (agrid) - if (allocated(Init_parm_xlon)) deallocate(Init_parm_xlon) - if (allocated(Init_parm_xlat)) deallocate(Init_parm_xlat) - - ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid - allocate (wk3_stc(nfiles, 1:im,jbeg:jend, 1:km)) - allocate (wk3_slc(nfiles, 1:im,jbeg:jend, 1:km)) - do k=1, nfiles - call read_iau_forcing_all_timesteps(Land_IAU_Control, & - 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(k)), errmsg, errflg, & - wk3_stc(k, :, :, :), wk3_slc(k, :, :, :)) - enddo - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(1, :, :, :), Land_IAU_state%inc1%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(1, :, :, :), Land_IAU_state%inc1%slc_inc, errmsg, errflg) - if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window - call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%wt) - endif - if (nfiles.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them - allocate (Land_IAU_state%inc2%stc_inc(is:ie, js:je, km)) - allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) - Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(2, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(2, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) - endif - else ! increment files in fv3 tiles - if (trim(Land_IAU_Control%iau_inc_files(1)) .eq. '' .or. Land_IAU_Control%iaufhrs(1) .lt. 0) then ! only 1 file expected - print*, "warning! in Land IAU but increment file name is empty or iaufhrs(1) is negative" - return - endif + ! determine number of valid forecast hours + ntimesall = size(Land_IAU_Control%iaufhrs) + ntimes = 0 + do k=1,ntimesall + if (Land_IAU_Control%iaufhrs(k) .lt. 0) exit if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,"increment file ", trim(adjustl(Land_IAU_Control%iau_inc_files(1))) + print *,k, " fhour ", Land_IAU_Control%iaufhrs(k) endif - - ! determine number of increment files to read, and the valid forecast hours - ntimesall = size(Land_IAU_Control%iaufhrs) - ntimes = 0 - do k=1,ntimesall - if (Land_IAU_Control%iaufhrs(k) .lt. 0) exit - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,k, " fhour ", Land_IAU_Control%iaufhrs(k) + ntimes = ntimes + 1 + enddo + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'ntimes = ',ntimes + if (ntimes < 1) then + return + endif + if (ntimes > 1) then + allocate(idt(ntimes-1)) + idt = Land_IAU_Control%iaufhrs(2:ntimes)-Land_IAU_Control%iaufhrs(1:ntimes-1) + do k=1,ntimes-1 + if (idt(k) .ne. Land_IAU_Control%iaufhrs(2)-Land_IAU_Control%iaufhrs(1)) then + print *,'in land_iau_init: forecast intervals in iaufhrs must be constant' + ! call mpp_error (FATAL,' forecast intervals in iaufhrs must be constant') + errmsg = 'Fatal error in land_iau_init. forecast intervals in iaufhrs must be constant' + errflg = 1 + return endif - ntimes = ntimes + 1 enddo - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'ntimes = ',ntimes - if (ntimes < 1) then - return - endif - if (ntimes > 1) then - allocate(idt(ntimes-1)) - idt = Land_IAU_Control%iaufhrs(2:ntimes)-Land_IAU_Control%iaufhrs(1:ntimes-1) - do k=1,ntimes-1 - if (idt(k) .ne. Land_IAU_Control%iaufhrs(2)-Land_IAU_Control%iaufhrs(1)) then - print *,'in land_iau_init: forecast intervals in iaufhrs must be constant' - ! call mpp_error (FATAL,' forecast intervals in iaufhrs must be constant') - errmsg = 'Fatal error in land_iau_init. forecast intervals in iaufhrs must be constant' - errflg = 1 - return - endif - enddo - deallocate(idt) - endif - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval = ',Land_IAU_Control%iau_delthrs,' hours' - dt = (Land_IAU_Control%iau_delthrs*3600.) - rdt = 1.0/dt - - ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid - ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) - ! allocate (wk3_slc(n_t, 1:im,jbeg:jend, 1:km)) - call read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errflg) - ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) - - ! increments already in the fv3 modele grid--no need for interpolation - Land_IAU_state%inc1%stc_inc(:, :, :) = wk3_stc(1, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - Land_IAU_state%inc1%slc_inc(:, :, :) = wk3_slc(1, :, :, :) - ! call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(1, :, :, :), Land_IAU_state%inc1%stc_inc, errmsg, errflg) - ! call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(1, :, :, :), Land_IAU_state%inc1%slc_inc, errmsg, errflg) - if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window - call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%wt) - endif - if (nfiles.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them - allocate (Land_IAU_state%inc2%stc_inc(is:ie, js:je, km)) - allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) - Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) - - Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(2, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(2, :, :, :) - ! call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(2, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) - ! call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(2, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) - endif + deallocate(idt) endif + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval = ',Land_IAU_Control%iau_delthrs,' hours' + dt = (Land_IAU_Control%iau_delthrs*3600.) + rdt = 1.0/dt + Land_IAU_state%rdt = rdt + + ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid + ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) + ! allocate (wk3_slc(n_t, 1:im,jbeg:jend, 1:km)) + call read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errflg) + ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) + + ! increments already in the fv3 modele grid--no need for interpolation + Land_IAU_state%inc1%stc_inc(:, :, :) = wk3_stc(1, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) + Land_IAU_state%inc1%slc_inc(:, :, :) = wk3_slc(1, :, :, :) + if (nfiles.EQ.1) then ! only need to get incrments once since constant forcing over window + call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%rdt, Land_IAU_state%wt) + endif + if (nfiles.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them + allocate (Land_IAU_state%inc2%stc_inc(is:ie, js:je, km)) + allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) + Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) + + Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(2, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) + Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(2, :, :, :) + endif ! print*,'end of IAU init',dt,rdt end subroutine land_iau_mod_init @@ -514,8 +361,8 @@ subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, errmsg, errflg type (land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg if (allocated (wk3_stc)) deallocate (wk3_stc) if (allocated (wk3_slc)) deallocate (wk3_slc) @@ -536,8 +383,8 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e implicit none type (land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg real(kind=kind_phys) t1,t2,sx,wx,wt,dtp integer n,i,j,k,kstep,nstep,itnext @@ -585,7 +432,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',t1,Land_IAU_Control%fhour,t2 Land_IAU_Data%in_interval=.false. else - if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control,Land_IAU_Data,Land_IAU_state%wt) + if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control,Land_IAU_Data, Land_IAU_state%rdt, Land_IAU_state%wt) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact Land_IAU_Data%in_interval=.true. endif @@ -612,28 +459,31 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e Land_IAU_state%inc1=Land_IAU_state%inc2 ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'reading next lnd iau increment file',trim(Land_IAU_Control%iau_inc_files(itnext)) - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'copying/interpolating next lnd iau increment ', itnext !trim(Land_IAU_Control%iau_inc_files(itnext)) - if (Land_IAU_Control%gaussian_inc_file) then - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_stc(itnext, :, :, :), Land_IAU_state%inc2%stc_inc, errmsg, errflg) - call interp_inc_at_timestep(Land_IAU_Control, km, wk3_slc(itnext, :, :, :), Land_IAU_state%inc2%slc_inc, errmsg, errflg) - else - Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'copying next lnd iau increment ', itnext !trim(Land_IAU_Control%iau_inc_files(itnext)) + Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) + Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) endif endif - call updateiauforcing(Land_IAU_Control,Land_IAU_Data,Land_IAU_state%wt) + call updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%rdt, Land_IAU_state%wt) endif endif end subroutine land_iau_mod_getiauforcing -subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, wt) +subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) implicit none type (land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data - real(kind=kind_phys) delt, wt - integer i,j,k,l + real(kind=kind_phys) delt, rdt, wt + integer i,j,k + integer :: is, ie, js, je + + is = Land_IAU_Control%isc + ie = is + Land_IAU_Control%nx-1 + js = Land_IAU_Control%jsc + je = js + Land_IAU_Control%ny-1 + npz = Land_IAU_Control%lsoil ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in updateiauforcing',nfiles,Land_IAU_Control%iaufhrs(1:nfiles) delt = (Land_IAU_state%hr2-(Land_IAU_Control%fhour))/(Land_IAU_state%hr2-Land_IAU_state%hr1) @@ -647,18 +497,25 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, wt) enddo end subroutine updateiauforcing - subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, wt) + subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) implicit none type (land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data - real(kind=kind_phys) delt, dt,wt - integer i,j,k,l + real(kind=kind_phys) delt, rdt,wt + integer i, j, k + integer :: is, ie, js, je + + is = Land_IAU_Control%isc + ie = is + Land_IAU_Control%nx-1 + js = Land_IAU_Control%jsc + je = js + Land_IAU_Control%ny-1 + npz = Land_IAU_Control%lsoil ! this is only called if using 1 increment file if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau setiauforcing rdt = ',rdt - do j = js,je - do i = is,ie - do k = 1,npz ! do k = 1,n_soill ! + do j = js, je + do i = is, ie + do k = 1, npz ! do k = 1,n_soill ! Land_IAU_Data%stc_inc(i,j,k) = wt*Land_IAU_state%inc1%stc_inc(i,j,k)*rdt Land_IAU_Data%slc_inc(i,j,k) = wt*Land_IAU_state%inc1%slc_inc(i,j,k)*rdt end do @@ -667,73 +524,6 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, wt) end subroutine setiauforcing -subroutine read_iau_forcing_all_timesteps(Land_IAU_Control, fname, errmsg, errflg, & - wk3_out_stc, wk3_out_slc) !, fname_sfc) is, ie, js, je, ks,ke, - type (land_iau_control_type), intent(in) :: Land_IAU_Control - character(len=*), intent(in) :: fname - character(len=*), intent(inout) :: errmsg - integer, intent(inout) :: errflg - real(kind=kind_phys), intent(out) :: wk3_out_stc(1:im, jbeg:jend, 1:km) - real(kind=kind_phys), intent(out) :: wk3_out_slc(1:im, jbeg:jend, 1:km) - - integer :: i, j, k, l, npz - integer :: i1, i2, j1 - logical :: exists - integer :: ncid, status, varid - integer :: ierr - - character(len=32), dimension(4) :: stc_vars = [character(len=32) :: 'soilt1_inc', 'soilt2_inc', 'soilt3_inc', 'soilt4_inc'] - character(len=32), dimension(4) :: slc_vars = [character(len=32) :: 'slc1_inc', 'slc2_inc', 'slc3_inc', 'slc4_inc'] - - !Errors messages handled through CCPP error handling variables - errmsg = '' - errflg = 0 - - inquire (file=trim(fname), exist=exists) - if (exists) then - status = nf90_open(trim(fname), NF90_NOWRITE, ncid) ! open the file - call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) - if (errflg .ne. 0) return - else - errmsg = 'FATAL Error in land iau read_iau_forcing_all_timesteps: Expected file '//trim(fname)//' for DA increment does not exist' - errflg = 1 - return - endif - - do i = 1, size(stc_vars) - print *, trim(stc_vars(i)) - ! call check_var_exists(ncid, trim(stc_vars(i)), ierr) - status = nf90_inq_varid(ncid, trim(stc_vars(i)), varid) - if (status == nf90_noerr) then !if (ierr == 0) then - call get_var3d_values(ncid, varid, 1,im, jbeg,jend, 1,1, wk3_out_stc(:, :, i), status) - call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg) - if (errflg .ne. 0) return - else - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, & - 'warning: no increment for ',trim(stc_vars(i)),' found, assuming zero' - wk3_out_stc(:, :, i) = 0. - endif - enddo - do i = 1, size(slc_vars) - print *, trim(slc_vars(i)) - status = nf90_inq_varid(ncid, trim(slc_vars(i)), varid) - if (status == nf90_noerr) then !if (ierr == 0) then - ! call get_var3_r4( ncid, trim(slc_vars(i)), 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i) ) - call get_var3d_values(ncid, varid, 1,im, jbeg,jend, 1,1, wk3_out_slc(:, :, i), status) - call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg) - if (errflg .ne. 0) return - else - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,& - 'warning: no increment for ',trim(slc_vars(i)),' found, assuming zero' - wk3_out_slc(:, :, i) = 0. - endif - enddo - - status =nf90_close(ncid) - call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) - -end subroutine read_iau_forcing_all_timesteps - subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errmsg, errflg) type (land_iau_control_type), intent(in) :: Land_IAU_Control @@ -835,118 +625,8 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm status =nf90_close(ncid) call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) - end subroutine read_iau_forcing_fv3 -subroutine interp_inc_at_timestep(Land_IAU_Control, km_in, wk3_in, var, errmsg, errflg) !field_name, , jbeg, jend) - ! interpolate increment from GSI gaussian grid to cubed sphere - ! everying is on the A-grid, earth relative - type (land_iau_control_type), intent(in) :: Land_IAU_Control - ! character(len=*), intent(in) :: field_name - integer, intent(in) :: km_in !jbeg,jend - real(kind=kind_phys), intent(in) :: wk3_in(1:im,jbeg:jend, 1:km_in) - real(kind=kind_phys), dimension(is:ie, js:je, 1:km), intent(inout) :: var - - character(len=*), intent(inout) :: errmsg - integer, intent(inout) :: errflg - integer:: i1, i2, j1, k, j, i - - do k=1,km_in - do j=js,je - do i=is,ie - i1 = id1(i,j) - i2 = id2(i,j) - j1 = jdc(i,j) - var(i,j,k) = s2c(i,j,1)*wk3_in(i1,j1 ,k) + s2c(i,j,2)*wk3_in(i2,j1 ,k)+& - s2c(i,j,3)*wk3_in(i2,j1+1,k) + s2c(i,j,4)*wk3_in(i1,j1+1,k) - enddo - enddo - enddo -end subroutine interp_inc_at_timestep - -!> This subroutine is copied from 'fv_treat_da_inc.F90 by Xi.Chen -! copying it here, due to inability to 'include' from the original module when the land iau mod is called through CCPP frameowrk -!> @author Xi.Chen !> @date 02/12/2016 - !============================================================================= - !>@brief The subroutine 'remap_coef' calculates the coefficients for horizonal regridding. - subroutine remap_coef( is, ie, js, je, isd, ied, jsd, jed, & - im, jm, lon, lat, id1, id2, jdc, s2c, agrid ) - - integer, intent(in):: is, ie, js, je, isd, ied, jsd, jed - integer, intent(in):: im, jm - real(kind=kind_phys), intent(in):: lon(im), lat(jm) - real(kind=kind_phys), intent(out):: s2c(is:ie,js:je,4) - integer, intent(out), dimension(is:ie,js:je):: id1, id2, jdc - real(kind=kind_phys), intent(in):: agrid(isd:ied,jsd:jed,2) - ! local: - real(kind=kind_phys) :: rdlon(im) - real(kind=kind_phys) :: rdlat(jm) - real(kind=kind_phys):: a1, b1 - integer i,j, i1, i2, jc, i0, j0 - do i=1,im-1 - rdlon(i) = 1. / (lon(i+1) - lon(i)) - enddo - rdlon(im) = 1. / (lon(1) + 2.*pi - lon(im)) - - do j=1,jm-1 - rdlat(j) = 1. / (lat(j+1) - lat(j)) - enddo - - ! * Interpolate to cubed sphere cell center - do 5000 j=js,je - - do i=is,ie - - if ( agrid(i,j,1)>lon(im) ) then - i1 = im; i2 = 1 - a1 = (agrid(i,j,1)-lon(im)) * rdlon(im) - elseif ( agrid(i,j,1)=lon(i0) .and. agrid(i,j,1)<=lon(i0+1) ) then - i1 = i0; i2 = i0+1 - a1 = (agrid(i,j,1)-lon(i1)) * rdlon(i0) - go to 111 - endif - enddo - endif -111 continue - - if ( agrid(i,j,2)lat(jm) ) then - jc = jm-1 - b1 = 1. - else - do j0=1,jm-1 - if ( agrid(i,j,2)>=lat(j0) .and. agrid(i,j,2)<=lat(j0+1) ) then - jc = j0 - b1 = (agrid(i,j,2)-lat(jc)) * rdlat(jc) - go to 222 - endif - enddo - endif -222 continue - - if ( a1<0.0 .or. a1>1.0 .or. b1<0.0 .or. b1>1.0 ) then -!TODO uncomment and fix mpp_pe write(*,*) 'gid=', mpp_pe(), i,j,a1, b1 - endif - - s2c(i,j,1) = (1.-a1) * (1.-b1) - s2c(i,j,2) = a1 * (1.-b1) - s2c(i,j,3) = a1 * b1 - s2c(i,j,4) = (1.-a1) * b1 - id1(i,j) = i1 - id2(i,j) = i2 - jdc(i,j) = jc - enddo !i-loop -5000 continue ! j-loop - - end subroutine remap_coef - !> Calculate soil mask for land on model grid. !! Output is 1 - soil, 2 - snow-covered, 0 - land ice, -1 not land. !! From bb02763ced6c1c2cb38982490a0c39052b5e4de2 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 20 Jun 2024 12:55:21 -0400 Subject: [PATCH 030/141] remove Gaussian files --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 6 +++--- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 1f1cb85a0..51661b867 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -213,12 +213,12 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me end subroutine land_iau_mod_set_control -subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errmsg, errflg) !nlunit, ncols, IPD_Data,,Init_parm) +subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !nlunit, ncols, IPD_Data,,Init_parm) ! integer, intent(in) :: me, mpi_root type (land_iau_control_type), intent(in) :: Land_IAU_Control type (land_iau_external_data_type), intent(inout) :: Land_IAU_Data - real(kind=kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon - real(kind=kind_phys), dimension(:), intent(in) :: xlat ! latitude + ! real(kind=kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon + ! real(kind=kind_phys), dimension(:), intent(in) :: xlat ! latitude character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index cb38dbfb4..ae0772032 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -142,7 +142,7 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & me, mpi_root, isc,jsc, nx, ny, tile_num, nblks, blksz, & lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) ! Initialize IAU for land - call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, xlon, xlat, errmsg, errflg) + call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) ! xlon, xlat, errmsg, errflg) end subroutine noahmpdrv_init From 651fb26928b93e21e2b1b37108f96cb7249a7aee Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 20 Jun 2024 15:38:15 -0400 Subject: [PATCH 031/141] remove Gaussian files --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 32 +++++++++++-------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 51661b867..a1a9f6cbd 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -79,8 +79,8 @@ module land_iau_mod character(len=:), pointer, dimension(:) :: input_nml_file => null() ! Date: Thu, 20 Jun 2024 16:07:27 -0400 Subject: [PATCH 032/141] debug memory --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index a1a9f6cbd..77e6894c5 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -214,7 +214,7 @@ end subroutine land_iau_mod_set_control subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !nlunit, ncols, IPD_Data,,Init_parm) ! integer, intent(in) :: me, mpi_root - type (land_iau_control_type), intent(in) :: Land_IAU_Control + type (land_iau_control_type), intent(inout) :: Land_IAU_Control type (land_iau_external_data_type), intent(inout) :: Land_IAU_Data ! real(kind=kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon ! real(kind=kind_phys), dimension(:), intent(in) :: xlat ! latitude @@ -401,7 +401,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e t2 = Land_IAU_Control%iaufhrs(1)+0.5*Land_IAU_Control%iau_delthrs else t1 = Land_IAU_Control%iaufhrs(1) - t2 = Land_IAU_Control%iaufhrs(nfiles) + t2 = Land_IAU_Control%iaufhrs(ntimes) endif if (Land_IAU_Control%iau_filter_increments) then ! compute increment filter weight From c3066284e329901b1f5adc1a78b8d13b966a304b Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 21 Jun 2024 10:15:41 -0400 Subject: [PATCH 033/141] fix fv3 file error --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 77e6894c5..475c1101d 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -555,7 +555,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm write(tile_str, '(I0)') Land_IAU_Control%tile_num - fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1))//".tile"//tile_str//".nc" + fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1))//".tile"//trim(tile_str)//".nc" ! isc = Land_IAU_Control%isc ! jsc = Land_IAU_Control%jsc From 9a94c579cfdcc5b80e3aab1c7cb60dbee522fcbc Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 21 Jun 2024 10:57:10 -0400 Subject: [PATCH 034/141] fix fv3 file error --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 475c1101d..edbf200a5 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -750,10 +750,10 @@ subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) end subroutine get_var1d - subroutine get_var3d_values(ncid, varid, is,ie, js,je, ks,ke, var3d, status) + subroutine get_var3d_values(ncid, varid, is,ix, js,jx, ks,kz, var3d, status) integer, intent(in):: ncid, varid - integer, intent(in):: is, ie, js, je, ks,ke - real(kind=kind_phys), intent(out):: var3d(is:ie,js:je,ks:ke) + integer, intent(in):: is, ix, js, jy, ks,kz + real(kind=kind_phys), intent(out):: var3d(ix, jy, kz) !var3d(is:ie,js:je,ks:ke) integer, intent(out):: status ! integer, dimension(3):: start, nreco ! start(1) = is; start(2) = js; start(3) = ks @@ -762,7 +762,8 @@ subroutine get_var3d_values(ncid, varid, is,ie, js,je, ks,ke, var3d, status) ! nreco(3) = ke - ks + 1 status = nf90_get_var(ncid, varid, var3d, & !start = start, count = nreco) - start = (/is, js, ks/), count = (/ie - is + 1, je - js + 1, ke - ks + 1/)) + start = (/is, js, ks/), count = (/ix, jy, kz/)) + ! start = (/is, js, ks/), count = (/ie - is + 1, je - js + 1, ke - ks + 1/)) end subroutine get_var3d_values From f5de22f69d21f408640ed5c70e1b3bc169b293b6 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 21 Jun 2024 11:09:50 -0400 Subject: [PATCH 035/141] fix fv3 file error --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index edbf200a5..c194ab7ae 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -750,7 +750,7 @@ subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) end subroutine get_var1d - subroutine get_var3d_values(ncid, varid, is,ix, js,jx, ks,kz, var3d, status) + subroutine get_var3d_values(ncid, varid, is,ix, js,jy, ks,kz, var3d, status) integer, intent(in):: ncid, varid integer, intent(in):: is, ix, js, jy, ks,kz real(kind=kind_phys), intent(out):: var3d(ix, jy, kz) !var3d(is:ie,js:je,ks:ke) From 98d872b6397e3e5214738ba038dfb295cf67f627 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sat, 22 Jun 2024 09:01:45 -0400 Subject: [PATCH 036/141] add land iau conditions --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index ae0772032..801f195f6 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -137,6 +137,8 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & pores (:) = maxsmc (:) resid (:) = drysmc (:) + if (.not. Land_IAU_Control%do_land_iau) return + ! Read Land IAU settings call land_iau_mod_set_control(Land_IAU_Control, fn_nml, input_nml_file, & me, mpi_root, isc,jsc, nx, ny, tile_num, nblks, blksz, & @@ -228,6 +230,8 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! --- Initialize CCPP error handling variables errmsg = '' errflg = 0 + + if (.not. Land_IAU_Control%do_land_iau) return !> update current forecast hour ! GFS_control%jdat(:) = jdat(:) @@ -419,6 +423,8 @@ subroutine noahmpdrv_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, ! --- Initialize CCPP error handling variables errmsg = '' errflg = 0 + + if (.not. Land_IAU_Control%do_land_iau) return call land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !Land_IAU_Control%finalize() end subroutine noahmpdrv_finalize From f59bf592e32f4e06e30ecc34c09914e3971823f6 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sat, 22 Jun 2024 10:14:38 -0400 Subject: [PATCH 037/141] add land iau conditions --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 23 +++++++++++-------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 4 ++-- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index c194ab7ae..c395d46f2 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -257,6 +257,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) nlat = Land_IAU_Control%ny !nblks = Land_IAU_Control%nblks !blksz = Land_IAU_Control%blksz(1) + print*, "proc is ie js je ",Land_IAU_Control%me, is, ie, js, je allocate(Land_IAU_Data%stc_inc(is:ie, js:je, km)) allocate(Land_IAU_Data%slc_inc(is:ie, js:je, km)) @@ -331,12 +332,11 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) Land_IAU_state%rdt = rdt ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid - ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) - ! allocate (wk3_slc(n_t, 1:im,jbeg:jend, 1:km)) + ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) call read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errflg) ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) - ! increments already in the fv3 modele grid--no need for interpolation + ! increments already in the fv3 grid--no need for interpolation Land_IAU_state%inc1%stc_inc(:, :, :) = wk3_stc(1, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) Land_IAU_state%inc1%slc_inc(:, :, :) = wk3_slc(1, :, :, :) @@ -480,14 +480,17 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) real(kind=kind_phys) delt, rdt, wt integer i,j,k integer :: is, ie, js, je, npz + integer :: ntimes - is = Land_IAU_Control%isc + is = 1 !Land_IAU_Control%isc ie = is + Land_IAU_Control%nx-1 - js = Land_IAU_Control%jsc + js = 1 !Land_IAU_Control%jsc je = js + Land_IAU_Control%ny-1 npz = Land_IAU_Control%lsoil -! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in updateiauforcing',nfiles,Land_IAU_Control%iaufhrs(1:nfiles) + ntimes = Land_IAU_Control%ntimes + + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes) delt = (Land_IAU_state%hr2-(Land_IAU_Control%fhour))/(Land_IAU_state%hr2-Land_IAU_state%hr1) do j = js,je do i = is,ie @@ -508,9 +511,9 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) integer i, j, k integer :: is, ie, js, je, npz - is = Land_IAU_Control%isc + is = 1 !Land_IAU_Control%isc ie = is + Land_IAU_Control%nx-1 - js = Land_IAU_Control%jsc + js = 1 !Land_IAU_Control%jsc je = js + Land_IAU_Control%ny-1 npz = Land_IAU_Control%lsoil ! this is only called if using 1 increment file @@ -592,7 +595,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm allocate(slc_inc_out(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) do i = 1, size(stc_vars) - print *, trim(stc_vars(i)) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(stc_vars(i)) ! call check_var_exists(ncid, trim(stc_vars(i)), ierr) status = nf90_inq_varid(ncid, trim(stc_vars(i)), varid) if (status == nf90_noerr) then !if (ierr == 0) then @@ -610,7 +613,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm endif enddo do i = 1, size(slc_vars) - print *, trim(slc_vars(i)) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(slc_vars(i)) status = nf90_inq_varid(ncid, trim(slc_vars(i)), varid) if (status == nf90_noerr) then !if (ierr == 0) then do it = 1, n_t diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 801f195f6..dd2976e1b 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -280,7 +280,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! delt=GFS_Control%dtf if ((Land_IAU_Control%dtp - delt) > 0.0001) then if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "Warning noahmpdrv_run delt ",delt,"different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp + print*, "Warning noahmpdrv_run delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp endif endif @@ -423,7 +423,7 @@ subroutine noahmpdrv_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, ! --- Initialize CCPP error handling variables errmsg = '' errflg = 0 - + if (.not. Land_IAU_Control%do_land_iau) return call land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !Land_IAU_Control%finalize() From f40cebc1d6574c1420d8a5c56578e0d1fe031c18 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sat, 22 Jun 2024 10:39:41 -0400 Subject: [PATCH 038/141] add land iau conditions --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index dd2976e1b..bfd90f03e 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -137,13 +137,12 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & pores (:) = maxsmc (:) resid (:) = drysmc (:) - if (.not. Land_IAU_Control%do_land_iau) return - ! Read Land IAU settings call land_iau_mod_set_control(Land_IAU_Control, fn_nml, input_nml_file, & me, mpi_root, isc,jsc, nx, ny, tile_num, nblks, blksz, & lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) ! Initialize IAU for land + if (.not. Land_IAU_Control%do_land_iau) return call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) ! xlon, xlat, errmsg, errflg) end subroutine noahmpdrv_init From efad815958f09e7142623d9b8bd5291259eec6c5 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sat, 22 Jun 2024 11:58:17 -0400 Subject: [PATCH 039/141] temp comment soilt consistency --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 66 +++++++++---------- 2 files changed, 34 insertions(+), 34 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index c395d46f2..a6a51f19b 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -490,7 +490,7 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) ntimes = Land_IAU_Control%ntimes - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ntimes ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes) delt = (Land_IAU_state%hr2-(Land_IAU_Control%fhour))/(Land_IAU_state%hr2-Land_IAU_state%hr1) do j = js,je do i = is,ie diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index bfd90f03e..d850ee975 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -333,41 +333,41 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! enddo deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) -! (consistency) adjustments for updated soil temp and moisture +! ! (consistency) adjustments for updated soil temp and moisture - ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) - call read_mp_table_parameters(errmsg, errflg) - ! maxsmc(1:slcats) = smcmax_table(1:slcats) - ! bb(1:slcats) = bexp_table(1:slcats) - ! satpsi(1:slcats) = psisat_table(1:slcats) +! ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) +! call read_mp_table_parameters(errmsg, errflg) +! ! maxsmc(1:slcats) = smcmax_table(1:slcats) +! ! bb(1:slcats) = bexp_table(1:slcats) +! ! satpsi(1:slcats) = psisat_table(1:slcats) - if (errflg .ne. 0) then - print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' - errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' - return - endif - n_stc = 0 - do i=1,lensfc - if (stc_updated(i) == 1 ) then ! soil-only location - n_stc = n_stc+1 - soiltype = soiltyp(i) - do l = 1, lsoil_incr - !case 1: frz ==> frz, recalculate slc, smc remains - !case 2: unfrz ==> frz, recalculate slc, smc remains - !both cases are considered in the following if case - if (stc(i,l) .LT. tfreez )then - !recompute supercool liquid water,smc_anl remain unchanged - smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) - slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) - slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) - endif - !case 3: frz ==> unfrz, melt all soil ice (if any) - if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck - slc(i,l)=smc(i,l) - endif - enddo - endif - enddo +! if (errflg .ne. 0) then +! print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' +! errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' +! return +! endif +! n_stc = 0 +! do i=1,lensfc +! if (stc_updated(i) == 1 ) then ! soil-only location +! n_stc = n_stc+1 +! soiltype = soiltyp(i) +! do l = 1, lsoil_incr +! !case 1: frz ==> frz, recalculate slc, smc remains +! !case 2: unfrz ==> frz, recalculate slc, smc remains +! !both cases are considered in the following if case +! if (stc(i,l) .LT. tfreez )then +! !recompute supercool liquid water,smc_anl remain unchanged +! smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) +! slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) +! slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) +! endif +! !case 3: frz ==> unfrz, melt all soil ice (if any) +! if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck +! slc(i,l)=smc(i,l) +! endif +! enddo +! endif +! enddo deallocate(stc_updated) deallocate(mask_tile) From 1537ef11762d21bb5b7b2e374b36f2b8c55419c5 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sat, 22 Jun 2024 13:11:02 -0400 Subject: [PATCH 040/141] temp comment soilt consistency --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 77 +++++++++++-------- 2 files changed, 44 insertions(+), 35 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index a6a51f19b..7f7288986 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -257,7 +257,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) nlat = Land_IAU_Control%ny !nblks = Land_IAU_Control%nblks !blksz = Land_IAU_Control%blksz(1) - print*, "proc is ie js je ",Land_IAU_Control%me, is, ie, js, je + print*, "proc tile is ie js je ",,Land_IAU_Control%tile_num, Land_IAU_Control%me, is, ie, js, je allocate(Land_IAU_Data%stc_inc(is:ie, js:je, km)) allocate(Land_IAU_Data%slc_inc(is:ie, js:je, km)) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index d850ee975..6dede7c6d 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -240,6 +240,10 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo " delt ",delt," IauCont%dtp",Land_IAU_Control%dtp endif + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "root proc stc before update" + print*, stc + endif !> read iau increments call land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) if (errflg .ne. 0) then @@ -270,7 +274,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ib = 1 do j = 1, Land_IAU_Control%ny !ny do k = 1, km - stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) =Land_IAU_Data%stc_inc(:,j, k) + stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%stc_inc(:,j, k) ! slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) enddo ib = ib + Land_IAU_Control%nx !nlon @@ -333,41 +337,41 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! enddo deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) -! ! (consistency) adjustments for updated soil temp and moisture +! (consistency) adjustments for updated soil temp and moisture -! ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) -! call read_mp_table_parameters(errmsg, errflg) -! ! maxsmc(1:slcats) = smcmax_table(1:slcats) -! ! bb(1:slcats) = bexp_table(1:slcats) -! ! satpsi(1:slcats) = psisat_table(1:slcats) + ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) + call read_mp_table_parameters(errmsg, errflg) + ! maxsmc(1:slcats) = smcmax_table(1:slcats) + ! bb(1:slcats) = bexp_table(1:slcats) + ! satpsi(1:slcats) = psisat_table(1:slcats) -! if (errflg .ne. 0) then -! print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' -! errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' -! return -! endif -! n_stc = 0 -! do i=1,lensfc -! if (stc_updated(i) == 1 ) then ! soil-only location -! n_stc = n_stc+1 -! soiltype = soiltyp(i) -! do l = 1, lsoil_incr -! !case 1: frz ==> frz, recalculate slc, smc remains -! !case 2: unfrz ==> frz, recalculate slc, smc remains -! !both cases are considered in the following if case -! if (stc(i,l) .LT. tfreez )then -! !recompute supercool liquid water,smc_anl remain unchanged -! smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) -! slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) -! slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) -! endif -! !case 3: frz ==> unfrz, melt all soil ice (if any) -! if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck -! slc(i,l)=smc(i,l) -! endif -! enddo -! endif -! enddo + if (errflg .ne. 0) then + print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' + errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' + return + endif + n_stc = 0 + do i=1,lensfc + if (stc_updated(i) == 1 ) then ! soil-only location + n_stc = n_stc+1 + soiltype = soiltyp(i) + do l = 1, lsoil_incr + !case 1: frz ==> frz, recalculate slc, smc remains + !case 2: unfrz ==> frz, recalculate slc, smc remains + !both cases are considered in the following if case + if (stc(i,l) .LT. tfreez )then + !recompute supercool liquid water,smc_anl remain unchanged + smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) + slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) + slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) + endif + !case 3: frz ==> unfrz, melt all soil ice (if any) + if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck + slc(i,l)=smc(i,l) + endif + enddo + endif + enddo deallocate(stc_updated) deallocate(mask_tile) @@ -383,6 +387,11 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo endif + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "root proc stc after update" + print*, stc + endif + end subroutine noahmpdrv_timestep_init !> \ingroup NoahMP_LSM From e1dae931ff7546e930bcaa4e8c43fa1c8ffc943a Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sat, 22 Jun 2024 13:24:24 -0400 Subject: [PATCH 041/141] temp comment soilt consistency --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 7f7288986..48a1efff3 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -257,7 +257,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) nlat = Land_IAU_Control%ny !nblks = Land_IAU_Control%nblks !blksz = Land_IAU_Control%blksz(1) - print*, "proc tile is ie js je ",,Land_IAU_Control%tile_num, Land_IAU_Control%me, is, ie, js, je + print*, "proc tile is ie js je ",Land_IAU_Control%tile_num, Land_IAU_Control%me, is, ie, js, je allocate(Land_IAU_Data%stc_inc(is:ie, js:je, km)) allocate(Land_IAU_Data%slc_inc(is:ie, js:je, km)) From d01adf6e986bd5ec9b8f9fef0cda1c005da11ed7 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sat, 22 Jun 2024 14:53:40 -0400 Subject: [PATCH 042/141] temp comment soilt consistency --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 6 ++++-- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 17 +++++++---------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 48a1efff3..c736d9029 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -257,7 +257,8 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) nlat = Land_IAU_Control%ny !nblks = Land_IAU_Control%nblks !blksz = Land_IAU_Control%blksz(1) - print*, "proc tile is ie js je ",Land_IAU_Control%tile_num, Land_IAU_Control%me, is, ie, js, je + + ! print*, "proc tile is ie js je ",Land_IAU_Control%me, Land_IAU_Control%tile_num, is, ie, js, je allocate(Land_IAU_Data%stc_inc(is:ie, js:je, km)) allocate(Land_IAU_Data%slc_inc(is:ie, js:je, km)) @@ -490,7 +491,8 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) ntimes = Land_IAU_Control%ntimes - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ntimes ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ntimes ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes), & + " rdt wt ", rdt, wt delt = (Land_IAU_state%hr2-(Land_IAU_Control%fhour))/(Land_IAU_state%hr2-Land_IAU_state%hr1) do j = js,je do i = is,ie diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 6dede7c6d..eff57df87 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -240,10 +240,6 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo " delt ",delt," IauCont%dtp",Land_IAU_Control%dtp endif - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "root proc stc before update" - print*, stc - endif !> read iau increments call land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) if (errflg .ne. 0) then @@ -294,7 +290,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo !---this should be ncol?? as last block may be shorter (check blksz)? lensfc = Land_IAU_Control%nx * Land_IAU_Control%ny - print*,'adjusting first ', lsoil_incr, ' surface layers only' + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,' adjusting first ', lsoil_incr, ' surface layers only, delt ', delt ! initialize variables for counts statitics to be zeros nother = 0 ! grid cells not land nsnowupd = 0 ! grid cells with snow (temperature not yet updated) @@ -306,10 +302,11 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo allocate(mask_tile(lensfc)) call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, & !veg_type_landice, mask_tile) - + ij_loop : do ij = 1, lensfc ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land if (mask_tile(ij) == 1) then + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*, "root proc layer 1 stc, inc ", stc(ij,1), stc_inc_flat(ij,1) soil_freeze=.false. soil_ice=.false. do k = 1, lsoil_incr ! k = 1, km @@ -387,10 +384,10 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo endif - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "root proc stc after update" - print*, stc - endif + ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + ! print*, "root proc stc after update" + ! print*, stc + ! endif end subroutine noahmpdrv_timestep_init From e7bb2c33a762fc232bd6860f0b59797806f559e8 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sat, 22 Jun 2024 15:23:52 -0400 Subject: [PATCH 043/141] temp comment soilt consistency --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 23 +++++++++++-------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index c736d9029..c3a3bcaae 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -334,7 +334,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) - call read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errflg) + call read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, wk3_stc, wk3_slc ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) ! increments already in the fv3 grid--no need for interpolation @@ -531,14 +531,14 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) end subroutine setiauforcing -subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errmsg, errflg) +subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_out, slc_inc_out type (land_iau_control_type), intent(in) :: Land_IAU_Control ! character(len=*), intent(in) :: fname character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg - real(kind=kind_phys), allocatable, intent(out) :: stc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) - real(kind=kind_phys), allocatable, intent(out) :: slc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) + ! real(kind=kind_phys), allocatable, intent(out) :: stc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) + ! real(kind=kind_phys), allocatable, intent(out) :: slc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) integer :: i, it, km !j, k, l, npz, logical :: exists @@ -593,8 +593,11 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm return endif - allocate(stc_inc_out(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) - allocate(slc_inc_out(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) + ! allocate(stc_inc_out(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) + ! allocate(slc_inc_out(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) + allocate(wk3_stc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) + allocate(wk3_slc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) + do i = 1, size(stc_vars) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(stc_vars(i)) @@ -603,7 +606,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm if (status == nf90_noerr) then !if (ierr == 0) then do it = 1, n_t ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) - call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, stc_inc_out(it,:, :, i), status) + call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, wk3_stc(it,:, :, i), status) ! call get_var3d_values(ncid, varid, 1,im, jbeg,jend, it, 1, stc_inc_out(it,:, :, i), status) call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg) if (errflg .ne. 0) return @@ -611,7 +614,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm else if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, & 'warning: no increment for ',trim(stc_vars(i)),' found, assuming zero' - stc_inc_out(:, :, :, i) = 0. + wk3_stc(:, :, :, i) = 0. endif enddo do i = 1, size(slc_vars) @@ -619,7 +622,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm status = nf90_inq_varid(ncid, trim(slc_vars(i)), varid) if (status == nf90_noerr) then !if (ierr == 0) then do it = 1, n_t - call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, slc_inc_out(it, :, :, i), status) + call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, wk3_slc(it, :, :, i), status) ! call get_var3d_values(ncid, varid, 1,im, jbeg,jend, it, 1, slc_inc_out(it, :, :, i), status) call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg) if (errflg .ne. 0) return @@ -627,7 +630,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, stc_inc_out, slc_inc_out, errm else if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,& 'warning: no increment for ',trim(slc_vars(i)),' found, assuming zero' - slc_inc_out(:, :, :, i) = 0. + wk3_slc(:, :, :, i) = 0. endif enddo From 3fe39b710d3a277ec47a2ab874bbcab94019f712 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 23 Jun 2024 09:29:33 -0400 Subject: [PATCH 044/141] fix rdt error --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index c3a3bcaae..cae97b2b0 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -29,6 +29,7 @@ module land_iau_mod private real(kind=kind_phys), allocatable :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) +! real(kind=kind_phys) :: rdt type land_iau_internal_data_type real(kind=kind_phys),allocatable :: stc_inc(:,:,:) @@ -327,11 +328,10 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) enddo deallocate(idt) endif - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval = ',Land_IAU_Control%iau_delthrs,' hours' dt = (Land_IAU_Control%iau_delthrs*3600.) rdt = 1.0/dt Land_IAU_state%rdt = rdt - + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval, rdt',Land_IAU_Control%iau_delthrs,Land_IAU_state%rdt ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) call read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, wk3_stc, wk3_slc @@ -437,7 +437,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e Land_IAU_Data%in_interval=.false. else if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control,Land_IAU_Data, Land_IAU_state%rdt, Land_IAU_state%wt) - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact,Land_IAU_state%rdt Land_IAU_Data%in_interval=.true. endif return @@ -449,7 +449,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',Land_IAU_Control%iaufhrs(1),Land_IAU_Control%fhour,Land_IAU_Control%iaufhrs(nfiles) Land_IAU_Data%in_interval=.false. else - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact,Land_IAU_state%rdt Land_IAU_Data%in_interval=.true. do k=ntimes, 1, -1 if (Land_IAU_Control%iaufhrs(k) > Land_IAU_Control%fhour) then From ed09ad60018ff40e008003f4b25aeb4a7594c0a6 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 23 Jun 2024 10:18:58 -0400 Subject: [PATCH 045/141] - --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index cae97b2b0..af2221379 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -336,6 +336,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) call read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, wk3_stc, wk3_slc ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'wk3_stc min max', min(wk3_stc), max(wk3_stc) ! increments already in the fv3 grid--no need for interpolation Land_IAU_state%inc1%stc_inc(:, :, :) = wk3_stc(1, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) @@ -491,9 +492,9 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) ntimes = Land_IAU_Control%ntimes - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ntimes ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes), & - " rdt wt ", rdt, wt delt = (Land_IAU_state%hr2-(Land_IAU_Control%fhour))/(Land_IAU_state%hr2-Land_IAU_state%hr1) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ntimes ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes), & + " rdt wt delt ", rdt, wt, delt do j = js,je do i = is,ie do k = 1,npz ! do k = 1,n_soill ! From 0c8ff8ece14e40e7c033d3e833cb69a48843a38e Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 23 Jun 2024 10:37:36 -0400 Subject: [PATCH 046/141] - --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index af2221379..888dc5d6a 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -336,7 +336,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) call read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, wk3_stc, wk3_slc ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'wk3_stc min max', min(wk3_stc), max(wk3_stc) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) ! increments already in the fv3 grid--no need for interpolation Land_IAU_state%inc1%stc_inc(:, :, :) = wk3_stc(1, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) From 3656ec51c29317a0b30b5113bd1b721762504ab5 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 23 Jun 2024 11:05:18 -0400 Subject: [PATCH 047/141] - --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 888dc5d6a..d1de42cb9 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -336,7 +336,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) call read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, wk3_stc, wk3_slc ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) ! increments already in the fv3 grid--no need for interpolation Land_IAU_state%inc1%stc_inc(:, :, :) = wk3_stc(1, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) @@ -353,6 +352,11 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(2, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(2, :, :, :) endif + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,' IAU init wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) + print *,'inc1%stc_inc min max', minval(Land_IAU_state%inc1%stc_inc), maxval(Land_IAU_state%inc1%stc_inc) + print *,'inc2%stc_inc min max', minval(Land_IAU_state%inc2%stc_inc), maxval(Land_IAU_state%inc2%stc_inc) + endif ! print*,'end of IAU init',dt,rdt end subroutine land_iau_mod_init @@ -393,6 +397,12 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e ntimes = Land_IAU_Control%ntimes + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'getiauforc wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) + print *,'inc1%stc_inc min max', minval(Land_IAU_state%inc1%stc_inc), maxval(Land_IAU_state%inc1%stc_inc) + print *,'inc2%stc_inc min max', minval(Land_IAU_state%inc2%stc_inc), maxval(Land_IAU_state%inc2%stc_inc) + endif + Land_IAU_Data%in_interval=.false. if (ntimes.LE.0) then return From b744d6c18a3bff2174ce953d55f430517cc412f8 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 23 Jun 2024 11:36:36 -0400 Subject: [PATCH 048/141] - --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 29 +++++++++++++++---- 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index d1de42cb9..8199aab6b 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -216,7 +216,7 @@ end subroutine land_iau_mod_set_control subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !nlunit, ncols, IPD_Data,,Init_parm) ! integer, intent(in) :: me, mpi_root type (land_iau_control_type), intent(inout) :: Land_IAU_Control - type (land_iau_external_data_type), intent(inout) :: Land_IAU_Data + type (land_iau_external_data_type), intent(inout) :: Land_IAU_Data ! real(kind=kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon ! real(kind=kind_phys), dimension(:), intent(in) :: xlat ! latitude character(len=*), intent(out) :: errmsg @@ -239,7 +239,8 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) integer :: n_soill, n_snowl !soil and snow layers logical :: do_land_iau integer :: is, ie, js, je - integer :: npz + integer :: npz + integer :: i, j !Errors messages handled through CCPP error handling variables errmsg = '' @@ -338,8 +339,16 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) ! increments already in the fv3 grid--no need for interpolation - Land_IAU_state%inc1%stc_inc(:, :, :) = wk3_stc(1, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - Land_IAU_state%inc1%slc_inc(:, :, :) = wk3_slc(1, :, :, :) + ! Land_IAU_state%inc1%stc_inc(:, :, :) = wk3_stc(1, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) + ! Land_IAU_state%inc1%slc_inc(:, :, :) = wk3_slc(1, :, :, :) + do k = 1, npz ! do k = 1,n_soill ! + do j = 1, nlat + do i = 1, nlon + Land_IAU_state%inc1%stc_inc(i,j,k) = wk3_stc(1, i, j, k) + Land_IAU_state%inc1%slc_inc(i,j,k) = wk3_slc(1, i, j, k) + end do + enddo + enddo if (ntimes.EQ.1) then ! only need to get incrments once since constant forcing over window call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%rdt, Land_IAU_state%wt) @@ -349,8 +358,16 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) - Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(2, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(2, :, :, :) + ! Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(2, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) + ! Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(2, :, :, :) + do k = 1, npz ! do k = 1,n_soill ! + do j = 1, nlat + do i = 1, nlon + Land_IAU_state%inc2%stc_inc(i,j,k) = wk3_stc(2, i, j, k) + Land_IAU_state%inc2%slc_inc(i,j,k) = wk3_slc(2, i, j, k) + end do + enddo + enddo endif if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print *,' IAU init wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) From dbe2d7da0e216d3fe3c925b82bcd996921f0a311 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 23 Jun 2024 12:10:01 -0400 Subject: [PATCH 049/141] - --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 8199aab6b..e1ea20c76 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -250,6 +250,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) n_soill = Land_IAU_Control%lsoil !4 for sfc updates ! n_snowl = Land_IAU_Control%lsnowl npz = Land_IAU_Control%lsoil + km = Land_IAU_Control%lsoil is = Land_IAU_Control%isc ie = is + Land_IAU_Control%nx-1 From 05de695455b45008dd1bf607e4705af27771ccd9 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 23 Jun 2024 13:26:14 -0400 Subject: [PATCH 050/141] debug --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 20 +++++++++---------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 +- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index e1ea20c76..902905138 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -370,11 +370,11 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) enddo enddo endif - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,' IAU init wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) - print *,'inc1%stc_inc min max', minval(Land_IAU_state%inc1%stc_inc), maxval(Land_IAU_state%inc1%stc_inc) - print *,'inc2%stc_inc min max', minval(Land_IAU_state%inc2%stc_inc), maxval(Land_IAU_state%inc2%stc_inc) - endif + ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + ! print *,' IAU init wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) + ! print *,'inc1%stc_inc min max', minval(Land_IAU_state%inc1%stc_inc), maxval(Land_IAU_state%inc1%stc_inc) + ! print *,'inc2%stc_inc min max', minval(Land_IAU_state%inc2%stc_inc), maxval(Land_IAU_state%inc2%stc_inc) + ! endif ! print*,'end of IAU init',dt,rdt end subroutine land_iau_mod_init @@ -415,11 +415,11 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e ntimes = Land_IAU_Control%ntimes - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'getiauforc wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) - print *,'inc1%stc_inc min max', minval(Land_IAU_state%inc1%stc_inc), maxval(Land_IAU_state%inc1%stc_inc) - print *,'inc2%stc_inc min max', minval(Land_IAU_state%inc2%stc_inc), maxval(Land_IAU_state%inc2%stc_inc) - endif + ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + ! print *,'getiauforc wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) + ! print *,'inc1%stc_inc min max', minval(Land_IAU_state%inc1%stc_inc), maxval(Land_IAU_state%inc1%stc_inc) + ! print *,'inc2%stc_inc min max', minval(Land_IAU_state%inc2%stc_inc), maxval(Land_IAU_state%inc2%stc_inc) + ! endif Land_IAU_Data%in_interval=.false. if (ntimes.LE.0) then diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index eff57df87..6498d0206 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -306,7 +306,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ij_loop : do ij = 1, lensfc ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land if (mask_tile(ij) == 1) then - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*, "root proc layer 1 stc, inc ", stc(ij,1), stc_inc_flat(ij,1) + ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*, "root proc layer 1 stc, inc ", stc(ij,1), stc_inc_flat(ij,1) soil_freeze=.false. soil_ice=.false. do k = 1, lsoil_incr ! k = 1, km From 820ef5eb4f6e9a404489d6d772a5a744147c4d0a Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 23 Jun 2024 17:11:24 -0400 Subject: [PATCH 051/141] clean up --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 27 +---------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 47 +++++-------------- 2 files changed, 13 insertions(+), 61 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 902905138..b4a76f838 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -29,7 +29,6 @@ module land_iau_mod private real(kind=kind_phys), allocatable :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) -! real(kind=kind_phys) :: rdt type land_iau_internal_data_type real(kind=kind_phys),allocatable :: stc_inc(:,:,:) @@ -261,8 +260,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !nblks = Land_IAU_Control%nblks !blksz = Land_IAU_Control%blksz(1) - ! print*, "proc tile is ie js je ",Land_IAU_Control%me, Land_IAU_Control%tile_num, is, ie, js, je - allocate(Land_IAU_Data%stc_inc(is:ie, js:je, km)) allocate(Land_IAU_Data%slc_inc(is:ie, js:je, km)) ! allocate arrays that will hold iau state @@ -334,14 +331,12 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) rdt = 1.0/dt Land_IAU_state%rdt = rdt if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval, rdt',Land_IAU_Control%iau_delthrs,Land_IAU_state%rdt - ! Read all increment files at iau init time (at beginning of cycle) and interpolate to target grid + ! Read all increment files at iau init time (at beginning of cycle) ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) call read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, wk3_stc, wk3_slc ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) ! increments already in the fv3 grid--no need for interpolation - ! Land_IAU_state%inc1%stc_inc(:, :, :) = wk3_stc(1, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - ! Land_IAU_state%inc1%slc_inc(:, :, :) = wk3_slc(1, :, :, :) do k = 1, npz ! do k = 1,n_soill ! do j = 1, nlat do i = 1, nlon @@ -358,9 +353,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) allocate (Land_IAU_state%inc2%stc_inc(is:ie, js:je, km)) allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) - - ! Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(2, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - ! Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(2, :, :, :) + do k = 1, npz ! do k = 1,n_soill ! do j = 1, nlat do i = 1, nlon @@ -370,11 +363,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) enddo enddo endif - ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - ! print *,' IAU init wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) - ! print *,'inc1%stc_inc min max', minval(Land_IAU_state%inc1%stc_inc), maxval(Land_IAU_state%inc1%stc_inc) - ! print *,'inc2%stc_inc min max', minval(Land_IAU_state%inc2%stc_inc), maxval(Land_IAU_state%inc2%stc_inc) - ! endif ! print*,'end of IAU init',dt,rdt end subroutine land_iau_mod_init @@ -415,12 +403,6 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e ntimes = Land_IAU_Control%ntimes - ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - ! print *,'getiauforc wk3_stc min max', minval(wk3_stc), maxval(wk3_stc) - ! print *,'inc1%stc_inc min max', minval(Land_IAU_state%inc1%stc_inc), maxval(Land_IAU_state%inc1%stc_inc) - ! print *,'inc2%stc_inc min max', minval(Land_IAU_state%inc2%stc_inc), maxval(Land_IAU_state%inc2%stc_inc) - ! endif - Land_IAU_Data%in_interval=.false. if (ntimes.LE.0) then return @@ -566,8 +548,6 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_ou ! character(len=*), intent(in) :: fname character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg - ! real(kind=kind_phys), allocatable, intent(out) :: stc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) - ! real(kind=kind_phys), allocatable, intent(out) :: slc_inc_out(:, :, :, :) !1:im, jbeg:jend, 1:km) integer :: i, it, km !j, k, l, npz, logical :: exists @@ -622,12 +602,9 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_ou return endif - ! allocate(stc_inc_out(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) - ! allocate(slc_inc_out(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) allocate(wk3_stc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) allocate(wk3_slc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) - do i = 1, size(stc_vars) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(stc_vars(i)) ! call check_var_exists(ncid, trim(stc_vars(i)), ierr) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 6498d0206..74aaffb9e 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -30,9 +30,9 @@ module noahmpdrv !> \Land IAU data and control ! Land IAU Control holds settings' information, maily read from namelist (e.g., - ! block of global domain that belongs to a process , - ! whethrer to do IAU increment at this time step, - ! time step informatoin, etc) + ! block of global domain that belongs to a process , + ! whethrer to do IAU increment at this time step, + ! time step informatoin, etc) type (land_iau_control_type) :: Land_IAU_Control ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step type (land_iau_external_data_type) :: Land_IAU_Data !(number of blocks):each proc holds nblks @@ -59,8 +59,6 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & use set_soilveg_mod, only: set_soilveg use namelist_soilveg use noahmp_tables - !use GFS_typedefs, only: GFS_control_type - ! use GFS_typedefs, only: GFS_data_type implicit none @@ -83,12 +81,8 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon real(kind_phys), dimension(:), intent(in) :: xlat ! latitude - - integer, intent(in) :: lsoil, lsnow_lsm real(kind=kind_phys), intent(in) :: dtp, fhour - ! type(gfs_data_type), dimension(:), intent(inout) :: GFS_Data ! !(one:) - !type(gfs_control_type), intent(in) :: GFS_Control ! Initialize CCPP error handling variables errmsg = '' @@ -153,7 +147,7 @@ end subroutine noahmpdrv_init !! \section arg_table_noahmpdrv_timestep_init Argument Table !! \htmlinclude noahmpdrv_timestep_init.html !! - !! For Noah-MP, the adjustment scheme shown below as of 11/09/2023: +!! For Noah-MP, the adjustment scheme shown below is applied to soil moisture and temp: !! Case 1: frozen ==> frozen, recalculate slc following opt_frz=1, smc remains !! Case 2: unfrozen ==> frozen, recalculate slc following opt_frz=1, smc remains !! Case 3: frozen ==> unfrozen, melt all soil ice (if any) @@ -161,16 +155,6 @@ end subroutine noahmpdrv_init !! Note: For Case 3, Yuan Xue thoroughly evaluated a total of four options and !! current option is found to be the best as of 11/09/2023 -!! @param[in] isot Integer code for the soil type data set -!! @param[in] ivegsrc Integer code for the vegetation type data set -!! @param[in] lensfc Number of land points for this tile - -!! @param[in] lsoil_incr Number of soil layers (from top) to apply soil increments to - -!! @param[inout] smc_adj Analysis soil moisture states -!! @param[inout] slc_adj Analysis liquid soil moisture states -!! @param[in] stc_updated Integer to record whether STC in each grid cell was updated - subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_root, isot, ivegsrc, soiltyp, vegtype, weasd, & stc, slc, smc, errmsg, errflg) ! smc, t2mmp, q2mp, @@ -182,13 +166,12 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo implicit none - ! for soil temp/moisture consistency adjustment after DA update - integer, intent(in) :: isot, ivegsrc - integer , intent(in) :: itime !current forecast iteration real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) real(kind=kind_phys) , intent(in) :: delt ! time interval [s] integer , intent(in) :: km !vertical soil layer dimension + integer, intent(in) :: isot + integer, intent(in) :: ivegsrc integer , dimension(:) , intent(in) :: soiltyp ! soil type (integer index) integer , dimension(:) , intent(in) :: vegtype ! vegetation type (integer index) @@ -282,12 +265,8 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo print*, "Warning noahmpdrv_run delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp endif endif - - !IAU increments are in units of 1/sec !Land_IAU_Control%dtp - !* only updating soil temp for now + lsoil_incr = Land_IAU_Control%lsoil_incr - -!---this should be ncol?? as last block may be shorter (check blksz)? lensfc = Land_IAU_Control%nx * Land_IAU_Control%ny if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,' adjusting first ', lsoil_incr, ' surface layers only, delt ', delt @@ -300,9 +279,10 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo !TODO---if only fv3 increment files are used, this can be read from file allocate(mask_tile(lensfc)) - call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, & !veg_type_landice, - mask_tile) - + call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) !& !veg_type_landice, + + !IAU increments are in units of 1/sec !Land_IAU_Control%dtp + !* only updating soil temp for now ij_loop : do ij = 1, lensfc ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land if (mask_tile(ij) == 1) then @@ -384,11 +364,6 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo endif - ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - ! print*, "root proc stc after update" - ! print*, stc - ! endif - end subroutine noahmpdrv_timestep_init !> \ingroup NoahMP_LSM From b46a17fdb53b018c4579ce9db5b0509d0b5342c2 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 24 Jun 2024 16:49:29 -0400 Subject: [PATCH 052/141] read mask from file --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 24 +++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index b4a76f838..7e94d595e 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -39,6 +39,7 @@ module land_iau_mod real(kind=kind_phys),allocatable :: stc_inc(:,:,:) real(kind=kind_phys),allocatable :: slc_inc(:,:,:) logical :: in_interval = .false. + integer,allocatable :: snow_land_mask(:, :, :) end type land_iau_external_data_type type land_iau_state_type @@ -331,6 +332,29 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) rdt = 1.0/dt Land_IAU_state%rdt = rdt if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval, rdt',Land_IAU_Control%iau_delthrs,Land_IAU_state%rdt + + allocate(Land_IAU_Data%snow_land_mask(nlon, nlat, ntimes)) + fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1)) + inquire (file=trim(fname), exist=exists) + if (exists) then ! if( file_exist(fname) ) then + ! call open_ncfile( fname, ncid ) + status = nf90_open(trim(fname), NF90_NOWRITE, ncid) ! open the file + call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) + if (errflg .ne. 0) return + ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) + call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, 1, n_t, & + Land_IAU_Data%snow_land_mask(:, :, it), status) + call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg) + if (errflg .ne. 0) return + status = nf90_close(ncid) + CALL netcdf_err(status, 'closing file: '//trim(fname) , errflg, errmsg) + if (errflg .ne. 0) return + else + errmsg = 'FATAL Error in Land_IAU_initialize: Expected file '// trim(fname)//' for DA increment does not exist' + errflg = 1 + return + endif + ! Read all increment files at iau init time (at beginning of cycle) ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) call read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, wk3_stc, wk3_slc From 3bb397a9c80b3fcd59f19c0de99781253b39b7ac Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 24 Jun 2024 18:38:26 -0400 Subject: [PATCH 053/141] revert back to calculating mask --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 24 +------------------ 1 file changed, 1 insertion(+), 23 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 7e94d595e..de245fcca 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -39,7 +39,7 @@ module land_iau_mod real(kind=kind_phys),allocatable :: stc_inc(:,:,:) real(kind=kind_phys),allocatable :: slc_inc(:,:,:) logical :: in_interval = .false. - integer,allocatable :: snow_land_mask(:, :, :) + ! integer,allocatable :: snow_land_mask(:, :, :) end type land_iau_external_data_type type land_iau_state_type @@ -333,28 +333,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) Land_IAU_state%rdt = rdt if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval, rdt',Land_IAU_Control%iau_delthrs,Land_IAU_state%rdt - allocate(Land_IAU_Data%snow_land_mask(nlon, nlat, ntimes)) - fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1)) - inquire (file=trim(fname), exist=exists) - if (exists) then ! if( file_exist(fname) ) then - ! call open_ncfile( fname, ncid ) - status = nf90_open(trim(fname), NF90_NOWRITE, ncid) ! open the file - call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) - if (errflg .ne. 0) return - ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) - call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, 1, n_t, & - Land_IAU_Data%snow_land_mask(:, :, it), status) - call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg) - if (errflg .ne. 0) return - status = nf90_close(ncid) - CALL netcdf_err(status, 'closing file: '//trim(fname) , errflg, errmsg) - if (errflg .ne. 0) return - else - errmsg = 'FATAL Error in Land_IAU_initialize: Expected file '// trim(fname)//' for DA increment does not exist' - errflg = 1 - return - endif - ! Read all increment files at iau init time (at beginning of cycle) ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) call read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, wk3_stc, wk3_slc From 10c3427104197dd725a4c6ef9a3f078632aa580c Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 26 Jun 2024 15:58:09 -0400 Subject: [PATCH 054/141] delete sim_nc --- .../SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 | 469 ------------------ 1 file changed, 469 deletions(-) delete mode 100644 physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 diff --git a/physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 b/physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 deleted file mode 100644 index 6f2bd1ad2..000000000 --- a/physics/SFC_Models/Land/Noahmp/sim_nc_mod_lnd.F90 +++ /dev/null @@ -1,469 +0,0 @@ -!*********************************************************************** -!* GNU Lesser General Public License -!* -!* This file is part of the FV3 dynamical core. -!* -!* The FV3 dynamical core is free software: you can redistribute it -!* and/or modify it under the terms of the -!* GNU Lesser General Public License as published by the -!* Free Software Foundation, either version 3 of the License, or -!* (at your option) any later version. -!* -!* The FV3 dynamical core is distributed in the hope that it will be -!* useful, but WITHOUT ANYWARRANTY; without even the implied warranty -!* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -!* See the GNU General Public License for more details. -!* -!* You should have received a copy of the GNU Lesser General Public -!* License along with the FV3 dynamical core. -!* If not, see . -!*********************************************************************** - -!> March 2024: This is a copy of S-J Lin's sim_nc_mod -!> renamed it sim_nc_mod_lnd to faciliate compilaton - -!>@brief The module 'sim_nc' is a netcdf file reader. -!>@details The code is necessary to circumvent issues with the FMS -!! 'read_data' utility, which opens too many files and uses excessive -!! memory. -!>@author Shian-Jiann Lin - -module sim_nc_mod_lnd - -! This is S-J Lin's private netcdf file reader -! This code is needed because FMS utility (read_data) led to too much -! memory usage and too many files openned. Perhaps lower-level FMS IO -! calls should be used instead. - -#if defined(OLD_PT_TO_T) || defined(OLD_COS_SG) -#error -#error Compile time options -DOLD_PT_TO_T and -DOLD_COS_SG are no longer supported. Please remove them from your XML. -#error -#endif - -! use mpp_mod, only: mpp_error, FATAL - - implicit none -#include - - private - public open_ncfile, close_ncfile, get_ncdim1, get_var1_double, get_var2_double, & - get_var3_real, get_var3_double, get_var3_r4, get_var2_real, get_var2_r4, & - handle_err, check_var, get_var1_real, get_var_att_double, & - check_var_exists - - contains - - subroutine open_ncfile( iflnm, ncid ) - character(len=*), intent(in):: iflnm - integer, intent(out):: ncid - integer:: status - - status = nf_open (iflnm, NF_NOWRITE, ncid) - if (status .ne. NF_NOERR) call handle_err('nf_open',status) - - - end subroutine open_ncfile - - - subroutine close_ncfile( ncid ) - integer, intent(in):: ncid - integer:: status - - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err('nf_close',status) - - - end subroutine close_ncfile - - - subroutine get_ncdim1( ncid, var1_name, im ) - integer, intent(in):: ncid - character(len=*), intent(in):: var1_name - integer, intent(out):: im - integer:: status, var1id - - status = nf_inq_dimid (ncid, var1_name, var1id) - if (status .ne. NF_NOERR) call handle_err('dimid '//var1_name,status) - - status = nf_inq_dimlen (ncid, var1id, im) - if (status .ne. NF_NOERR) call handle_err('dimid '//var1_name,status) - - end subroutine get_ncdim1 - -!>@brief The 'get_var' subroutines read in variables from netcdf files - subroutine get_var1_double( ncid, var1_name, im, var1, var_exist ) - integer, intent(in):: ncid - character(len=*), intent(in):: var1_name - integer, intent(in):: im - logical, intent(out), optional:: var_exist - real(kind=8), intent(out):: var1(im) - integer:: status, var1id - - status = nf_inq_varid (ncid, var1_name, var1id) - if (status .ne. NF_NOERR) then -! call handle_err('varid '//var1_name,status) - if(present(var_exist) ) var_exist = .false. - else - status = nf_get_var_double (ncid, var1id, var1) - if (status .ne. NF_NOERR) call handle_err('varid '//var1_name,status) - if(present(var_exist) ) var_exist = .true. - endif - - - end subroutine get_var1_double - - -! 4-byte data: - subroutine get_var1_real( ncid, var1_name, im, var1, var_exist ) - integer, intent(in):: ncid - character(len=*), intent(in):: var1_name - integer, intent(in):: im - logical, intent(out), optional:: var_exist - real(kind=4), intent(out):: var1(im) - integer:: status, var1id - - status = nf_inq_varid (ncid, var1_name, var1id) - if (status .ne. NF_NOERR) then -! call handle_err(status) - if(present(var_exist) ) var_exist = .false. - else - status = nf_get_var_real (ncid, var1id, var1) - if (status .ne. NF_NOERR) call handle_err('get_var1_real1 '//var1_name,status) - if(present(var_exist) ) var_exist = .true. - endif - - - end subroutine get_var1_real - - subroutine get_var2_real( ncid, var_name, im, jm, var2 ) - integer, intent(in):: ncid - character(len=*), intent(in):: var_name - integer, intent(in):: im, jm - real(kind=4), intent(out):: var2(im) - - integer:: status, var1id - - status = nf_inq_varid (ncid, var_name, var1id) - if (status .ne. NF_NOERR) call handle_err('get_var2_real varid '//var_name,status) - - status = nf_get_var_real (ncid, var1id, var2) - if (status .ne. NF_NOERR) call handle_err('get_var2_real get_var'//var_name,status) - - end subroutine get_var2_real - - subroutine get_var2_r4( ncid, var2_name, is,ie, js,je, var2, time_slice ) - integer, intent(in):: ncid - character(len=*), intent(in):: var2_name - integer, intent(in):: is, ie, js, je - real(kind=4), intent(out):: var2(is:ie,js:je) - integer, intent(in), optional :: time_slice -! - real(kind=4), dimension(1) :: time - integer, dimension(3):: start, nreco - integer:: status, var2id - - status = nf_inq_varid (ncid, var2_name, var2id) - if (status .ne. NF_NOERR) call handle_err('get_var2_r4 varid'//var2_name,status) - - start(1) = is; start(2) = js; start(3) = 1 - if ( present(time_slice) ) then - start(3) = time_slice - end if - - nreco(1) = ie - is + 1 - nreco(2) = je - js + 1 - nreco(3) = 1 - - status = nf_get_vara_real(ncid, var2id, start, nreco, var2) - if (status .ne. NF_NOERR) call handle_err('get_var2_r4 get_vara_real'//var2_name,status) - - end subroutine get_var2_r4 - - subroutine get_var2_double( ncid, var2_name, im, jm, var2 ) - integer, intent(in):: ncid - character(len=*), intent(in):: var2_name - integer, intent(in):: im, jm - real(kind=8), intent(out):: var2(im,jm) - - integer:: status, var2id - - status = nf_inq_varid (ncid, var2_name, var2id) - if (status .ne. NF_NOERR) call handle_err('get_var2_double varid'//var2_name,status) - - status = nf_get_var_double (ncid, var2id, var2) - if (status .ne. NF_NOERR) call handle_err('get_var2_double get_var_double'//var2_name,status) - - - end subroutine get_var2_double - - - subroutine get_var3_double( ncid, var3_name, im, jm, km, var3 ) - integer, intent(in):: ncid - character(len=*), intent(in):: var3_name - integer, intent(in):: im, jm, km - real(kind=8), intent(out):: var3(im,jm,km) - - integer:: status, var3id - - status = nf_inq_varid (ncid, var3_name, var3id) - - if (status .ne. NF_NOERR) & - call handle_err('get_var3_double varid '//var3_name,status) - - status = nf_get_var_double (ncid, var3id, var3) - if (status .ne. NF_NOERR) & - call handle_err('get_var3_double get_vara_double '//var3_name,status) - - end subroutine get_var3_double - - subroutine get_var3_real( ncid, var3_name, im, jm, km, var3 ) - integer, intent(in):: ncid - character(len=*), intent(in):: var3_name - integer, intent(in):: im, jm, km - real(kind=4), intent(out):: var3(im,jm,km) - - integer:: status, var3id - - status = nf_inq_varid (ncid, var3_name, var3id) - - if (status .ne. NF_NOERR) & - call handle_err('get_var3_real varid '//var3_name,status) - status = nf_get_var_real (ncid, var3id, var3) - - if (status .ne. NF_NOERR) & - call handle_err('get_var3_real get_var_real '//var3_name,status) - - end subroutine get_var3_real - - - subroutine check_var_exists(ncid, var_name, status) - integer, intent(in):: ncid - integer, intent(inout) :: status - character(len=*), intent(in):: var_name - integer:: varid - status = nf_inq_varid (ncid, var_name, varid) - end subroutine check_var_exists - - subroutine get_var3_r4( ncid, var3_name, is,ie, js,je, ks,ke, var3, time_slice ) - integer, intent(in):: ncid - character(len=*), intent(in):: var3_name - integer, intent(in):: is, ie, js, je, ks,ke - real(kind=4), intent(out):: var3(is:ie,js:je,ks:ke) - integer, intent(in), optional :: time_slice -! - real(kind=4), dimension(1) :: time - integer, dimension(4):: start, nreco - integer:: status, var3id - - status = nf_inq_varid (ncid, var3_name, var3id) - if (status .ne. NF_NOERR) call handle_err('get_var3_r4 varid '//var3_name,status) - - start(1) = is; start(2) = js; start(3) = ks; start(4) = 1 - if ( present(time_slice) ) then - start(4) = time_slice - end if - - nreco(1) = ie - is + 1 - nreco(2) = je - js + 1 - nreco(3) = ke - ks + 1 - nreco(4) = 1 - - status = nf_get_vara_real(ncid, var3id, start, nreco, var3) - if (status .ne. NF_NOERR) call handle_err('get_var3_r4 get_vara_real '//var3_name,status) - - end subroutine get_var3_r4 - - - subroutine get_var4_real( ncid, var4_name, im, jm, km, nt, var4 ) - implicit none -#include - integer, intent(in):: ncid - character*(*), intent(in):: var4_name - integer, intent(in):: im, jm, km, nt - real*4:: wk4(im,jm,km,4) - real*4, intent(out):: var4(im,jm) - integer:: status, var4id - integer:: start(4), icount(4) - integer:: i,j - - start(1) = 1 - start(2) = 1 - start(3) = 1 - start(4) = nt - - icount(1) = im ! all range - icount(2) = jm ! all range - icount(3) = km ! all range - icount(4) = 1 ! one time level at a time - -! write(*,*) nt, 'Within get_var4_double: ', var4_name - - status = nf_inq_varid (ncid, var4_name, var4id) -! write(*,*) '#1', status, ncid, var4id - - status = nf_get_vara_real(ncid, var4id, start, icount, var4) -! status = nf_get_vara_real(ncid, var4id, start, icount, wk4) -! write(*,*) '#2', status, ncid, var4id - - do j=1,jm - do i=1,im -! var4(i,j) = wk4(i,j,1,nt) - enddo - enddo - - if (status .ne. NF_NOERR) call handle_err('get_var4_r4 get_vara_real '//var4_name,status) - - end subroutine get_var4_real - - - subroutine get_var4_double( ncid, var4_name, im, jm, km, nt, var4 ) - integer, intent(in):: ncid - character(len=*), intent(in):: var4_name - integer, intent(in):: im, jm, km, nt - real(kind=8), intent(out):: var4(im,jm,km,1) - integer:: status, var4id -! - integer:: start(4), icount(4) - - start(1) = 1 - start(2) = 1 - start(3) = 1 - start(4) = nt - - icount(1) = im ! all range - icount(2) = jm ! all range - icount(3) = km ! all range - icount(4) = 1 ! one time level at a time - - status = nf_inq_varid (ncid, var4_name, var4id) - status = nf_get_vara_double(ncid, var4id, start, icount, var4) - - if (status .ne. NF_NOERR) call handle_err('get_var4_double get_vara_double '//var4_name,status) - - end subroutine get_var4_double -!------------------------------------------------------------------------ - - subroutine get_real3( ncid, var4_name, im, jm, nt, var4 ) -! This is for multi-time-level 2D var - integer, intent(in):: ncid - character(len=*), intent(in):: var4_name - integer, intent(in):: im, jm, nt - real(kind=4), intent(out):: var4(im,jm) - integer:: status, var4id - integer:: start(3), icount(3) - integer:: i,j - - start(1) = 1 - start(2) = 1 - start(3) = nt - - icount(1) = im - icount(2) = jm - icount(3) = 1 - - status = nf_inq_varid (ncid, var4_name, var4id) - status = nf_get_vara_real(ncid, var4id, start, icount, var4) - - if (status .ne. NF_NOERR) & - call handle_err('get_real3 get_vara_real '//var4_name,status) - - end subroutine get_real3 -!------------------------------------------------------------------------ - - logical function check_var( ncid, var3_name) - integer, intent(in):: ncid - character(len=*), intent(in):: var3_name - - integer:: status, var3id - - status = nf_inq_varid (ncid, var3_name, var3id) - check_var = (status == NF_NOERR) - - end function check_var - - subroutine get_var_att_str(ncid, var_name, att_name, att) - implicit none -#include - integer, intent(in):: ncid - character*(*), intent(in):: var_name, att_name - character*(*), intent(out):: att - - integer:: status, varid - - status = nf_inq_varid (ncid, var_name, varid) - status = nf_get_att_text(ncid, varid, att_name, att) - - if (status .ne. NF_NOERR) call handle_err('get_var_att_str '//var_name,status) - - end subroutine get_var_att_str - - subroutine get_var_att_double(ncid, var_name, att_name, value) - implicit none -#include - integer, intent(in):: ncid - character*(*), intent(in):: var_name, att_name - real(kind=8), intent(out):: value - - integer:: status, varid - - status = nf_inq_varid (ncid, var_name, varid) - status = nf_get_att(ncid, varid, att_name, value) - - if (status .ne. NF_NOERR) call handle_err('get_var_att_double '//var_name,status) - - end subroutine get_var_att_double - - - subroutine handle_err(idstr, status, errflg) - integer status - character(len=500) :: errstr - character(len=*) :: idstr - integer, optional, intent(inout) :: errflg - - if (status .ne. nf_noerr) then - write(errstr,*) 'Error in handle_err: ',trim(idstr)//' ',NF_STRERROR(STATUS) - ! call mpp_error(FATAL,errstr) - ! if (available(errflg)) errflg = 1 - ! return - write(6, *) trim(errstr) - stop - endif - - end subroutine handle_err - -!>@brief The subroutine 'calendar' computes the current GMT. - subroutine calendar(year, month, day, hour) - integer, intent(inout) :: year ! year - integer, intent(inout) :: month ! month - integer, intent(inout) :: day ! day - integer, intent(inout) :: hour -! -! Local variables -! - integer irem4,irem100 - integer mdays(12) !< number day of month - data mdays /31,28,31,30,31,30,31,31,30,31,30,31/ -!**** consider leap year -! - irem4 = mod( year, 4 ) - irem100 = mod( year, 100 ) - if( irem4 == 0 .and. irem100 /= 0) mdays(2) = 29 -! - if( hour >= 24 ) then - day = day + 1 - hour = hour - 24 - end if - - if( day > mdays(month) ) then - day = day - mdays(month) - month = month + 1 - end if - if( month > 12 ) then - year = year + 1 - month = 1 - end if - - end subroutine calendar - -end module sim_nc_mod_lnd From e8149406d08eb8bcaff0e93c58998aa5b5cdedd9 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 11 Jul 2024 08:10:08 -0400 Subject: [PATCH 055/141] use explcit array length --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index de245fcca..ceb2a7b79 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -261,11 +261,14 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !nblks = Land_IAU_Control%nblks !blksz = Land_IAU_Control%blksz(1) - allocate(Land_IAU_Data%stc_inc(is:ie, js:je, km)) - allocate(Land_IAU_Data%slc_inc(is:ie, js:je, km)) + allocate(Land_IAU_Data%stc_inc(nlon, nlat, km)) + allocate(Land_IAU_Data%slc_inc(nlon, nlat, km)) ! allocate arrays that will hold iau state - allocate (Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - allocate (Land_IAU_state%inc1%slc_inc(is:ie, js:je, km)) + allocate (Land_IAU_state%inc1%stc_inc(nlon, nlat, km)) + allocate (Land_IAU_state%inc1%slc_inc(nlon, nlat, km)) + allocate (Land_IAU_state%inc2%stc_inc(nlon, nlat, km)) + allocate (Land_IAU_state%inc2%slc_inc(nlon, nlat, km)) + Land_IAU_state%hr1=Land_IAU_Control%iaufhrs(1) Land_IAU_state%wt = 1.0 ! IAU increment filter weights (default 1.0) Land_IAU_state%wt_normfact = 1.0 @@ -351,9 +354,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) if (ntimes.EQ.1) then ! only need to get incrments once since constant forcing over window call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%rdt, Land_IAU_state%wt) endif - if (ntimes.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them - allocate (Land_IAU_state%inc2%stc_inc(is:ie, js:je, km)) - allocate (Land_IAU_state%inc2%slc_inc(is:ie, js:je, km)) + if (ntimes.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) do k = 1, npz ! do k = 1,n_soill ! From 18c769ce66b0f841d9d194f6c03fb9cdf7a4d3e1 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 11 Jul 2024 08:16:02 -0400 Subject: [PATCH 056/141] use explcit array length --- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 0b9e17f97..fadbc70d1 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -4,7 +4,7 @@ dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90 dependencies = ../Noah/set_soilveg.f - dependencies = sim_nc_mod_lnd.F90,lnd_iau_mod.F90 + dependencies = lnd_iau_mod.F90 ######################################################################## [ccpp-arg-table] From 7644d5550c9cacf6bf71278217b312e8c45ac801 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 11 Jul 2024 08:44:12 -0400 Subject: [PATCH 057/141] debug print --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index ceb2a7b79..b6e322b54 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -261,6 +261,8 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !nblks = Land_IAU_Control%nblks !blksz = Land_IAU_Control%blksz(1) + print*, "rank is ie js je nlon nlat", Land_IAU_Control%me, is, ie, js, je, nlon, nlat + allocate(Land_IAU_Data%stc_inc(nlon, nlat, km)) allocate(Land_IAU_Data%slc_inc(nlon, nlat, km)) ! allocate arrays that will hold iau state From 77ed427372b797f2605c8b03b2d372ffdce0bc50 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 14 Jul 2024 10:26:05 -0400 Subject: [PATCH 058/141] read land snow mask from inc files --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 29 +++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index b6e322b54..d357ba48f 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -29,6 +29,7 @@ module land_iau_mod private real(kind=kind_phys), allocatable :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) + integer(kind=kind_phys), allocatable :: wk3_slmsk(:, :, :) type land_iau_internal_data_type real(kind=kind_phys),allocatable :: stc_inc(:,:,:) @@ -39,7 +40,7 @@ module land_iau_mod real(kind=kind_phys),allocatable :: stc_inc(:,:,:) real(kind=kind_phys),allocatable :: slc_inc(:,:,:) logical :: in_interval = .false. - ! integer,allocatable :: snow_land_mask(:, :, :) + integer,allocatable :: snow_land_mask(:, :) end type land_iau_external_data_type type land_iau_state_type @@ -265,6 +266,8 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) allocate(Land_IAU_Data%stc_inc(nlon, nlat, km)) allocate(Land_IAU_Data%slc_inc(nlon, nlat, km)) + allocate(Land_IAU_Data%snow_land_mask(nlon, nlat)) + ! allocate arrays that will hold iau state allocate (Land_IAU_state%inc1%stc_inc(nlon, nlat, km)) allocate (Land_IAU_state%inc1%slc_inc(nlon, nlat, km)) @@ -305,6 +308,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) endif ! determine number of valid forecast hours +!TODO: can read this from the increment file ("Time" dim) ntimesall = size(Land_IAU_Control%iaufhrs) ntimes = 0 do k=1,ntimesall @@ -339,7 +343,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval, rdt',Land_IAU_Control%iau_delthrs,Land_IAU_state%rdt ! Read all increment files at iau init time (at beginning of cycle) - ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) + ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) call read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, wk3_stc, wk3_slc ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) @@ -358,6 +362,8 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) endif if (ntimes.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) + + Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(1, :, :) do k = 1, npz ! do k = 1,n_soill ! do j = 1, nlat @@ -383,9 +389,11 @@ subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, errmsg, errflg if (allocated (wk3_stc)) deallocate (wk3_stc) if (allocated (wk3_slc)) deallocate (wk3_slc) + if (allocated (wk3_slmsk)) deallocate (wk3_slmsk) if (allocated(Land_IAU_Data%stc_inc)) deallocate (Land_IAU_Data%stc_inc) if (allocated(Land_IAU_Data%slc_inc)) deallocate (Land_IAU_Data%slc_inc) + if (allocated(Land_IAU_Data%snow_land_mask)) deallocate (Land_IAU_Data%snow_land_mask) if (allocated(Land_IAU_state%inc1%stc_inc)) deallocate(Land_IAU_state%inc1%stc_inc) if (allocated(Land_IAU_state%inc1%slc_inc)) deallocate(Land_IAU_state%inc1%slc_inc) @@ -483,6 +491,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) endif + Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(itnext-1, :, :) call updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%rdt, Land_IAU_state%wt) endif endif @@ -542,6 +551,7 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) Land_IAU_Data%stc_inc(i,j,k) = wt*Land_IAU_state%inc1%stc_inc(i,j,k)*rdt Land_IAU_Data%slc_inc(i,j,k) = wt*Land_IAU_state%inc1%slc_inc(i,j,k)*rdt end do + Land_IAU_Data%snow_land_mask(i, j) = wk3_slmsk(1, i, j) enddo enddo @@ -565,6 +575,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_ou character(len=32), dimension(4) :: stc_vars = [character(len=32) :: 'soilt1_inc', 'soilt2_inc', 'soilt3_inc', 'soilt4_inc'] character(len=32), dimension(4) :: slc_vars = [character(len=32) :: 'slc1_inc', 'slc2_inc', 'slc3_inc', 'slc4_inc'] + character(len=32) :: slsn_mask = "soilsnow_mask" !Errors messages handled through CCPP error handling variables errmsg = '' @@ -609,6 +620,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_ou allocate(wk3_stc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) allocate(wk3_slc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) + allocate(wk3_slmsk(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny)) do i = 1, size(stc_vars) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(stc_vars(i)) @@ -644,6 +656,19 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_ou wk3_slc(:, :, :, i) = 0. endif enddo + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(slsn_mask) + status = nf90_inq_varid(ncid, trim(slsn_mask), varid) + if (status == nf90_noerr) then !if (ierr == 0) then + do it = 1, n_t + call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, wk3_slmsk(it, :, :), status) + call netcdf_err(status, 'reading var: '//trim(slsn_mask), errflg, errmsg) + if (errflg .ne. 0) return + enddo + else + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, 'warning: no values for ',trim(slsn_mask), ' found', & + 'assuming value of 1 for all grid cells. Please make sure the increment files have soil snow mask var' + wk3_slmsk(:, :, :) = 1 + endif status =nf90_close(ncid) call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) From 4590b5d7bf9ffd45eab77df313a2ab25f7ea35b5 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 14 Jul 2024 10:47:39 -0400 Subject: [PATCH 059/141] read land snow mask from inc files --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 22 +++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index d357ba48f..850b86a4e 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -362,7 +362,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) endif if (ntimes.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) - + Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(1, :, :) do k = 1, npz ! do k = 1,n_soill ! @@ -660,7 +660,8 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_ou status = nf90_inq_varid(ncid, trim(slsn_mask), varid) if (status == nf90_noerr) then !if (ierr == 0) then do it = 1, n_t - call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, wk3_slmsk(it, :, :), status) + call get_var3d_values_int(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & + it, 1, wk3_slmsk(it, :, :), status) call netcdf_err(status, 'reading var: '//trim(slsn_mask), errflg, errmsg) if (errflg .ne. 0) return enddo @@ -810,6 +811,23 @@ subroutine get_var3d_values(ncid, varid, is,ix, js,jy, ks,kz, var3d, status) ! start = (/is, js, ks/), count = (/ie - is + 1, je - js + 1, ke - ks + 1/)) end subroutine get_var3d_values + + subroutine get_var3d_values_int(ncid, varid, is,ix, js,jy, ks,kz, var3d, status) + integer, intent(in):: ncid, varid + integer, intent(in):: is, ix, js, jy, ks,kz + integer, intent(out):: var3d(ix, jy, kz) !var3d(is:ie,js:je,ks:ke) + integer, intent(out):: status + ! integer, dimension(3):: start, nreco + ! start(1) = is; start(2) = js; start(3) = ks + ! nreco(1) = ie - is + 1 + ! nreco(2) = je - js + 1 + ! nreco(3) = ke - ks + 1 + + status = nf90_get_var(ncid, varid, var3d, & !start = start, count = nreco) + start = (/is, js, ks/), count = (/ix, jy, kz/)) + ! start = (/is, js, ks/), count = (/ie - is + 1, je - js + 1, ke - ks + 1/)) + + end subroutine get_var3d_values_int end module land_iau_mod From 562e6d3cae58cde0b8de5671cb2bafa530f3834b Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 14 Jul 2024 11:11:03 -0400 Subject: [PATCH 060/141] read land snow mask from inc files --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 850b86a4e..cc69dcc28 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -29,7 +29,7 @@ module land_iau_mod private real(kind=kind_phys), allocatable :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) - integer(kind=kind_phys), allocatable :: wk3_slmsk(:, :, :) + integer, allocatable :: wk3_slmsk(:, :, :) type land_iau_internal_data_type real(kind=kind_phys),allocatable :: stc_inc(:,:,:) From 1a936bb0b43cc5beef6f73fde13004656896e7f2 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 14 Jul 2024 14:18:37 -0400 Subject: [PATCH 061/141] test on adj --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 42 ++++++++++---------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 74aaffb9e..7b0115611 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -328,27 +328,27 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo return endif n_stc = 0 - do i=1,lensfc - if (stc_updated(i) == 1 ) then ! soil-only location - n_stc = n_stc+1 - soiltype = soiltyp(i) - do l = 1, lsoil_incr - !case 1: frz ==> frz, recalculate slc, smc remains - !case 2: unfrz ==> frz, recalculate slc, smc remains - !both cases are considered in the following if case - if (stc(i,l) .LT. tfreez )then - !recompute supercool liquid water,smc_anl remain unchanged - smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) - slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) - slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) - endif - !case 3: frz ==> unfrz, melt all soil ice (if any) - if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck - slc(i,l)=smc(i,l) - endif - enddo - endif - enddo + ! do i=1,lensfc + ! if (stc_updated(i) == 1 ) then ! soil-only location + ! n_stc = n_stc+1 + ! soiltype = soiltyp(i) + ! do l = 1, lsoil_incr + ! !case 1: frz ==> frz, recalculate slc, smc remains + ! !case 2: unfrz ==> frz, recalculate slc, smc remains + ! !both cases are considered in the following if case + ! if (stc(i,l) .LT. tfreez )then + ! !recompute supercool liquid water,smc_anl remain unchanged + ! smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) + ! slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) + ! slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) + ! endif + ! !case 3: frz ==> unfrz, melt all soil ice (if any) + ! if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck + ! slc(i,l)=smc(i,l) + ! endif + ! enddo + ! endif + ! enddo deallocate(stc_updated) deallocate(mask_tile) From f53c9ab937a84a37ab1e31070b2055a03bf773e6 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 15 Jul 2024 10:21:10 -0400 Subject: [PATCH 062/141] print debug info --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 39 ++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 7b0115611..68c27cab0 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -280,6 +280,31 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo !TODO---if only fv3 increment files are used, this can be read from file allocate(mask_tile(lensfc)) call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) !& !veg_type_landice, + + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "root proc, tile num, layer 1 stc", Land_IAU_Control%me, Land_IAU_Control%tile_num + ! do ij = 1, lensfc + ! print*, stc(ij,1) + ! enddo + ib = 1 + do j = 1, Land_IAU_Control%ny !ny + do i = ib, ib+Land_IAU_Control%nx-1 + print*, stc(i, 1) + enddo + ib = ib + Land_IAU_Control%nx !nlon + enddo + print*, "root proc layer 1 inc" + ! do ij = 1, lensfc + ! print*, stc_inc_flat(ij,k)*delt !Land_IAU_Control%dtp + ! enddo + ib = 1 + do j = 1, Land_IAU_Control%ny !ny + do i = ib, ib+Land_IAU_Control%nx-1 + print*, stc_inc_flat(i, 1)*delt + enddo + ib = ib + Land_IAU_Control%nx !nlon + enddo + endif !IAU increments are in units of 1/sec !Land_IAU_Control%dtp !* only updating soil temp for now @@ -312,6 +337,20 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !Land_IAU_Control%dtp ! ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !Land_IAU_Control%dtp ! enddo + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "root proc layer 1 stc after adding IAU inc" + ! do ij = 1, lensfc + ! print*, stc(ij,1) + ! enddo + ib = 1 + do j = 1, Land_IAU_Control%ny !ny + do i = ib, ib+Land_IAU_Control%nx-1 + print*, stc(i, 1) + enddo + ib = ib + Land_IAU_Control%nx !nlon + enddo + endif + deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) ! (consistency) adjustments for updated soil temp and moisture From e6b68c7c927cea46cb6f4ec7f4d7201e38c72051 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 15 Jul 2024 10:57:17 -0400 Subject: [PATCH 063/141] print debug info --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 68c27cab0..7bf1fd6fa 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -288,9 +288,11 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! enddo ib = 1 do j = 1, Land_IAU_Control%ny !ny - do i = ib, ib+Land_IAU_Control%nx-1 - print*, stc(i, 1) - enddo + ! do i = ib, ib+Land_IAU_Control%nx-1 + ! print*, stc(i, 1) + ! WRITE(*,"(10F5.2)") + ! enddo + WRITE(*,"(48F7.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) ib = ib + Land_IAU_Control%nx !nlon enddo print*, "root proc layer 1 inc" @@ -299,9 +301,10 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! enddo ib = 1 do j = 1, Land_IAU_Control%ny !ny - do i = ib, ib+Land_IAU_Control%nx-1 - print*, stc_inc_flat(i, 1)*delt - enddo + ! do i = ib, ib+Land_IAU_Control%nx-1 + ! print*, stc_inc_flat(i, 1)*delt + ! enddo + WRITE(*,"(48F7.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1) ib = ib + Land_IAU_Control%nx !nlon enddo endif @@ -350,7 +353,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ib = ib + Land_IAU_Control%nx !nlon enddo endif - + deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) ! (consistency) adjustments for updated soil temp and moisture From c575a42f4c5bec4f44b7903f89c44b463f6dc30a Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 15 Jul 2024 11:27:22 -0400 Subject: [PATCH 064/141] print debug info --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 7bf1fd6fa..a037e6bf9 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -292,7 +292,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! print*, stc(i, 1) ! WRITE(*,"(10F5.2)") ! enddo - WRITE(*,"(48F7.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) + WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) ib = ib + Land_IAU_Control%nx !nlon enddo print*, "root proc layer 1 inc" @@ -304,7 +304,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! do i = ib, ib+Land_IAU_Control%nx-1 ! print*, stc_inc_flat(i, 1)*delt ! enddo - WRITE(*,"(48F7.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1) + WRITE(*,"(48F6.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1)*delt ib = ib + Land_IAU_Control%nx !nlon enddo endif @@ -347,9 +347,10 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! enddo ib = 1 do j = 1, Land_IAU_Control%ny !ny - do i = ib, ib+Land_IAU_Control%nx-1 - print*, stc(i, 1) - enddo + ! do i = ib, ib+Land_IAU_Control%nx-1 + ! print*, stc(i, 1) + ! enddo + WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) ib = ib + Land_IAU_Control%nx !nlon enddo endif From ca26670f7060f7cd80ffa1fb8d876bb0ba3c4c7e Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 15 Jul 2024 16:53:18 -0400 Subject: [PATCH 065/141] restrore stc/slc adjustments --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 42 ++++++++++---------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index a037e6bf9..598295498 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -371,27 +371,27 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo return endif n_stc = 0 - ! do i=1,lensfc - ! if (stc_updated(i) == 1 ) then ! soil-only location - ! n_stc = n_stc+1 - ! soiltype = soiltyp(i) - ! do l = 1, lsoil_incr - ! !case 1: frz ==> frz, recalculate slc, smc remains - ! !case 2: unfrz ==> frz, recalculate slc, smc remains - ! !both cases are considered in the following if case - ! if (stc(i,l) .LT. tfreez )then - ! !recompute supercool liquid water,smc_anl remain unchanged - ! smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) - ! slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) - ! slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) - ! endif - ! !case 3: frz ==> unfrz, melt all soil ice (if any) - ! if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck - ! slc(i,l)=smc(i,l) - ! endif - ! enddo - ! endif - ! enddo + do i=1,lensfc + if (stc_updated(i) == 1 ) then ! soil-only location + n_stc = n_stc+1 + soiltype = soiltyp(i) + do l = 1, lsoil_incr + !case 1: frz ==> frz, recalculate slc, smc remains + !case 2: unfrz ==> frz, recalculate slc, smc remains + !both cases are considered in the following if case + if (stc(i,l) .LT. tfreez )then + !recompute supercool liquid water,smc_anl remain unchanged + smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) + slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) + slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) + endif + !case 3: frz ==> unfrz, melt all soil ice (if any) + if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck + slc(i,l)=smc(i,l) + endif + enddo + endif + enddo deallocate(stc_updated) deallocate(mask_tile) From 2c0c276ea0141448f291e3f3d5f9c503e1077245 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 16 Jul 2024 09:52:41 -0400 Subject: [PATCH 066/141] print diff indices --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 52 ++++++++++---------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 598295498..88f3d807d 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -184,7 +184,9 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo integer, intent(out) :: errflg ! IAU update - real,allocatable :: stc_inc_flat(:,:) + real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat + real(kind=kind_phys),allocatable, dimension(:) :: stc_bck, d_stc + integer, allocatable, dimension(:) :: diff_indices ! real,allocatable :: slc_inc_flat(:,:) integer :: lsoil_incr ! integer :: veg_type_landice @@ -194,17 +196,17 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo logical :: soil_freeze, soil_ice integer :: n_freeze, n_thaw integer :: soiltype, n_stc - real :: slc_new + real(kind=kind_phys) :: slc_new integer :: i, j, ij, l, k, ib integer :: lensfc ! real (kind=kind_phys), dimension(max_soiltyp) :: maxsmc, bb, satpsi ! real, dimension(30) :: maxsmc, bb, satpsi - real, parameter :: tfreez=273.16 !< con_t0c in physcons - real, parameter :: hfus=0.3336e06 !< latent heat of fusion(j/kg) - real, parameter :: grav=9.80616 !< gravity accel.(m/s2) - real :: smp !< for computing supercooled water + real(kind=kind_phys), parameter :: tfreez=273.16 !< con_t0c in physcons + real(kind=kind_phys), parameter :: hfus=0.3336e06 !< latent heat of fusion(j/kg) + real(kind=kind_phys), parameter :: grav=9.80616 !< gravity accel.(m/s2) + real(kind=kind_phys) :: smp !< for computing supercooled water integer :: nother, nsnowupd integer :: nstcupd, nfrozen, nfrozen_upd @@ -249,6 +251,11 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols ! allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) + !copy background stc + allocate(stc_bck(Land_IAU_Control%nx * Land_IAU_Control%ny)) + allocate(d_stc(Land_IAU_Control%nx * Land_IAU_Control%ny)) + stc_bck = stc(:, 1) + stc_updated = 0 ib = 1 do j = 1, Land_IAU_Control%ny !ny @@ -259,6 +266,8 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ib = ib + Land_IAU_Control%nx !nlon enddo + + ! delt=GFS_Control%dtf if ((Land_IAU_Control%dtp - delt) > 0.0001) then if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then @@ -283,27 +292,14 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print*, "root proc, tile num, layer 1 stc", Land_IAU_Control%me, Land_IAU_Control%tile_num - ! do ij = 1, lensfc - ! print*, stc(ij,1) - ! enddo ib = 1 do j = 1, Land_IAU_Control%ny !ny - ! do i = ib, ib+Land_IAU_Control%nx-1 - ! print*, stc(i, 1) - ! WRITE(*,"(10F5.2)") - ! enddo WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) ib = ib + Land_IAU_Control%nx !nlon enddo print*, "root proc layer 1 inc" - ! do ij = 1, lensfc - ! print*, stc_inc_flat(ij,k)*delt !Land_IAU_Control%dtp - ! enddo ib = 1 do j = 1, Land_IAU_Control%ny !ny - ! do i = ib, ib+Land_IAU_Control%nx-1 - ! print*, stc_inc_flat(i, 1)*delt - ! enddo WRITE(*,"(48F6.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1)*delt ib = ib + Land_IAU_Control%nx !nlon enddo @@ -342,14 +338,8 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! enddo if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print*, "root proc layer 1 stc after adding IAU inc" - ! do ij = 1, lensfc - ! print*, stc(ij,1) - ! enddo ib = 1 do j = 1, Land_IAU_Control%ny !ny - ! do i = ib, ib+Land_IAU_Control%nx-1 - ! print*, stc(i, 1) - ! enddo WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) ib = ib + Land_IAU_Control%nx !nlon enddo @@ -392,9 +382,19 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo enddo endif enddo - + + d_stc = stc(:, 1) - stc_bck + ! Where(d_stc .gt. 0.0001) + diff_indices = pack([(i, i=1, lensfc)], d_stc > 0.0001) + print*, "proc ", Land_IAU_Control%me, " indices with large increment" + print*, diff_indices + print*, d_stc(diff_indices) + + deallocate(stc_bck, d_stc) + if(allocated(diff_indices)) deallocate(diff_indices) deallocate(stc_updated) deallocate(mask_tile) + write(*,'(a,i2)') ' statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me write(*,'(a,i8)') ' soil grid total', lensfc From 119ebbd13d04cbf246b9f7224e91f43dc3971443 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 18 Jul 2024 17:38:38 -0400 Subject: [PATCH 067/141] bypass _timestep_init --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 88f3d807d..873550d9d 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -214,6 +214,8 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! --- Initialize CCPP error handling variables errmsg = '' errflg = 0 + + return if (.not. Land_IAU_Control%do_land_iau) return From 9bfc30561d38558b8f76127b2ba5e121510af7e4 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 18 Jul 2024 18:33:42 -0400 Subject: [PATCH 068/141] bypass _timestep_init --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 303 ++++++++++--------- 1 file changed, 154 insertions(+), 149 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 873550d9d..5a61cc435 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -214,8 +214,6 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo ! --- Initialize CCPP error handling variables errmsg = '' errflg = 0 - - return if (.not. Land_IAU_Control%do_land_iau) return @@ -249,163 +247,170 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo return endif - ! local variable to copy blocked data Land_IAU_Data%stc_inc - allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols - ! allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols - allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) - !copy background stc - allocate(stc_bck(Land_IAU_Control%nx * Land_IAU_Control%ny)) - allocate(d_stc(Land_IAU_Control%nx * Land_IAU_Control%ny)) - stc_bck = stc(:, 1) - - stc_updated = 0 - ib = 1 - do j = 1, Land_IAU_Control%ny !ny - do k = 1, km - stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%stc_inc(:,j, k) - ! slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) - enddo - ib = ib + Land_IAU_Control%nx !nlon + do j = 33, 35 + do i = 40, 42 + ib = (j - 1) * Land_IAU_Control%nx + i + stc(ib, 1) = Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp + enddo enddo +! ! local variable to copy blocked data Land_IAU_Data%stc_inc +! allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols +! ! allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols +! allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) +! !copy background stc +! allocate(stc_bck(Land_IAU_Control%nx * Land_IAU_Control%ny)) +! allocate(d_stc(Land_IAU_Control%nx * Land_IAU_Control%ny)) +! stc_bck = stc(:, 1) + +! stc_updated = 0 +! ib = 1 +! do j = 1, Land_IAU_Control%ny !ny +! do k = 1, km +! stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%stc_inc(:,j, k) +! ! slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) +! enddo +! ib = ib + Land_IAU_Control%nx !nlon +! enddo + - ! delt=GFS_Control%dtf - if ((Land_IAU_Control%dtp - delt) > 0.0001) then - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "Warning noahmpdrv_run delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp - endif - endif +! ! delt=GFS_Control%dtf +! if ((Land_IAU_Control%dtp - delt) > 0.0001) then +! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then +! print*, "Warning noahmpdrv_run delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp +! endif +! endif - lsoil_incr = Land_IAU_Control%lsoil_incr - lensfc = Land_IAU_Control%nx * Land_IAU_Control%ny - - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,' adjusting first ', lsoil_incr, ' surface layers only, delt ', delt - ! initialize variables for counts statitics to be zeros - nother = 0 ! grid cells not land - nsnowupd = 0 ! grid cells with snow (temperature not yet updated) - nstcupd = 0 ! grid cells that are updated - nfrozen = 0 ! not update as frozen soil - nfrozen_upd = 0 ! not update as frozen soil - -!TODO---if only fv3 increment files are used, this can be read from file - allocate(mask_tile(lensfc)) - call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) !& !veg_type_landice, - - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "root proc, tile num, layer 1 stc", Land_IAU_Control%me, Land_IAU_Control%tile_num - ib = 1 - do j = 1, Land_IAU_Control%ny !ny - WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) - ib = ib + Land_IAU_Control%nx !nlon - enddo - print*, "root proc layer 1 inc" - ib = 1 - do j = 1, Land_IAU_Control%ny !ny - WRITE(*,"(48F6.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1)*delt - ib = ib + Land_IAU_Control%nx !nlon - enddo - endif +! lsoil_incr = Land_IAU_Control%lsoil_incr +! lensfc = Land_IAU_Control%nx * Land_IAU_Control%ny + +! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,' adjusting first ', lsoil_incr, ' surface layers only, delt ', delt +! ! initialize variables for counts statitics to be zeros +! nother = 0 ! grid cells not land +! nsnowupd = 0 ! grid cells with snow (temperature not yet updated) +! nstcupd = 0 ! grid cells that are updated +! nfrozen = 0 ! not update as frozen soil +! nfrozen_upd = 0 ! not update as frozen soil + +! !TODO---if only fv3 increment files are used, this can be read from file +! allocate(mask_tile(lensfc)) +! call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) !& !veg_type_landice, + +! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then +! print*, "root proc, tile num, layer 1 stc", Land_IAU_Control%me, Land_IAU_Control%tile_num +! ib = 1 +! do j = 1, Land_IAU_Control%ny !ny +! WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) +! ib = ib + Land_IAU_Control%nx !nlon +! enddo +! print*, "root proc layer 1 inc" +! ib = 1 +! do j = 1, Land_IAU_Control%ny !ny +! WRITE(*,"(48F6.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1)*delt +! ib = ib + Land_IAU_Control%nx !nlon +! enddo +! endif - !IAU increments are in units of 1/sec !Land_IAU_Control%dtp - !* only updating soil temp for now - ij_loop : do ij = 1, lensfc - ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land - if (mask_tile(ij) == 1) then - ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*, "root proc layer 1 stc, inc ", stc(ij,1), stc_inc_flat(ij,1) - soil_freeze=.false. - soil_ice=.false. - do k = 1, lsoil_incr ! k = 1, km - if ( stc(ij,k) < tfreez) soil_freeze=.true. - if ( smc(ij,k) - slc(ij,k) > 0.001 ) soil_ice=.true. - - stc(ij,k) = stc(ij,k) + stc_inc_flat(ij,k)*delt !Land_IAU_Control%dtp - - if (k==1) then - stc_updated(ij) = 1 - nstcupd = nstcupd + 1 - endif - if ( (stc(ij,k) < tfreez) .and. (.not. soil_freeze) .and. (k==1) )& - nfrozen_upd = nfrozen_upd + 1 - ! moisture updates not done if this layer or any above is frozen - if ( soil_freeze .or. soil_ice ) then - if (k==1) nfrozen = nfrozen+1 - endif - enddo - endif ! if soil/snow point - enddo ij_loop - ! do k = 1, km - ! stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !Land_IAU_Control%dtp - ! ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !Land_IAU_Control%dtp - ! enddo - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "root proc layer 1 stc after adding IAU inc" - ib = 1 - do j = 1, Land_IAU_Control%ny !ny - WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) - ib = ib + Land_IAU_Control%nx !nlon - enddo - endif - - deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) - -! (consistency) adjustments for updated soil temp and moisture - - ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) - call read_mp_table_parameters(errmsg, errflg) - ! maxsmc(1:slcats) = smcmax_table(1:slcats) - ! bb(1:slcats) = bexp_table(1:slcats) - ! satpsi(1:slcats) = psisat_table(1:slcats) +! !IAU increments are in units of 1/sec !Land_IAU_Control%dtp +! !* only updating soil temp for now +! ij_loop : do ij = 1, lensfc +! ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land +! if (mask_tile(ij) == 1) then +! ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*, "root proc layer 1 stc, inc ", stc(ij,1), stc_inc_flat(ij,1) +! soil_freeze=.false. +! soil_ice=.false. +! do k = 1, lsoil_incr ! k = 1, km +! if ( stc(ij,k) < tfreez) soil_freeze=.true. +! if ( smc(ij,k) - slc(ij,k) > 0.001 ) soil_ice=.true. + +! stc(ij,k) = stc(ij,k) + stc_inc_flat(ij,k)*delt !Land_IAU_Control%dtp + +! if (k==1) then +! stc_updated(ij) = 1 +! nstcupd = nstcupd + 1 +! endif +! if ( (stc(ij,k) < tfreez) .and. (.not. soil_freeze) .and. (k==1) )& +! nfrozen_upd = nfrozen_upd + 1 +! ! moisture updates not done if this layer or any above is frozen +! if ( soil_freeze .or. soil_ice ) then +! if (k==1) nfrozen = nfrozen+1 +! endif +! enddo +! endif ! if soil/snow point +! enddo ij_loop +! ! do k = 1, km +! ! stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !Land_IAU_Control%dtp +! ! ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !Land_IAU_Control%dtp +! ! enddo +! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then +! print*, "root proc layer 1 stc after adding IAU inc" +! ib = 1 +! do j = 1, Land_IAU_Control%ny !ny +! WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) +! ib = ib + Land_IAU_Control%nx !nlon +! enddo +! endif + +! deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) + +! ! (consistency) adjustments for updated soil temp and moisture + +! ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) +! call read_mp_table_parameters(errmsg, errflg) +! ! maxsmc(1:slcats) = smcmax_table(1:slcats) +! ! bb(1:slcats) = bexp_table(1:slcats) +! ! satpsi(1:slcats) = psisat_table(1:slcats) - if (errflg .ne. 0) then - print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' - errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' - return - endif - n_stc = 0 - do i=1,lensfc - if (stc_updated(i) == 1 ) then ! soil-only location - n_stc = n_stc+1 - soiltype = soiltyp(i) - do l = 1, lsoil_incr - !case 1: frz ==> frz, recalculate slc, smc remains - !case 2: unfrz ==> frz, recalculate slc, smc remains - !both cases are considered in the following if case - if (stc(i,l) .LT. tfreez )then - !recompute supercool liquid water,smc_anl remain unchanged - smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) - slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) - slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) - endif - !case 3: frz ==> unfrz, melt all soil ice (if any) - if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck - slc(i,l)=smc(i,l) - endif - enddo - endif - enddo - - d_stc = stc(:, 1) - stc_bck - ! Where(d_stc .gt. 0.0001) - diff_indices = pack([(i, i=1, lensfc)], d_stc > 0.0001) - print*, "proc ", Land_IAU_Control%me, " indices with large increment" - print*, diff_indices - print*, d_stc(diff_indices) +! if (errflg .ne. 0) then +! print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' +! errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' +! return +! endif +! n_stc = 0 +! do i=1,lensfc +! if (stc_updated(i) == 1 ) then ! soil-only location +! n_stc = n_stc+1 +! soiltype = soiltyp(i) +! do l = 1, lsoil_incr +! !case 1: frz ==> frz, recalculate slc, smc remains +! !case 2: unfrz ==> frz, recalculate slc, smc remains +! !both cases are considered in the following if case +! if (stc(i,l) .LT. tfreez )then +! !recompute supercool liquid water,smc_anl remain unchanged +! smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) +! slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) +! slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) +! endif +! !case 3: frz ==> unfrz, melt all soil ice (if any) +! if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck +! slc(i,l)=smc(i,l) +! endif +! enddo +! endif +! enddo + +! d_stc = stc(:, 1) - stc_bck +! ! Where(d_stc .gt. 0.0001) +! diff_indices = pack([(i, i=1, lensfc)], d_stc > 0.0001) +! print*, "proc ", Land_IAU_Control%me, " indices with large increment" +! print*, diff_indices +! print*, d_stc(diff_indices) - deallocate(stc_bck, d_stc) - if(allocated(diff_indices)) deallocate(diff_indices) - deallocate(stc_updated) - deallocate(mask_tile) +! deallocate(stc_bck, d_stc) +! if(allocated(diff_indices)) deallocate(diff_indices) +! deallocate(stc_updated) +! deallocate(mask_tile) - write(*,'(a,i2)') ' statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me - write(*,'(a,i8)') ' soil grid total', lensfc - write(*,'(a,i8)') ' soil grid cells stc updated = ',nstcupd - write(*,'(a,i8)') ' soil grid cells not updated, frozen = ',nfrozen - write(*,'(a,i8)') ' soil grid cells update, became frozen = ',nfrozen_upd - write(*,'(a,i8)') ' (not updated yet) snow grid cells = ', nsnowupd - write(*,'(a,i8)') ' grid cells, without soil or snow = ', nother - write(*,'(a,i8)') ' soil grid cells with stc update', n_stc +! write(*,'(a,i2)') ' statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me +! write(*,'(a,i8)') ' soil grid total', lensfc +! write(*,'(a,i8)') ' soil grid cells stc updated = ',nstcupd +! write(*,'(a,i8)') ' soil grid cells not updated, frozen = ',nfrozen +! write(*,'(a,i8)') ' soil grid cells update, became frozen = ',nfrozen_upd +! write(*,'(a,i8)') ' (not updated yet) snow grid cells = ', nsnowupd +! write(*,'(a,i8)') ' grid cells, without soil or snow = ', nother +! write(*,'(a,i8)') ' soil grid cells with stc update', n_stc endif From 3234712bc63761a2f403f8c0033d3464eac300fc Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 19 Jul 2024 18:05:06 -0400 Subject: [PATCH 069/141] test with hardcoded inc --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 19 ++++++++++++------- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 7 +++++++ 2 files changed, 19 insertions(+), 7 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 5a61cc435..bc40854f6 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -155,7 +155,7 @@ end subroutine noahmpdrv_init !! Note: For Case 3, Yuan Xue thoroughly evaluated a total of four options and !! current option is found to be the best as of 11/09/2023 -subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_root, +subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & !me, mpi_root, isot, ivegsrc, soiltyp, vegtype, weasd, & stc, slc, smc, errmsg, errflg) ! smc, t2mmp, q2mp, @@ -170,6 +170,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) real(kind=kind_phys) , intent(in) :: delt ! time interval [s] integer , intent(in) :: km !vertical soil layer dimension + integer, intent(in) :: ncols integer, intent(in) :: isot integer, intent(in) :: ivegsrc @@ -247,12 +248,16 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, & !me, mpi_roo return endif - do j = 33, 35 - do i = 40, 42 - ib = (j - 1) * Land_IAU_Control%nx + i - stc(ib, 1) = Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp - enddo - enddo + if(Land_IAU_Control%tile_num == 1) then + print*, "proc, tile num, layer 1 stc_inc at 33:35,40:42", Land_IAU_Control%me, Land_IAU_Control%tile_num + do j = 33, 35 + WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) + do i = 40, 42 + ib = (j - 1) * Land_IAU_Control%nx + i + stc(ib, 1) = stc(ib, 1) + 0.9 * 4.6296296296296296296296296296296e-5 * delt !0.05 !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp + enddo + enddo + endif ! ! local variable to copy blocked data Land_IAU_Data%stc_inc ! allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index fadbc70d1..892894329 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -257,6 +257,13 @@ dimensions = () type = integer intent = in +[ncols] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in [isot] standard_name = control_for_soil_type_dataset long_name = soil type dataset choice From 432015dc6197c9ce933d516ddad26fe1e8ec1416 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 19 Jul 2024 19:06:53 -0400 Subject: [PATCH 070/141] test with hardcoded inc --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index bc40854f6..6cfedee8c 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -186,7 +186,8 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! IAU update real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat - real(kind=kind_phys),allocatable, dimension(:) :: stc_bck, d_stc + ! real(kind=kind_phys),allocatable, dimension(:) :: stc_bck, d_stc + real(kind=kind_phys), :: stc_bck(ncols, km), d_stc(ncols, km) integer, allocatable, dimension(:) :: diff_indices ! real,allocatable :: slc_inc_flat(:,:) integer :: lsoil_incr @@ -209,6 +210,8 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & real(kind=kind_phys), parameter :: grav=9.80616 !< gravity accel.(m/s2) real(kind=kind_phys) :: smp !< for computing supercooled water + real(kind=kind_phys) :: hc_incr + integer :: nother, nsnowupd integer :: nstcupd, nfrozen, nfrozen_upd @@ -248,13 +251,18 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & return endif + stc_bck = stc + hc_incr = 0.9 * 4.6296296296296296296296296296296e-5 * delt !0.05 + if(Land_IAU_Control%tile_num == 1) then + print*, "stc_bck shape, min, max ", shape(stc_bck), minval(stc_bck), maxval(stc_bck) + print*, " hc_incr ", hc_incr print*, "proc, tile num, layer 1 stc_inc at 33:35,40:42", Land_IAU_Control%me, Land_IAU_Control%tile_num do j = 33, 35 WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) do i = 40, 42 ib = (j - 1) * Land_IAU_Control%nx + i - stc(ib, 1) = stc(ib, 1) + 0.9 * 4.6296296296296296296296296296296e-5 * delt !0.05 !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp + stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp enddo enddo endif From 62fd97c0b339113d93e6b7ca8f93f3a11ee4ec05 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 19 Jul 2024 19:28:58 -0400 Subject: [PATCH 071/141] test with hardcoded inc --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 6cfedee8c..4627cb74d 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -187,7 +187,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! IAU update real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat ! real(kind=kind_phys),allocatable, dimension(:) :: stc_bck, d_stc - real(kind=kind_phys), :: stc_bck(ncols, km), d_stc(ncols, km) + real(kind=kind_phys) :: stc_bck(ncols, km), d_stc(ncols, km) integer, allocatable, dimension(:) :: diff_indices ! real,allocatable :: slc_inc_flat(:,:) integer :: lsoil_incr From 6c2ac7618940c499172292be9f9de6106c2be547 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 19 Jul 2024 20:17:12 -0400 Subject: [PATCH 072/141] test with hardcoded inc --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 4627cb74d..0fb4221d8 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -252,7 +252,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & endif stc_bck = stc - hc_incr = 0.9 * 4.6296296296296296296296296296296e-5 * delt !0.05 + hc_incr = 0.0 !0.9 * 4.6296296296296296296296296296296e-5 * delt !0.05 if(Land_IAU_Control%tile_num == 1) then print*, "stc_bck shape, min, max ", shape(stc_bck), minval(stc_bck), maxval(stc_bck) From bde3e05738c570c6ace189a794f65e6e064c95d4 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 19 Jul 2024 20:58:23 -0400 Subject: [PATCH 073/141] test with hardcoded inc --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 28 +++++++++++--------- 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 0fb4221d8..c47eda703 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -254,18 +254,22 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & stc_bck = stc hc_incr = 0.0 !0.9 * 4.6296296296296296296296296296296e-5 * delt !0.05 - if(Land_IAU_Control%tile_num == 1) then - print*, "stc_bck shape, min, max ", shape(stc_bck), minval(stc_bck), maxval(stc_bck) - print*, " hc_incr ", hc_incr - print*, "proc, tile num, layer 1 stc_inc at 33:35,40:42", Land_IAU_Control%me, Land_IAU_Control%tile_num - do j = 33, 35 - WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) - do i = 40, 42 - ib = (j - 1) * Land_IAU_Control%nx + i - stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp - enddo - enddo - endif + ! if(Land_IAU_Control%tile_num == 1) then + ! print*, "stc_bck shape, min, max ", shape(stc_bck), minval(stc_bck), maxval(stc_bck) + ! print*, " hc_incr ", hc_incr + ! print*, "proc, tile num, layer 1 stc_inc at 33:35,40:42", Land_IAU_Control%me, Land_IAU_Control%tile_num + ! do j = 33, 35 + ! WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) + ! do i = 40, 42 + ! ib = (j - 1) * Land_IAU_Control%nx + i + ! stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp + ! enddo + ! enddo + ! endif + + do ib = 1, ncols + stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp + enddo ! ! local variable to copy blocked data Land_IAU_Data%stc_inc ! allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols From ff3660f24096fd67a0d7d5af31c8b6de0587c23a Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 21 Jul 2024 13:54:28 -0400 Subject: [PATCH 074/141] test non-iau increment hardcoded --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index c47eda703..ffc8c6b31 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -267,9 +267,9 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! enddo ! endif - do ib = 1, ncols - stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp - enddo + ! do ib = 1, ncols + ! stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp + ! enddo ! ! local variable to copy blocked data Land_IAU_Data%stc_inc ! allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols @@ -1059,6 +1059,8 @@ subroutine noahmpdrv_run & errmsg = '' errflg = 0 + stc(:, 4) = stc(:, 4) + 0.000001 + do i = 1, im if (flag_iter(i) .and. dry(i)) then From 6f18f657375b399dd08a61894981002f84a8b7a4 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 23 Jul 2024 07:13:48 -0400 Subject: [PATCH 075/141] test 0 inc double prec --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 266 ++++++++++--------- 1 file changed, 138 insertions(+), 128 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index ffc8c6b31..a6697effc 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -240,136 +240,148 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & endif !> update land states with iau increments - if (Land_IAU_Data%in_interval) then + if (.not. Land_IAU_Data%in_interval) then if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "adding land iau increments " + print*, "current time step not in IAU interval " endif + return + endif - if (Land_IAU_Control%lsoil .ne. km) then - write(errmsg,*) 'noahmpdrv_timestep_init: Land_IAU_Data%lsoil ',Land_IAU_Control%lsoil,' not equal to km ',km - errflg = 1 - return - endif + ! if (Land_IAU_Data%in_interval) then + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "adding land iau increments " + endif - stc_bck = stc - hc_incr = 0.0 !0.9 * 4.6296296296296296296296296296296e-5 * delt !0.05 - - ! if(Land_IAU_Control%tile_num == 1) then - ! print*, "stc_bck shape, min, max ", shape(stc_bck), minval(stc_bck), maxval(stc_bck) - ! print*, " hc_incr ", hc_incr - ! print*, "proc, tile num, layer 1 stc_inc at 33:35,40:42", Land_IAU_Control%me, Land_IAU_Control%tile_num - ! do j = 33, 35 - ! WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) - ! do i = 40, 42 - ! ib = (j - 1) * Land_IAU_Control%nx + i - ! stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp - ! enddo - ! enddo - ! endif - - ! do ib = 1, ncols - ! stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp - ! enddo + if (Land_IAU_Control%lsoil .ne. km) then + write(errmsg,*) 'noahmpdrv_timestep_init: Land_IAU_Data%lsoil ',Land_IAU_Control%lsoil,' not equal to km ',km + errflg = 1 + return + endif -! ! local variable to copy blocked data Land_IAU_Data%stc_inc -! allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols -! ! allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols -! allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) -! !copy background stc -! allocate(stc_bck(Land_IAU_Control%nx * Land_IAU_Control%ny)) -! allocate(d_stc(Land_IAU_Control%nx * Land_IAU_Control%ny)) -! stc_bck = stc(:, 1) - -! stc_updated = 0 -! ib = 1 -! do j = 1, Land_IAU_Control%ny !ny -! do k = 1, km -! stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%stc_inc(:,j, k) -! ! slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) -! enddo -! ib = ib + Land_IAU_Control%nx !nlon -! enddo + stc_bck = stc + + ! hc_incr = 0.0 !0.9 * 4.6296296296296296296296296296296e-5 * delt !0.05 + + ! if(Land_IAU_Control%tile_num == 1) then + ! print*, "stc_bck shape, min, max ", shape(stc_bck), minval(stc_bck), maxval(stc_bck) + ! print*, " hc_incr ", hc_incr + ! print*, "proc, tile num, layer 1 stc_inc at 33:35,40:42", Land_IAU_Control%me, Land_IAU_Control%tile_num + ! do j = 33, 35 + ! WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) + ! do i = 40, 42 + ! ib = (j - 1) * Land_IAU_Control%nx + i + ! stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp + ! enddo + ! enddo + ! endif + + ! do ib = 1, ncols + ! stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp + ! enddo + + ! local variable to copy blocked data Land_IAU_Data%stc_inc + allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols + ! allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols + allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) + !copy background stc + + stc_updated = 0 + ib = 1 + do j = 1, Land_IAU_Control%ny !ny + do k = 1, km + stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%stc_inc(:,j, k) + ! slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) + enddo + ib = ib + Land_IAU_Control%nx !nlon + enddo + + ! delt=GFS_Control%dtf + if ((Land_IAU_Control%dtp - delt) > 0.0001) then + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "Warning noahmpdrv_run delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp + endif + endif + + lsoil_incr = Land_IAU_Control%lsoil_incr + lensfc = Land_IAU_Control%nx * Land_IAU_Control%ny - + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,' adjusting first ', lsoil_incr, ' surface layers only, delt ', delt + ! initialize variables for counts statitics to be zeros + nother = 0 ! grid cells not land + nsnowupd = 0 ! grid cells with snow (temperature not yet updated) + nstcupd = 0 ! grid cells that are updated + nfrozen = 0 ! not update as frozen soil + nfrozen_upd = 0 ! not update as frozen soil -! ! delt=GFS_Control%dtf -! if ((Land_IAU_Control%dtp - delt) > 0.0001) then -! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then -! print*, "Warning noahmpdrv_run delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp -! endif -! endif - -! lsoil_incr = Land_IAU_Control%lsoil_incr -! lensfc = Land_IAU_Control%nx * Land_IAU_Control%ny - -! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,' adjusting first ', lsoil_incr, ' surface layers only, delt ', delt -! ! initialize variables for counts statitics to be zeros -! nother = 0 ! grid cells not land -! nsnowupd = 0 ! grid cells with snow (temperature not yet updated) -! nstcupd = 0 ! grid cells that are updated -! nfrozen = 0 ! not update as frozen soil -! nfrozen_upd = 0 ! not update as frozen soil - -! !TODO---if only fv3 increment files are used, this can be read from file -! allocate(mask_tile(lensfc)) -! call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) !& !veg_type_landice, - -! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then -! print*, "root proc, tile num, layer 1 stc", Land_IAU_Control%me, Land_IAU_Control%tile_num -! ib = 1 -! do j = 1, Land_IAU_Control%ny !ny -! WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) -! ib = ib + Land_IAU_Control%nx !nlon -! enddo -! print*, "root proc layer 1 inc" -! ib = 1 -! do j = 1, Land_IAU_Control%ny !ny -! WRITE(*,"(48F6.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1)*delt -! ib = ib + Land_IAU_Control%nx !nlon -! enddo -! endif - -! !IAU increments are in units of 1/sec !Land_IAU_Control%dtp -! !* only updating soil temp for now -! ij_loop : do ij = 1, lensfc -! ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land -! if (mask_tile(ij) == 1) then -! ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*, "root proc layer 1 stc, inc ", stc(ij,1), stc_inc_flat(ij,1) -! soil_freeze=.false. -! soil_ice=.false. -! do k = 1, lsoil_incr ! k = 1, km -! if ( stc(ij,k) < tfreez) soil_freeze=.true. -! if ( smc(ij,k) - slc(ij,k) > 0.001 ) soil_ice=.true. - -! stc(ij,k) = stc(ij,k) + stc_inc_flat(ij,k)*delt !Land_IAU_Control%dtp - -! if (k==1) then -! stc_updated(ij) = 1 -! nstcupd = nstcupd + 1 -! endif -! if ( (stc(ij,k) < tfreez) .and. (.not. soil_freeze) .and. (k==1) )& -! nfrozen_upd = nfrozen_upd + 1 -! ! moisture updates not done if this layer or any above is frozen -! if ( soil_freeze .or. soil_ice ) then -! if (k==1) nfrozen = nfrozen+1 -! endif -! enddo -! endif ! if soil/snow point -! enddo ij_loop -! ! do k = 1, km -! ! stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !Land_IAU_Control%dtp -! ! ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !Land_IAU_Control%dtp -! ! enddo -! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then -! print*, "root proc layer 1 stc after adding IAU inc" -! ib = 1 -! do j = 1, Land_IAU_Control%ny !ny -! WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) -! ib = ib + Land_IAU_Control%nx !nlon -! enddo -! endif +!TODO---if only fv3 increment files are used, this can be read from file + allocate(mask_tile(lensfc)) + call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) !& !veg_type_landice, -! deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "root proc, tile num, layer 1 stc", Land_IAU_Control%me, Land_IAU_Control%tile_num + ! ib = 1 + ! do j = 1, Land_IAU_Control%ny !ny + ! WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) + ! ib = ib + Land_IAU_Control%nx !nlon + ! enddo + print*, "root proc layer 1 inc" + ! ib = 1 + ! do j = 1, Land_IAU_Control%ny !ny + ! WRITE(*,"(48F6.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1)*delt + ! ib = ib + Land_IAU_Control%nx !nlon + ! enddo + do j = 33, 35 + WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) + enddo + print*, "stc_inc_flat" + + do j = 33, 35 + ib = (j - 1) * Land_IAU_Control%nx + 40 + WRITE(*,"(3F15.12)") stc_inc_flat(ib:ib+2, 1) + enddo + endif + + !IAU increments are in units of 1/sec !Land_IAU_Control%dtp + !* only updating soil temp for now + ij_loop : do ij = 1, lensfc + ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land + if (mask_tile(ij) == 1) then + ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*, "root proc layer 1 stc, inc ", stc(ij,1), stc_inc_flat(ij,1) + soil_freeze=.false. + soil_ice=.false. + do k = 1, lsoil_incr ! k = 1, km + if ( stc(ij,k) < tfreez) soil_freeze=.true. + if ( smc(ij,k) - slc(ij,k) > 0.001 ) soil_ice=.true. + + stc(ij,k) = stc(ij,k) + stc_inc_flat(ij,k)*delt !Land_IAU_Control%dtp + + if (k==1) then + stc_updated(ij) = 1 + nstcupd = nstcupd + 1 + endif + if ( (stc(ij,k) < tfreez) .and. (.not. soil_freeze) .and. (k==1) )& + nfrozen_upd = nfrozen_upd + 1 + ! moisture updates not done if this layer or any above is frozen + if ( soil_freeze .or. soil_ice ) then + if (k==1) nfrozen = nfrozen+1 + endif + enddo + endif ! if soil/snow point + enddo ij_loop + ! do k = 1, km + ! stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !Land_IAU_Control%dtp + ! ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !Land_IAU_Control%dtp + ! enddo + ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + ! print*, "root proc layer 1 stc after adding IAU inc" + ! ib = 1 + ! do j = 1, Land_IAU_Control%ny !ny + ! WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) + ! ib = ib + Land_IAU_Control%nx !nlon + ! enddo + ! endif + + deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) ! ! (consistency) adjustments for updated soil temp and moisture @@ -378,7 +390,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! ! maxsmc(1:slcats) = smcmax_table(1:slcats) ! ! bb(1:slcats) = bexp_table(1:slcats) ! ! satpsi(1:slcats) = psisat_table(1:slcats) - + ! if (errflg .ne. 0) then ! print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' ! errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' @@ -413,12 +425,12 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! print*, "proc ", Land_IAU_Control%me, " indices with large increment" ! print*, diff_indices ! print*, d_stc(diff_indices) - + ! deallocate(stc_bck, d_stc) ! if(allocated(diff_indices)) deallocate(diff_indices) ! deallocate(stc_updated) ! deallocate(mask_tile) - + ! write(*,'(a,i2)') ' statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me ! write(*,'(a,i8)') ' soil grid total', lensfc @@ -429,7 +441,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! write(*,'(a,i8)') ' grid cells, without soil or snow = ', nother ! write(*,'(a,i8)') ' soil grid cells with stc update', n_stc - endif + ! endif end subroutine noahmpdrv_timestep_init @@ -1059,8 +1071,6 @@ subroutine noahmpdrv_run & errmsg = '' errflg = 0 - stc(:, 4) = stc(:, 4) + 0.000001 - do i = 1, im if (flag_iter(i) .and. dry(i)) then From 7c4806b1fc4ec5bc65e8e48025239d285ddfb2fc Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 24 Jul 2024 10:52:12 -0400 Subject: [PATCH 076/141] remove hard-coded test --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index cc69dcc28..28158fc1f 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -127,7 +127,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me !logical :: land_iau_gaussian_inc_file = .false. integer :: lsoil_incr = 4 - NAMELIST /lnd_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, & !land_iau_gaussian_inc_file, & + NAMELIST /land_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, & !land_iau_gaussian_inc_file, & land_iau_filter_increments, & lsoil_incr @@ -141,7 +141,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886 allocate(input_nml_file, mold=input_nml_file_i) input_nml_file => input_nml_file_i - read(input_nml_file, nml=lnd_iau_nml) + read(input_nml_file, nml=land_iau_nml) ! Set length (number of lines) in namelist for internal reads input_nml_file_length = size(input_nml_file) #else @@ -157,7 +157,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%fn_nml = trim(fn_nml) ! maynot need this open (unit=nlunit, file=trim(fn_nml), action='READ', status='OLD', iostat=ios, iomsg=ioerrmsg) rewind(nlunit) - read (nlunit, nml=lnd_iau_nml) + read (nlunit, nml=land_iau_nml) close (nlunit) if (ios /= 0) then ! call mpp_error(FATAL, 'lnd_iau_mod_set_control: error reading namelist file ',trim(fn_nml)) @@ -172,8 +172,8 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me #endif if (me == mpi_root) then - write(6,*) "lnd_iau_nml" - write(6, lnd_iau_nml) + write(6,*) "land_iau_nml" + write(6, land_iau_nml) endif Land_IAU_Control%do_land_iau = do_land_iau From 29cff05c6739468c37bfe96005909828c741dac5 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 24 Jul 2024 11:01:22 -0400 Subject: [PATCH 077/141] remove debug prints --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 153 +++++++++---------- 1 file changed, 76 insertions(+), 77 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index a6697effc..cd135fdba 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -188,8 +188,8 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat ! real(kind=kind_phys),allocatable, dimension(:) :: stc_bck, d_stc real(kind=kind_phys) :: stc_bck(ncols, km), d_stc(ncols, km) - integer, allocatable, dimension(:) :: diff_indices - ! real,allocatable :: slc_inc_flat(:,:) + ! integer, allocatable, dimension(:) :: diff_indices + integer :: lsoil_incr ! integer :: veg_type_landice @@ -317,29 +317,29 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & allocate(mask_tile(lensfc)) call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) !& !veg_type_landice, - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "root proc, tile num, layer 1 stc", Land_IAU_Control%me, Land_IAU_Control%tile_num - ! ib = 1 - ! do j = 1, Land_IAU_Control%ny !ny - ! WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) - ! ib = ib + Land_IAU_Control%nx !nlon - ! enddo - print*, "root proc layer 1 inc" - ! ib = 1 - ! do j = 1, Land_IAU_Control%ny !ny - ! WRITE(*,"(48F6.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1)*delt - ! ib = ib + Land_IAU_Control%nx !nlon - ! enddo - do j = 33, 35 - WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) - enddo - print*, "stc_inc_flat" + ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + ! print*, "root proc, tile num, layer 1 stc", Land_IAU_Control%me, Land_IAU_Control%tile_num + ! ! ib = 1 + ! ! do j = 1, Land_IAU_Control%ny !ny + ! ! WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) + ! ! ib = ib + Land_IAU_Control%nx !nlon + ! ! enddo + ! print*, "root proc layer 1 inc" + ! ! ib = 1 + ! ! do j = 1, Land_IAU_Control%ny !ny + ! ! WRITE(*,"(48F6.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1)*delt + ! ! ib = ib + Land_IAU_Control%nx !nlon + ! ! enddo + ! do j = 33, 35 + ! WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) + ! enddo + ! print*, "stc_inc_flat" - do j = 33, 35 - ib = (j - 1) * Land_IAU_Control%nx + 40 - WRITE(*,"(3F15.12)") stc_inc_flat(ib:ib+2, 1) - enddo - endif + ! do j = 33, 35 + ! ib = (j - 1) * Land_IAU_Control%nx + 40 + ! WRITE(*,"(3F15.12)") stc_inc_flat(ib:ib+2, 1) + ! enddo + ! endif !IAU increments are in units of 1/sec !Land_IAU_Control%dtp !* only updating soil temp for now @@ -383,65 +383,64 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) -! ! (consistency) adjustments for updated soil temp and moisture +! (consistency) adjustments for updated soil temp and moisture -! ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) -! call read_mp_table_parameters(errmsg, errflg) -! ! maxsmc(1:slcats) = smcmax_table(1:slcats) -! ! bb(1:slcats) = bexp_table(1:slcats) -! ! satpsi(1:slcats) = psisat_table(1:slcats) + ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) + call read_mp_table_parameters(errmsg, errflg) + ! maxsmc(1:slcats) = smcmax_table(1:slcats) + ! bb(1:slcats) = bexp_table(1:slcats) + ! satpsi(1:slcats) = psisat_table(1:slcats) -! if (errflg .ne. 0) then -! print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' -! errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' -! return -! endif -! n_stc = 0 -! do i=1,lensfc -! if (stc_updated(i) == 1 ) then ! soil-only location -! n_stc = n_stc+1 -! soiltype = soiltyp(i) -! do l = 1, lsoil_incr -! !case 1: frz ==> frz, recalculate slc, smc remains -! !case 2: unfrz ==> frz, recalculate slc, smc remains -! !both cases are considered in the following if case -! if (stc(i,l) .LT. tfreez )then -! !recompute supercool liquid water,smc_anl remain unchanged -! smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) -! slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) -! slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) -! endif -! !case 3: frz ==> unfrz, melt all soil ice (if any) -! if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck -! slc(i,l)=smc(i,l) -! endif -! enddo -! endif -! enddo - -! d_stc = stc(:, 1) - stc_bck -! ! Where(d_stc .gt. 0.0001) -! diff_indices = pack([(i, i=1, lensfc)], d_stc > 0.0001) -! print*, "proc ", Land_IAU_Control%me, " indices with large increment" -! print*, diff_indices -! print*, d_stc(diff_indices) + if (errflg .ne. 0) then + print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' + errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' + return + endif + n_stc = 0 + do i=1,lensfc + if (stc_updated(i) == 1 ) then ! soil-only location + n_stc = n_stc+1 + soiltype = soiltyp(i) + do l = 1, lsoil_incr + !case 1: frz ==> frz, recalculate slc, smc remains + !case 2: unfrz ==> frz, recalculate slc, smc remains + !both cases are considered in the following if case + if (stc(i,l) .LT. tfreez )then + !recompute supercool liquid water,smc_anl remain unchanged + smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) + slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) + slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) + endif + !case 3: frz ==> unfrz, melt all soil ice (if any) + if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck + slc(i,l)=smc(i,l) + endif + enddo + endif + enddo + + ! d_stc = stc(:, 1) - stc_bck + ! ! Where(d_stc .gt. 0.0001) + ! diff_indices = pack([(i, i=1, lensfc)], d_stc > 0.0001) + ! print*, "proc ", Land_IAU_Control%me, " indices with large increment" + ! print*, diff_indices + ! print*, d_stc(diff_indices) -! deallocate(stc_bck, d_stc) -! if(allocated(diff_indices)) deallocate(diff_indices) -! deallocate(stc_updated) -! deallocate(mask_tile) + ! if(allocated(diff_indices)) deallocate(diff_indices) + + deallocate(stc_updated) + deallocate(mask_tile) -! write(*,'(a,i2)') ' statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me -! write(*,'(a,i8)') ' soil grid total', lensfc -! write(*,'(a,i8)') ' soil grid cells stc updated = ',nstcupd -! write(*,'(a,i8)') ' soil grid cells not updated, frozen = ',nfrozen -! write(*,'(a,i8)') ' soil grid cells update, became frozen = ',nfrozen_upd -! write(*,'(a,i8)') ' (not updated yet) snow grid cells = ', nsnowupd -! write(*,'(a,i8)') ' grid cells, without soil or snow = ', nother -! write(*,'(a,i8)') ' soil grid cells with stc update', n_stc + write(*,'(a,i2)') ' statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me + write(*,'(a,i8)') ' soil grid total', lensfc + write(*,'(a,i8)') ' soil grid cells stc updated = ',nstcupd + write(*,'(a,i8)') ' soil grid cells not updated, frozen = ',nfrozen + write(*,'(a,i8)') ' soil grid cells update, became frozen = ',nfrozen_upd + write(*,'(a,i8)') ' (not updated yet) snow grid cells = ', nsnowupd + write(*,'(a,i8)') ' grid cells, without soil or snow = ', nother + write(*,'(a,i8)') ' soil grid cells with stc update', n_stc - ! endif end subroutine noahmpdrv_timestep_init From 6530674d07c6b51cc9f5a0531d100759d3f9f6bb Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 31 Jul 2024 15:34:03 -0400 Subject: [PATCH 078/141] add stc update and adjustment --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 9 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 97 ++++++++++++++----- 2 files changed, 82 insertions(+), 24 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 28158fc1f..8ccb26592 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -72,6 +72,8 @@ module land_iau_mod real(kind=kind_phys) :: iaufhrs(7) ! forecast hours associated with increment files logical :: iau_filter_increments integer :: lsoil_incr ! soil layers (from top) updated by DA + logical :: upd_stc + logical :: upd_slc !, iau_drymassfixer integer :: me !< MPI rank designator integer :: mpi_root !< MPI rank of master atmosphere processor @@ -126,10 +128,12 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me logical :: land_iau_filter_increments = .false. !< filter IAU increments !logical :: land_iau_gaussian_inc_file = .false. integer :: lsoil_incr = 4 + logical :: upd_stc = .false. + logical :: upd_slc = .false. NAMELIST /land_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, & !land_iau_gaussian_inc_file, & land_iau_filter_increments, & - lsoil_incr + lsoil_incr, upd_stc, upd_slc !Errors messages handled through CCPP error handling variables errmsg = '' @@ -199,6 +203,9 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%input_nml_file = input_nml_file Land_IAU_Control%input_nml_file_length = input_nml_file_length + Land_IAU_Control%upd_stc = upd_stc + Land_IAU_Control%upd_slc = upd_slc + allocate(Land_IAU_Control%blksz(nblks)) allocate(Land_IAU_Control%blk_strt_indx(nblks)) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index cd135fdba..9c01baf5c 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -185,19 +185,23 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & integer, intent(out) :: errflg ! IAU update - real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat + real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat, slc_inc_flat ! real(kind=kind_phys),allocatable, dimension(:) :: stc_bck, d_stc real(kind=kind_phys) :: stc_bck(ncols, km), d_stc(ncols, km) ! integer, allocatable, dimension(:) :: diff_indices + real(kind=kind_phys), dimension(km) :: dz ! layer thickness + +!TODO: 7.31.24: This is hard-coded in noahmpdrv + real(kind=kind_phys) :: zsoil(4) = (/ -0.1, -0.4, -1.0, -2.0 /) !zsoil(km) integer :: lsoil_incr ! integer :: veg_type_landice integer, allocatable :: mask_tile(:) - integer,allocatable :: stc_updated(:) + integer,allocatable :: stc_updated(:), slc_updated(:) logical :: soil_freeze, soil_ice integer :: n_freeze, n_thaw - integer :: soiltype, n_stc + integer :: soiltype, n_stc, n_slc real(kind=kind_phys) :: slc_new integer :: i, j, ij, l, k, ib @@ -213,7 +217,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & real(kind=kind_phys) :: hc_incr integer :: nother, nsnowupd - integer :: nstcupd, nfrozen, nfrozen_upd + integer :: nstcupd, nslcupd, nfrozen, nfrozen_upd ! --- Initialize CCPP error handling variables errmsg = '' @@ -281,16 +285,18 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! local variable to copy blocked data Land_IAU_Data%stc_inc allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols - ! allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols + allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) + allocate(slc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) !copy background stc stc_updated = 0 + slc_updated = 0 ib = 1 do j = 1, Land_IAU_Control%ny !ny do k = 1, km stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%stc_inc(:,j, k) - ! slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) + slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) enddo ib = ib + Land_IAU_Control%nx !nlon enddo @@ -309,7 +315,8 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! initialize variables for counts statitics to be zeros nother = 0 ! grid cells not land nsnowupd = 0 ! grid cells with snow (temperature not yet updated) - nstcupd = 0 ! grid cells that are updated + nstcupd = 0 ! grid cells that are updated stc + nslcupd = 0 ! grid cells that are updated slc nfrozen = 0 ! not update as frozen soil nfrozen_upd = 0 ! not update as frozen soil @@ -353,21 +360,40 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & if ( stc(ij,k) < tfreez) soil_freeze=.true. if ( smc(ij,k) - slc(ij,k) > 0.001 ) soil_ice=.true. - stc(ij,k) = stc(ij,k) + stc_inc_flat(ij,k)*delt !Land_IAU_Control%dtp - - if (k==1) then - stc_updated(ij) = 1 - nstcupd = nstcupd + 1 + if (Land_IAU_Control%upd_stc) then + stc(ij,k) = stc(ij,k) + stc_inc_flat(ij,k)*delt !Land_IAU_Control%dtp + if (k==1) then + stc_updated(ij) = 1 + nstcupd = nstcupd + 1 + endif endif - if ( (stc(ij,k) < tfreez) .and. (.not. soil_freeze) .and. (k==1) )& - nfrozen_upd = nfrozen_upd + 1 - ! moisture updates not done if this layer or any above is frozen - if ( soil_freeze .or. soil_ice ) then + + if ( (stc(ij,k) < tfreez) .and. (.not. soil_freeze) .and. (k==1) ) nfrozen_upd = nfrozen_upd + 1 + + ! do not do updates if this layer or any above is frozen + if ( (.not. soil_freeze ) .and. (.not. soil_ice ) ) then + if (Land_IAU_Control%upd_slc) then + if (k==1) then + nslcupd = nslcupd + 1 + slc_updated(ij) = 1 + endif + ! apply zero limit here (higher, model-specific limits are later) + slc(ij,k) = max(slc(ij,k) + slc_inc_flat(ij,k)*delt, 0.0) + smc(ij,k) = max(smc(ij,k) + slc_inc_flat(ij,k)*delt, 0.0) + ! slc_state(ij,k) = max(slc_state(ij,k) + slcinc(ij,k), 0.0) + ! smc_state(ij,k) = max(smc_state(ij,k) + slcinc(ij,k), 0.0) + endif + else if (k==1) nfrozen = nfrozen+1 - endif + ! ! moisture updates not done if this layer or any above is frozen + ! if ( soil_freeze .or. soil_ice ) then + ! if (k==1) nfrozen = nfrozen+1 + ! endif + endif enddo endif ! if soil/snow point enddo ij_loop + ! do k = 1, km ! stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !Land_IAU_Control%dtp ! ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !Land_IAU_Control%dtp @@ -381,7 +407,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! enddo ! endif - deallocate(stc_inc_flat) !, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) + deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) ! (consistency) adjustments for updated soil temp and moisture @@ -389,14 +415,16 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & call read_mp_table_parameters(errmsg, errflg) ! maxsmc(1:slcats) = smcmax_table(1:slcats) ! bb(1:slcats) = bexp_table(1:slcats) - ! satpsi(1:slcats) = psisat_table(1:slcats) - + ! satpsi(1:slcats) = psisat_table(1:slcats) if (errflg .ne. 0) then print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' return endif - n_stc = 0 + + n_stc = 0 + n_slc = 0 + if (Land_IAU_Control%upd_stc) then do i=1,lensfc if (stc_updated(i) == 1 ) then ! soil-only location n_stc = n_stc+1 @@ -418,6 +446,27 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & enddo endif enddo + endif + + if (Land_IAU_Control%upd_slc) then + dz(1) = -zsoil(1) + do l = 2, km + dz(l) = -zsoil(l) + zsoil(l-1) + enddo + ! print *, 'Applying soil moisture mins ' + do i=1,lensfc + if (slc_updated(i) == 1 ) then + n_slc = n_slc+1 + ! apply SM bounds (later: add upper SMC limit) + do l = 1, lsoil_incr + ! noah-mp minimum is 1 mm per layer (in SMC) + ! no need to maintain frozen amount, would be v. small. + slc(i,l) = max( 0.001/dz(l), slc(i,l) ) + smc(i,l) = max( 0.001/dz(l), smc(i,l) ) + enddo + endif + enddo + endif ! d_stc = stc(:, 1) - stc_bck ! ! Where(d_stc .gt. 0.0001) @@ -428,18 +477,20 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! if(allocated(diff_indices)) deallocate(diff_indices) - deallocate(stc_updated) + deallocate(stc_updated, slc_updated) deallocate(mask_tile) write(*,'(a,i2)') ' statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me write(*,'(a,i8)') ' soil grid total', lensfc write(*,'(a,i8)') ' soil grid cells stc updated = ',nstcupd + write(*,'(a,i8)') ' soil grid cells slc updated = ',nslcupd write(*,'(a,i8)') ' soil grid cells not updated, frozen = ',nfrozen write(*,'(a,i8)') ' soil grid cells update, became frozen = ',nfrozen_upd write(*,'(a,i8)') ' (not updated yet) snow grid cells = ', nsnowupd write(*,'(a,i8)') ' grid cells, without soil or snow = ', nother - write(*,'(a,i8)') ' soil grid cells with stc update', n_stc + write(*,'(a,i8)') ' soil grid cells with stc adjustment', n_stc + write(*,'(a,i8)') ' soil grid cells with slc adjustment', n_slc end subroutine noahmpdrv_timestep_init From 0b41c39f3f0516cfdbad8b7eb5b14938d7fd232b Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 31 Jul 2024 16:16:47 -0400 Subject: [PATCH 079/141] add stc update and adjustment --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 8ccb26592..89df0cdd1 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -128,12 +128,12 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me logical :: land_iau_filter_increments = .false. !< filter IAU increments !logical :: land_iau_gaussian_inc_file = .false. integer :: lsoil_incr = 4 - logical :: upd_stc = .false. - logical :: upd_slc = .false. + logical :: land_iau_upd_stc = .false. + logical :: land_iau_upd_slc = .false. NAMELIST /land_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, & !land_iau_gaussian_inc_file, & land_iau_filter_increments, & - lsoil_incr, upd_stc, upd_slc + lsoil_incr, land_iau_upd_stc, land_iau_upd_slc !Errors messages handled through CCPP error handling variables errmsg = '' @@ -203,8 +203,8 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%input_nml_file = input_nml_file Land_IAU_Control%input_nml_file_length = input_nml_file_length - Land_IAU_Control%upd_stc = upd_stc - Land_IAU_Control%upd_slc = upd_slc + Land_IAU_Control%upd_stc = land_iau_upd_stc + Land_IAU_Control%upd_slc = land_iau_upd_slc allocate(Land_IAU_Control%blksz(nblks)) allocate(Land_IAU_Control%blk_strt_indx(nblks)) From 0de64dde5e1b61585abb0aa88c47c506cb27547a Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 5 Aug 2024 12:55:41 -0400 Subject: [PATCH 080/141] zero out too small increments --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 89df0cdd1..f475e08b4 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -74,6 +74,7 @@ module land_iau_mod integer :: lsoil_incr ! soil layers (from top) updated by DA logical :: upd_stc logical :: upd_slc + real(kind=kind_phys) :: min_T_increment !, iau_drymassfixer integer :: me !< MPI rank designator integer :: mpi_root !< MPI rank of master atmosphere processor @@ -130,10 +131,11 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me integer :: lsoil_incr = 4 logical :: land_iau_upd_stc = .false. logical :: land_iau_upd_slc = .false. + real(kind=kind_phys) :: land_iau_min_T_increment = 0.0001 NAMELIST /land_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, & !land_iau_gaussian_inc_file, & land_iau_filter_increments, & - lsoil_incr, land_iau_upd_stc, land_iau_upd_slc + lsoil_incr, land_iau_upd_stc, land_iau_upd_slc, land_iau_min_T_increment !Errors messages handled through CCPP error handling variables errmsg = '' @@ -205,6 +207,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%upd_stc = land_iau_upd_stc Land_IAU_Control%upd_slc = land_iau_upd_slc + Land_IAU_Control%min_T_increment = land_iau_min_T_increment allocate(Land_IAU_Control%blksz(nblks)) allocate(Land_IAU_Control%blk_strt_indx(nblks)) @@ -681,6 +684,9 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_ou status =nf90_close(ncid) call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) + !8.3.24 ensure to zero out too small increments + where(wk3_stc < Land_IAU_Control%min_T_increment) wk3_stc = 0.0 + end subroutine read_iau_forcing_fv3 !> Calculate soil mask for land on model grid. From a6381f32153c02f1d61a9315c00d5fab9fec7174 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 6 Aug 2024 15:10:19 -0400 Subject: [PATCH 081/141] zero out too small increments --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index f475e08b4..3044b7dc3 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -685,7 +685,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_ou call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) !8.3.24 ensure to zero out too small increments - where(wk3_stc < Land_IAU_Control%min_T_increment) wk3_stc = 0.0 + where(abs(wk3_stc) < Land_IAU_Control%min_T_increment) wk3_stc = 0.0 end subroutine read_iau_forcing_fv3 From 4a953f330a08429abead665b3297dddcb403259b Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 8 Aug 2024 17:11:09 -0400 Subject: [PATCH 082/141] add comment for single increment --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 3044b7dc3..bdb320d91 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -314,7 +314,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) return endif if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,"increment file ", trim(adjustl(Land_IAU_Control%iau_inc_files(1))) + print *,"land_iau_init: Increment file ", trim(adjustl(Land_IAU_Control%iau_inc_files(1))) endif ! determine number of valid forecast hours @@ -328,7 +328,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) endif ntimes = ntimes + 1 enddo - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'ntimes = ',ntimes + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau_init: ntimes = ',ntimes Land_IAU_Control%ntimes = ntimes if (ntimes < 1) then return @@ -684,7 +684,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_ou status =nf90_close(ncid) call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) - !8.3.24 ensure to zero out too small increments + !8.3.24 set too small increments to zero where(abs(wk3_stc) < Land_IAU_Control%min_T_increment) wk3_stc = 0.0 end subroutine read_iau_forcing_fv3 From 7319badd81c9f86efe6877807daf558b1faf4d47 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 8 Aug 2024 19:17:10 -0400 Subject: [PATCH 083/141] include t2 in update iau call --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index bdb320d91..3e81eee97 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -464,9 +464,10 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e endif if (ntimes.EQ.1) then - ! check to see if we are in the IAU window, - ! no need to update the states since they are fixed over the window - if ( Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2 ) then + ! check to see if we are in the IAU window, no need to update the states since they are fixed over the window +!8.8.24 TBCL: noahmpdrv_timestep_init doesn't get visited at t1, so include t2 + ! if ( Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2 ) then + if ( Land_IAU_Control%fhour <= t1 .or. Land_IAU_Control%fhour > t2 ) then ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',t1,Land_IAU_Control%fhour,t2 Land_IAU_Data%in_interval=.false. else @@ -479,7 +480,9 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e if (ntimes > 1) then itnext=2 - if (Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2) then +!8.8.24 TBCL: noahmpdrv_timestep_init doesn't get visited at t1, so include t2 + ! if ( Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2 ) then + if ( Land_IAU_Control%fhour <= t1 .or. Land_IAU_Control%fhour > t2 ) then ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',Land_IAU_Control%iaufhrs(1),Land_IAU_Control%fhour,Land_IAU_Control%iaufhrs(nfiles) Land_IAU_Data%in_interval=.false. else From f5607ade7b357492e94237a8e934e6eb228b80a7 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sat, 10 Aug 2024 09:52:32 -0400 Subject: [PATCH 084/141] set hr6 the only incr file (for testing) --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 3e81eee97..12db20f16 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -361,8 +361,8 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) do k = 1, npz ! do k = 1,n_soill ! do j = 1, nlat do i = 1, nlon - Land_IAU_state%inc1%stc_inc(i,j,k) = wk3_stc(1, i, j, k) - Land_IAU_state%inc1%slc_inc(i,j,k) = wk3_slc(1, i, j, k) + Land_IAU_state%inc1%stc_inc(i,j,k) = wk3_stc(2, i, j, k) + Land_IAU_state%inc1%slc_inc(i,j,k) = wk3_slc(2, i, j, k) end do enddo enddo @@ -464,7 +464,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e endif if (ntimes.EQ.1) then - ! check to see if we are in the IAU window, no need to update the states since they are fixed over the window + ! check to see if we are in the IAU window, no need to update the states since they are fixed over the window !8.8.24 TBCL: noahmpdrv_timestep_init doesn't get visited at t1, so include t2 ! if ( Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2 ) then if ( Land_IAU_Control%fhour <= t1 .or. Land_IAU_Control%fhour > t2 ) then From d0c2cac8d3bf99a638a5d3a7628ebf98ed93981b Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 14 Aug 2024 07:06:30 -0400 Subject: [PATCH 085/141] add increments at timestep_finalize (for testing) --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 4 ++-- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 8 ++++---- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 12db20f16..ebdc72aba 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -361,8 +361,8 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) do k = 1, npz ! do k = 1,n_soill ! do j = 1, nlat do i = 1, nlon - Land_IAU_state%inc1%stc_inc(i,j,k) = wk3_stc(2, i, j, k) - Land_IAU_state%inc1%slc_inc(i,j,k) = wk3_slc(2, i, j, k) + Land_IAU_state%inc1%stc_inc(i,j,k) = wk3_stc(1, i, j, k) + Land_IAU_state%inc1%slc_inc(i,j,k) = wk3_slc(1, i, j, k) end do enddo enddo diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 9c01baf5c..635af3907 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -155,7 +155,7 @@ end subroutine noahmpdrv_init !! Note: For Case 3, Yuan Xue thoroughly evaluated a total of four options and !! current option is found to be the best as of 11/09/2023 -subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & !me, mpi_root, +subroutine noahmpdrv_timestep_finalize (itime, fhour, delt, km, ncols, & !me, mpi_root, isot, ivegsrc, soiltyp, vegtype, weasd, & stc, slc, smc, errmsg, errflg) ! smc, t2mmp, q2mp, @@ -493,7 +493,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & write(*,'(a,i8)') ' soil grid cells with slc adjustment', n_slc -end subroutine noahmpdrv_timestep_init +end subroutine noahmpdrv_timestep_finalize !> \ingroup NoahMP_LSM !! \brief This subroutine is called after noahmpdrv_run @@ -502,7 +502,7 @@ end subroutine noahmpdrv_timestep_init !! \section arg_table_noahmpdrv_timestep_finalize Argument Table !! \htmlinclude noahmpdrv_timestep_finalize.html !! - subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, + subroutine noahmpdrv_timestep_init (errmsg, errflg) ! smc, t2mmp, q2mp, use machine, only: kind_phys implicit none @@ -514,7 +514,7 @@ subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp !> note the IAU deallocate happens at the noahmpdrv_finalize - end subroutine noahmpdrv_timestep_finalize + end subroutine noahmpdrv_timestep_init !> \ingroup NoahMP_LSM !! \brief This subroutine mirrors noahmpdrv_init diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 892894329..414f03f02 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -225,7 +225,7 @@ ######################################################################## [ccpp-arg-table] - name = noahmpdrv_timestep_init + name = noahmpdrv_timestep_finalize type = scheme [itime] standard_name = index_of_timestep @@ -342,7 +342,7 @@ ####################################################################### [ccpp-arg-table] - name = noahmpdrv_timestep_finalize + name = noahmpdrv_timestep_init type = scheme [errmsg] standard_name = ccpp_error_message From b79c7e603e8873d7b39a2e070fdfa7aeb9121de5 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 14 Aug 2024 19:32:54 -0400 Subject: [PATCH 086/141] add sec argtable --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 635af3907..3510fa853 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -144,9 +144,10 @@ end subroutine noahmpdrv_init !> \ingroup NoahMP_LSM !! \brief This subroutine is called before noahmpdrv_run !! to update states with iau increments, if available -!! \section arg_table_noahmpdrv_timestep_init Argument Table -!! \htmlinclude noahmpdrv_timestep_init.html -!! + +!! \section arg_table_noahmpdrv_timestep_finalize Argument Table +!! \htmlinclude noahmpdrv_timestep_finalize.html + !! For Noah-MP, the adjustment scheme shown below is applied to soil moisture and temp: !! Case 1: frozen ==> frozen, recalculate slc following opt_frz=1, smc remains !! Case 2: unfrozen ==> frozen, recalculate slc following opt_frz=1, smc remains @@ -499,8 +500,9 @@ end subroutine noahmpdrv_timestep_finalize !! \brief This subroutine is called after noahmpdrv_run !! to free up allocated memory, if there are any !! code to do any needed consistency check will go here -!! \section arg_table_noahmpdrv_timestep_finalize Argument Table -!! \htmlinclude noahmpdrv_timestep_finalize.html + +!! \section arg_table_noahmpdrv_timestep_init Argument Table +!! \htmlinclude noahmpdrv_timestep_init.html !! subroutine noahmpdrv_timestep_init (errmsg, errflg) ! smc, t2mmp, q2mp, From 4398a956d69506e71d03b5d7aa54101bc90c01a9 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 14 Aug 2024 22:37:37 -0400 Subject: [PATCH 087/141] fix argtable --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 3510fa853..dbaa7e8d3 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -143,11 +143,10 @@ end subroutine noahmpdrv_init !> \ingroup NoahMP_LSM !! \brief This subroutine is called before noahmpdrv_run -!! to update states with iau increments, if available - +!! to update states with iau increments, if available--- !! \section arg_table_noahmpdrv_timestep_finalize Argument Table !! \htmlinclude noahmpdrv_timestep_finalize.html - +!! !! For Noah-MP, the adjustment scheme shown below is applied to soil moisture and temp: !! Case 1: frozen ==> frozen, recalculate slc following opt_frz=1, smc remains !! Case 2: unfrozen ==> frozen, recalculate slc following opt_frz=1, smc remains @@ -499,8 +498,7 @@ end subroutine noahmpdrv_timestep_finalize !> \ingroup NoahMP_LSM !! \brief This subroutine is called after noahmpdrv_run !! to free up allocated memory, if there are any -!! code to do any needed consistency check will go here - +!! code to do any needed consistency check will go here-- !! \section arg_table_noahmpdrv_timestep_init Argument Table !! \htmlinclude noahmpdrv_timestep_init.html !! From 4d244ea2fa768674bb137018964e811e01ff82a7 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 16 Aug 2024 18:07:44 -0400 Subject: [PATCH 088/141] input line in namelist for stcsmc adjustment --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 5 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 103 +++++++++--------- 2 files changed, 57 insertions(+), 51 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index ebdc72aba..afa88d45b 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -74,6 +74,7 @@ module land_iau_mod integer :: lsoil_incr ! soil layers (from top) updated by DA logical :: upd_stc logical :: upd_slc + logical :: do_stcsmc_adjustment !do moisture/temperature adjustment for consistency after increment add real(kind=kind_phys) :: min_T_increment !, iau_drymassfixer integer :: me !< MPI rank designator @@ -131,11 +132,12 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me integer :: lsoil_incr = 4 logical :: land_iau_upd_stc = .false. logical :: land_iau_upd_slc = .false. + logical :: land_iau_do_stcsmc_adjustment = .false. real(kind=kind_phys) :: land_iau_min_T_increment = 0.0001 NAMELIST /land_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, & !land_iau_gaussian_inc_file, & land_iau_filter_increments, & - lsoil_incr, land_iau_upd_stc, land_iau_upd_slc, land_iau_min_T_increment + lsoil_incr, land_iau_upd_stc, land_iau_upd_slc, land_iau_do_stcsmc_adjustment, land_iau_min_T_increment !Errors messages handled through CCPP error handling variables errmsg = '' @@ -207,6 +209,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%upd_stc = land_iau_upd_stc Land_IAU_Control%upd_slc = land_iau_upd_slc + Land_IAU_Control%do_stcsmc_adjustment = land_iau_do_stcsmc_adjustment Land_IAU_Control%min_T_increment = land_iau_min_T_increment allocate(Land_IAU_Control%blksz(nblks)) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index dbaa7e8d3..ccd08ef81 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -411,61 +411,64 @@ subroutine noahmpdrv_timestep_finalize (itime, fhour, delt, km, ncols, ! (consistency) adjustments for updated soil temp and moisture - ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) - call read_mp_table_parameters(errmsg, errflg) - ! maxsmc(1:slcats) = smcmax_table(1:slcats) - ! bb(1:slcats) = bexp_table(1:slcats) - ! satpsi(1:slcats) = psisat_table(1:slcats) - if (errflg .ne. 0) then - print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' - errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' - return - endif + ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) + call read_mp_table_parameters(errmsg, errflg) + ! maxsmc(1:slcats) = smcmax_table(1:slcats) + ! bb(1:slcats) = bexp_table(1:slcats) + ! satpsi(1:slcats) = psisat_table(1:slcats) + if (errflg .ne. 0) then + print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' + errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' + return + endif n_stc = 0 n_slc = 0 - if (Land_IAU_Control%upd_stc) then - do i=1,lensfc - if (stc_updated(i) == 1 ) then ! soil-only location - n_stc = n_stc+1 - soiltype = soiltyp(i) + !!do moisture/temperature adjustment for consistency after increment add + if (Land_IAU_Control%do_stcsmc_adjustment) then + if (Land_IAU_Control%upd_stc) then + do i=1,lensfc + if (stc_updated(i) == 1 ) then ! soil-only location + n_stc = n_stc+1 + soiltype = soiltyp(i) + do l = 1, lsoil_incr + !case 1: frz ==> frz, recalculate slc, smc remains + !case 2: unfrz ==> frz, recalculate slc, smc remains + !both cases are considered in the following if case + if (stc(i,l) .LT. tfreez )then + !recompute supercool liquid water,smc_anl remain unchanged + smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) + slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) + slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) + endif + !case 3: frz ==> unfrz, melt all soil ice (if any) + if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck + slc(i,l)=smc(i,l) + endif + enddo + endif + enddo + endif + + if (Land_IAU_Control%upd_slc) then + dz(1) = -zsoil(1) + do l = 2, km + dz(l) = -zsoil(l) + zsoil(l-1) + enddo + ! print *, 'Applying soil moisture mins ' + do i=1,lensfc + if (slc_updated(i) == 1 ) then + n_slc = n_slc+1 + ! apply SM bounds (later: add upper SMC limit) do l = 1, lsoil_incr - !case 1: frz ==> frz, recalculate slc, smc remains - !case 2: unfrz ==> frz, recalculate slc, smc remains - !both cases are considered in the following if case - if (stc(i,l) .LT. tfreez )then - !recompute supercool liquid water,smc_anl remain unchanged - smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) - slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) - slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) - endif - !case 3: frz ==> unfrz, melt all soil ice (if any) - if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck - slc(i,l)=smc(i,l) - endif + ! noah-mp minimum is 1 mm per layer (in SMC) + ! no need to maintain frozen amount, would be v. small. + slc(i,l) = max( 0.001/dz(l), slc(i,l) ) + smc(i,l) = max( 0.001/dz(l), smc(i,l) ) enddo - endif - enddo - endif - - if (Land_IAU_Control%upd_slc) then - dz(1) = -zsoil(1) - do l = 2, km - dz(l) = -zsoil(l) + zsoil(l-1) - enddo - ! print *, 'Applying soil moisture mins ' - do i=1,lensfc - if (slc_updated(i) == 1 ) then - n_slc = n_slc+1 - ! apply SM bounds (later: add upper SMC limit) - do l = 1, lsoil_incr - ! noah-mp minimum is 1 mm per layer (in SMC) - ! no need to maintain frozen amount, would be v. small. - slc(i,l) = max( 0.001/dz(l), slc(i,l) ) - smc(i,l) = max( 0.001/dz(l), smc(i,l) ) - enddo - endif - enddo + endif + enddo + endif endif ! d_stc = stc(:, 1) - stc_bck From 1cbaea47f97c2b92b71376b3bfc1b17e94f618ac Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 20 Aug 2024 12:56:55 -0400 Subject: [PATCH 089/141] clean up --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 90 +++---------------- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 4 +- 3 files changed, 14 insertions(+), 82 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index afa88d45b..4be782033 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -11,7 +11,7 @@ !> - reads settings from namelist file (which indicates if IAU increments are available or not) !> - reads in DA increments from GSI/JEDI DA at the start of (the DA) cycle !> - maps increments to FV3 grid points belonging to mpi process -!> - interpolates temporally (with filter, weights if required by configuration) +!> - interpolates temporally (with filter-weights if required by configuration) !> - updates states with the interpolated increments !> March, 2024: Tseganeh Z. Gichamo, (EMC) based on the FV3 IAU mod diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index ccd08ef81..3dcdf01e5 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -144,8 +144,8 @@ end subroutine noahmpdrv_init !> \ingroup NoahMP_LSM !! \brief This subroutine is called before noahmpdrv_run !! to update states with iau increments, if available--- -!! \section arg_table_noahmpdrv_timestep_finalize Argument Table -!! \htmlinclude noahmpdrv_timestep_finalize.html +!! \section arg_table_noahmpdrv_timestep_init Argument Table +!! \htmlinclude noahmpdrv_timestep_init.html !! !! For Noah-MP, the adjustment scheme shown below is applied to soil moisture and temp: !! Case 1: frozen ==> frozen, recalculate slc following opt_frz=1, smc remains @@ -155,7 +155,7 @@ end subroutine noahmpdrv_init !! Note: For Case 3, Yuan Xue thoroughly evaluated a total of four options and !! current option is found to be the best as of 11/09/2023 -subroutine noahmpdrv_timestep_finalize (itime, fhour, delt, km, ncols, & !me, mpi_root, +subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & !me, mpi_root, isot, ivegsrc, soiltyp, vegtype, weasd, & stc, slc, smc, errmsg, errflg) ! smc, t2mmp, q2mp, @@ -186,11 +186,10 @@ subroutine noahmpdrv_timestep_finalize (itime, fhour, delt, km, ncols, ! IAU update real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat, slc_inc_flat - ! real(kind=kind_phys),allocatable, dimension(:) :: stc_bck, d_stc - real(kind=kind_phys) :: stc_bck(ncols, km), d_stc(ncols, km) - ! integer, allocatable, dimension(:) :: diff_indices real(kind=kind_phys), dimension(km) :: dz ! layer thickness - + ! real(kind=kind_phys) :: stc_bck(ncols, km), d_stc(ncols, km) + ! integer, allocatable, dimension(:) :: diff_indices + !TODO: 7.31.24: This is hard-coded in noahmpdrv real(kind=kind_phys) :: zsoil(4) = (/ -0.1, -0.4, -1.0, -2.0 /) !zsoil(km) @@ -262,27 +261,6 @@ subroutine noahmpdrv_timestep_finalize (itime, fhour, delt, km, ncols, return endif - stc_bck = stc - - ! hc_incr = 0.0 !0.9 * 4.6296296296296296296296296296296e-5 * delt !0.05 - - ! if(Land_IAU_Control%tile_num == 1) then - ! print*, "stc_bck shape, min, max ", shape(stc_bck), minval(stc_bck), maxval(stc_bck) - ! print*, " hc_incr ", hc_incr - ! print*, "proc, tile num, layer 1 stc_inc at 33:35,40:42", Land_IAU_Control%me, Land_IAU_Control%tile_num - ! do j = 33, 35 - ! WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) - ! do i = 40, 42 - ! ib = (j - 1) * Land_IAU_Control%nx + i - ! stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp - ! enddo - ! enddo - ! endif - - ! do ib = 1, ncols - ! stc(ib, 1) = stc_bck(ib, 1) + hc_incr !Land_IAU_Data%stc_inc(i,j,1)*delt !Land_IAU_Control%dtp - ! enddo - ! local variable to copy blocked data Land_IAU_Data%stc_inc allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols @@ -323,30 +301,6 @@ subroutine noahmpdrv_timestep_finalize (itime, fhour, delt, km, ncols, !TODO---if only fv3 increment files are used, this can be read from file allocate(mask_tile(lensfc)) call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) !& !veg_type_landice, - - ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - ! print*, "root proc, tile num, layer 1 stc", Land_IAU_Control%me, Land_IAU_Control%tile_num - ! ! ib = 1 - ! ! do j = 1, Land_IAU_Control%ny !ny - ! ! WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) - ! ! ib = ib + Land_IAU_Control%nx !nlon - ! ! enddo - ! print*, "root proc layer 1 inc" - ! ! ib = 1 - ! ! do j = 1, Land_IAU_Control%ny !ny - ! ! WRITE(*,"(48F6.3)") stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, 1)*delt - ! ! ib = ib + Land_IAU_Control%nx !nlon - ! ! enddo - ! do j = 33, 35 - ! WRITE(*,"(3F15.12)") Land_IAU_Data%stc_inc(40:42,j,1) - ! enddo - ! print*, "stc_inc_flat" - - ! do j = 33, 35 - ! ib = (j - 1) * Land_IAU_Control%nx + 40 - ! WRITE(*,"(3F15.12)") stc_inc_flat(ib:ib+2, 1) - ! enddo - ! endif !IAU increments are in units of 1/sec !Land_IAU_Control%dtp !* only updating soil temp for now @@ -394,19 +348,6 @@ subroutine noahmpdrv_timestep_finalize (itime, fhour, delt, km, ncols, endif ! if soil/snow point enddo ij_loop - ! do k = 1, km - ! stc(:,k) = stc(:,k) + stc_inc_flat(:,k)*delt !Land_IAU_Control%dtp - ! ! slc(:,k) = slc(:,k) + slc_inc_flat(:,k)*delt !Land_IAU_Control%dtp - ! enddo - ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - ! print*, "root proc layer 1 stc after adding IAU inc" - ! ib = 1 - ! do j = 1, Land_IAU_Control%ny !ny - ! WRITE(*,"(48F8.3)") stc(ib:ib+Land_IAU_Control%nx-1, 1) - ! ib = ib + Land_IAU_Control%nx !nlon - ! enddo - ! endif - deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) ! (consistency) adjustments for updated soil temp and moisture @@ -471,15 +412,6 @@ subroutine noahmpdrv_timestep_finalize (itime, fhour, delt, km, ncols, endif endif - ! d_stc = stc(:, 1) - stc_bck - ! ! Where(d_stc .gt. 0.0001) - ! diff_indices = pack([(i, i=1, lensfc)], d_stc > 0.0001) - ! print*, "proc ", Land_IAU_Control%me, " indices with large increment" - ! print*, diff_indices - ! print*, d_stc(diff_indices) - - ! if(allocated(diff_indices)) deallocate(diff_indices) - deallocate(stc_updated, slc_updated) deallocate(mask_tile) @@ -496,16 +428,16 @@ subroutine noahmpdrv_timestep_finalize (itime, fhour, delt, km, ncols, write(*,'(a,i8)') ' soil grid cells with slc adjustment', n_slc -end subroutine noahmpdrv_timestep_finalize +end subroutine noahmpdrv_timestep_init !> \ingroup NoahMP_LSM !! \brief This subroutine is called after noahmpdrv_run !! to free up allocated memory, if there are any !! code to do any needed consistency check will go here-- -!! \section arg_table_noahmpdrv_timestep_init Argument Table -!! \htmlinclude noahmpdrv_timestep_init.html +!! \section arg_table_noahmpdrv_timestep_finalize Argument Table +!! \htmlinclude noahmpdrv_timestep_finalize.html !! - subroutine noahmpdrv_timestep_init (errmsg, errflg) ! smc, t2mmp, q2mp, + subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, use machine, only: kind_phys implicit none @@ -517,7 +449,7 @@ subroutine noahmpdrv_timestep_init (errmsg, errflg) ! smc, t2mmp, q2mp, !> note the IAU deallocate happens at the noahmpdrv_finalize - end subroutine noahmpdrv_timestep_init + end subroutine noahmpdrv_timestep_finalize !> \ingroup NoahMP_LSM !! \brief This subroutine mirrors noahmpdrv_init diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 414f03f02..892894329 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -225,7 +225,7 @@ ######################################################################## [ccpp-arg-table] - name = noahmpdrv_timestep_finalize + name = noahmpdrv_timestep_init type = scheme [itime] standard_name = index_of_timestep @@ -342,7 +342,7 @@ ####################################################################### [ccpp-arg-table] - name = noahmpdrv_timestep_init + name = noahmpdrv_timestep_finalize type = scheme [errmsg] standard_name = ccpp_error_message From 812aefbbf20922de42b32ba665cf7367e666c52f Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 28 Aug 2024 19:46:22 -0400 Subject: [PATCH 090/141] fix missing error code initialization --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 4be782033..4f3e013e5 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -400,6 +400,10 @@ subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, errmsg, errflg character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + if (allocated (wk3_stc)) deallocate (wk3_stc) if (allocated (wk3_slc)) deallocate (wk3_slc) if (allocated (wk3_slmsk)) deallocate (wk3_slmsk) @@ -427,6 +431,10 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e integer n,i,j,k,kstep,nstep,itnext integer :: ntimes + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + ntimes = Land_IAU_Control%ntimes Land_IAU_Data%in_interval=.false. From 9b3dccdd0d73af70da9e40205deec5f8b5eadd0a Mon Sep 17 00:00:00 2001 From: tsga Date: Wed, 4 Sep 2024 02:56:27 +0000 Subject: [PATCH 091/141] remove namelist filename from iau struct --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 4f3e013e5..565dc395d 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -82,9 +82,9 @@ module land_iau_mod character(len=64) :: fn_nml !< namelist filename for surface data cycling real(kind=kind_phys) :: dtp !< physics timestep in seconds real(kind=kind_phys) :: fhour !< current forecast hour - character(len=:), pointer, dimension(:) :: input_nml_file => null() ! null() ! Date: Fri, 13 Sep 2024 07:56:53 +0000 Subject: [PATCH 092/141] use defaults when lnd_iau_nml doesn't exist --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 24 ++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 565dc395d..6047fcaf0 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -119,7 +119,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me !character(len=32) :: fn_nml = "input.nml" character(len=:), pointer, dimension(:) :: input_nml_file => null() integer :: input_nml_file_length !< length(number of lines) in namelist for internal reads - + character(len=4) :: iosstr !> these are not available through the CCPP interface so need to read them from namelist file !> vars to read from namelist @@ -149,7 +149,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886 allocate(input_nml_file, mold=input_nml_file_i) input_nml_file => input_nml_file_i - read(input_nml_file, nml=land_iau_nml) + read(input_nml_file, nml=land_iau_nml, ERR=888, END=999, iostat=ios) ! Set length (number of lines) in namelist for internal reads input_nml_file_length = size(input_nml_file) #else @@ -165,7 +165,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%fn_nml = trim(fn_nml) ! maynot need this open (unit=nlunit, file=trim(fn_nml), action='READ', status='OLD', iostat=ios, iomsg=ioerrmsg) rewind(nlunit) - read (nlunit, nml=land_iau_nml) + read (nlunit, nml=land_iau_nml, ERR=888, END=999, iostat=ios) close (nlunit) if (ios /= 0) then ! call mpp_error(FATAL, 'lnd_iau_mod_set_control: error reading namelist file ',trim(fn_nml)) @@ -178,6 +178,24 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me end if endif #endif + +888 if (ios /= 0) then ! .and. ios /= iostat_end) then + write(iosstr, '(I0)') ios + if (me == mpi_root) then + write(6,*) 'lnd_iau_mod_set_control: I/O error code '//trim(iosstr)//' at land_iau namelist read' + endif + errmsg = 'lnd_iau_mod_set_control: I/O error code '//trim(iosstr)//' at land_iau namelist read' + errflg = 1 + return + end if + +999 if (ios /= 0) then ! ios .eq. iostat_end) then + write(iosstr, '(I0)') ios + if (me == mpi_root) then + WRITE(6, * ) 'lnd_iau_mod_set_control: Warning! EoF ('//trim(iosstr)//') while reading land_iau namelist,' & + // ' likely because land_iau_nml was not found in input.nml. It will be set to default.' + endif + endif if (me == mpi_root) then write(6,*) "land_iau_nml" From 105eca11a6cf2a92a47f57b77ac7446de5bcf786 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Mon, 23 Sep 2024 00:35:22 -0600 Subject: [PATCH 093/141] Update noahmpdrv.F90 remove empty subroutine noahmpdrv_timestep_finalize --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 23 +------------------- 1 file changed, 1 insertion(+), 22 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index bfe3ebfcc..4d891f345 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -26,7 +26,7 @@ module noahmpdrv private public :: noahmpdrv_init, noahmpdrv_run, & - noahmpdrv_timestep_init, noahmpdrv_timestep_finalize, noahmpdrv_finalize + noahmpdrv_timestep_init, noahmpdrv_finalize !> \Land IAU data and control ! Land IAU Control holds settings' information, maily read from namelist (e.g., @@ -430,27 +430,6 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & end subroutine noahmpdrv_timestep_init - !> \ingroup NoahMP_LSM -!! \brief This subroutine is called after noahmpdrv_run -!! to free up allocated memory, if there are any -!! code to do any needed consistency check will go here-- -!! \section arg_table_noahmpdrv_timestep_finalize Argument Table -!! \htmlinclude noahmpdrv_timestep_finalize.html -!! - subroutine noahmpdrv_timestep_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, - - use machine, only: kind_phys - implicit none - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - ! --- Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - !> note the IAU deallocate happens at the noahmpdrv_finalize - - end subroutine noahmpdrv_timestep_finalize - !> \ingroup NoahMP_LSM !! \brief This subroutine mirrors noahmpdrv_init !! it calls land_iau_finalize which frees up allocated memory by IAU_init (in noahmdrv_init) From b4f0ba98f60f8365b97bc63e821c4bf43c001329 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Mon, 23 Sep 2024 00:41:24 -0600 Subject: [PATCH 094/141] Update noahmpdrv.meta remove empty subroutine: noahmpdrv_timestep_finalize --- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 20 ------------------- 1 file changed, 20 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 892894329..3994741d1 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -340,26 +340,6 @@ type = integer intent = out -####################################################################### -[ccpp-arg-table] - name = noahmpdrv_timestep_finalize - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - ####################################################################### [ccpp-arg-table] name = noahmpdrv_finalize From d2f9be1392c49853e6839688623cbbaf4cb261ce Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Mon, 23 Sep 2024 00:43:48 -0600 Subject: [PATCH 095/141] Update noahmpdrv.F90 removed pointer attribute from "input_nml_file" declaration --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 4d891f345..c96fb5531 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -74,7 +74,7 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & ! land iau mod integer, intent(in) :: mpi_root ! = GFS_Control%master character(*), intent(in) :: fn_nml - character(len=:), intent(in), dimension(:), pointer :: input_nml_file + character(len=:), intent(in), dimension(:) :: input_nml_file integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks integer, intent(in) :: tile_num !GFS_control_type%tile_num integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz From 6609eac2c59806f0b366016861478897d4eb4407 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Mon, 23 Sep 2024 00:50:40 -0600 Subject: [PATCH 096/141] Update lnd_iau_mod.F90 --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 6047fcaf0..61dcebaf8 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -121,8 +121,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me integer :: input_nml_file_length !< length(number of lines) in namelist for internal reads character(len=4) :: iosstr - !> these are not available through the CCPP interface so need to read them from namelist file - !> vars to read from namelist + !> land iau setting read from namelist logical :: do_land_iau = .false. real(kind=kind_phys) :: land_iau_delthrs = 0 !< iau time interval (to scale increments) character(len=240) :: land_iau_inc_files(7) = '' !< list of increment files From dbd3eb4a636c76629d9453d2a012c2f45b175fc7 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Mon, 23 Sep 2024 01:00:52 -0600 Subject: [PATCH 097/141] Update lnd_iau_mod.F90 remove commented out old lines --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 41 ++++--------------- 1 file changed, 7 insertions(+), 34 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 61dcebaf8..e537e5b56 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -76,15 +76,12 @@ module land_iau_mod logical :: upd_slc logical :: do_stcsmc_adjustment !do moisture/temperature adjustment for consistency after increment add real(kind=kind_phys) :: min_T_increment - !, iau_drymassfixer + integer :: me !< MPI rank designator integer :: mpi_root !< MPI rank of master atmosphere processor character(len=64) :: fn_nml !< namelist filename for surface data cycling real(kind=kind_phys) :: dtp !< physics timestep in seconds real(kind=kind_phys) :: fhour !< current forecast hour -! character(len=:), pointer, dimension(:) :: input_nml_file => null() ! null() + + character(len=:), dimension(:) :: input_nml_file => null() integer :: input_nml_file_length !< length(number of lines) in namelist for internal reads character(len=4) :: iosstr @@ -127,7 +124,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me character(len=240) :: land_iau_inc_files(7) = '' !< list of increment files real(kind=kind_phys) :: land_iau_fhrs(7) = -1 !< forecast hours associated with increment files logical :: land_iau_filter_increments = .false. !< filter IAU increments - !logical :: land_iau_gaussian_inc_file = .false. + integer :: lsoil_incr = 4 logical :: land_iau_upd_stc = .false. logical :: land_iau_upd_slc = .false. @@ -155,7 +152,6 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me ! if (file_exist(fn_nml)) then inquire (file=trim(fn_nml), exist=exists) ! TBCL: this maybe be replaced by nlunit passed from ccpp if (.not. exists) then - ! call mpp_error(FATAL, 'lnd_iau_mod_set_control: namelist file ',trim(fn_nml),' does not exist') write(6,*) 'lnd_iau_mod_set_control: namelist file ',trim(fn_nml),' does not exist' errmsg = 'lnd_iau_mod_set_control: namelist file '//trim(fn_nml)//' does not exist' errflg = 1 @@ -167,8 +163,6 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me read (nlunit, nml=land_iau_nml, ERR=888, END=999, iostat=ios) close (nlunit) if (ios /= 0) then - ! call mpp_error(FATAL, 'lnd_iau_mod_set_control: error reading namelist file ',trim(fn_nml)) - ! write(6,*) 'lnd_iau_mod_set_control: error reading namelist file ',trim(fn_nml) write(6,*) trim(ioerrmsg) errmsg = 'lnd_iau_mod_set_control: error reading namelist file '//trim(fn_nml) & // 'the error message from file handler:' //trim(ioerrmsg) @@ -221,9 +215,6 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me Land_IAU_Control%dtp = dtp Land_IAU_Control%fhour = fhour -! Land_IAU_Control%input_nml_file = input_nml_file -! Land_IAU_Control%input_nml_file_length = input_nml_file_length - Land_IAU_Control%upd_stc = land_iau_upd_stc Land_IAU_Control%upd_slc = land_iau_upd_slc Land_IAU_Control%do_stcsmc_adjustment = land_iau_do_stcsmc_adjustment @@ -244,12 +235,9 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me end subroutine land_iau_mod_set_control -subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !nlunit, ncols, IPD_Data,,Init_parm) - ! integer, intent(in) :: me, mpi_root +subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) type (land_iau_control_type), intent(inout) :: Land_IAU_Control type (land_iau_external_data_type), intent(inout) :: Land_IAU_Data - ! real(kind=kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon - ! real(kind=kind_phys), dimension(:), intent(in) :: xlat ! latitude character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -260,7 +248,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) integer :: nfilesall, ntimesall integer, allocatable :: idt(:) integer :: nlon, nlat - ! integer :: nb, ix, nblks, blksz logical :: exists integer :: ncid, dimid, varid, status, IDIM @@ -598,10 +585,9 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) end subroutine setiauforcing -subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, stc_inc_out, slc_inc_out +subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) type (land_iau_control_type), intent(in) :: Land_IAU_Control - ! character(len=*), intent(in) :: fname character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -784,7 +770,6 @@ SUBROUTINE NETCDF_ERR(ERR, STRING, errflg, errmsg_out) ERRMSG = NF90_STRERROR(ERR) PRINT*,'FATAL ERROR in Land IAU ', TRIM(STRING), ': ', TRIM(ERRMSG) errmsg_out = 'FATAL ERROR in Land IAU '//TRIM(STRING)//': '//TRIM(ERRMSG) - ! CALL MPI_ABORT(MPI_COMM_WORLD, 999) errflg = 1 return @@ -810,14 +795,7 @@ subroutine get_nc_dimlen(ncid, dim_name, dim_len, errflg, errmsg_out ) CALL netcdf_err(status, 'reading dim length '//trim(dim_name), errflg, errmsg_out) end subroutine get_nc_dimlen - ! status = nf90_inq_dimid(ncid, "longitude", dimid) - ! CALL netcdf_err(status, 'reading longitude dim id') - ! status = nf90_inquire_dimension(ncid, dimid, len = im) - ! CALL netcdf_err(status, 'reading dim longitude') - ! status = nf90_inq_dimid(ncid, "latitude", dimid) - ! CALL netcdf_err(status, 'reading latitude dim id') - ! status = nf90_inquire_dimension(ncid, dimid, len = jm) - ! CALL netcdf_err(status, 'reading dim latitude') + subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) integer, intent(in):: ncid, dim_len character(len=*), intent(in):: var_name @@ -861,11 +839,6 @@ subroutine get_var3d_values_int(ncid, varid, is,ix, js,jy, ks,kz, var3d, status) integer, intent(in):: is, ix, js, jy, ks,kz integer, intent(out):: var3d(ix, jy, kz) !var3d(is:ie,js:je,ks:ke) integer, intent(out):: status - ! integer, dimension(3):: start, nreco - ! start(1) = is; start(2) = js; start(3) = ks - ! nreco(1) = ie - is + 1 - ! nreco(2) = je - js + 1 - ! nreco(3) = ke - ks + 1 status = nf90_get_var(ncid, varid, var3d, & !start = start, count = nreco) start = (/is, js, ks/), count = (/ix, jy, kz/)) From 3c4fc1a887a5b6476d25b753c07f44b3d6226057 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Mon, 23 Sep 2024 05:14:32 -0600 Subject: [PATCH 098/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index c96fb5531..e9043a3fa 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -29,10 +29,8 @@ module noahmpdrv noahmpdrv_timestep_init, noahmpdrv_finalize !> \Land IAU data and control - ! Land IAU Control holds settings' information, maily read from namelist (e.g., - ! block of global domain that belongs to a process , - ! whethrer to do IAU increment at this time step, - ! time step informatoin, etc) + ! Land IAU Control holds settings' information, maily read from namelist (e.g., block of global domain that belongs to a process , + ! whether to do IAU increment at this time step, time step informatoin, etc) type (land_iau_control_type) :: Land_IAU_Control ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step type (land_iau_external_data_type) :: Land_IAU_Data !(number of blocks):each proc holds nblks From 335141f1fb32598773c3a7941cd1a759570d49c8 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Thu, 26 Sep 2024 00:30:44 -0600 Subject: [PATCH 099/141] Update lnd_iau_mod.F90 get rid unused var input_nml_length --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index e537e5b56..cd7968dba 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -114,8 +114,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me logical :: exists character(len=512) :: ioerrmsg - character(len=:), dimension(:) :: input_nml_file => null() - integer :: input_nml_file_length !< length(number of lines) in namelist for internal reads + character(len=:), dimension(:) :: input_nml_file => null() character(len=4) :: iosstr !> land iau setting read from namelist @@ -146,8 +145,6 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me allocate(input_nml_file, mold=input_nml_file_i) input_nml_file => input_nml_file_i read(input_nml_file, nml=land_iau_nml, ERR=888, END=999, iostat=ios) - ! Set length (number of lines) in namelist for internal reads - input_nml_file_length = size(input_nml_file) #else ! if (file_exist(fn_nml)) then inquire (file=trim(fn_nml), exist=exists) ! TBCL: this maybe be replaced by nlunit passed from ccpp From 77714c4f000f70e95c8048a326ff54e7fc748f82 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 2 Oct 2024 09:13:14 -0600 Subject: [PATCH 100/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index e9043a3fa..08e6d192d 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -280,7 +280,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! delt=GFS_Control%dtf if ((Land_IAU_Control%dtp - delt) > 0.0001) then if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "Warning noahmpdrv_run delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp + print*, "Warning noahmpdrv_timestep_init delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp endif endif From 28cf85f5983a1b8ffc714b02fd0cd45dc26b76fa Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 2 Oct 2024 09:19:38 -0600 Subject: [PATCH 101/141] Update noahmpdrv.F90 comment out unused number of freeze/thaw counters --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 08e6d192d..fbc9f15d1 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -197,7 +197,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & integer, allocatable :: mask_tile(:) integer,allocatable :: stc_updated(:), slc_updated(:) logical :: soil_freeze, soil_ice - integer :: n_freeze, n_thaw + ! integer :: n_freeze, n_thaw integer :: soiltype, n_stc, n_slc real(kind=kind_phys) :: slc_new From 156fb4e5f09e41b8064fe61502afc8f6a20e6432 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 2 Oct 2024 09:20:59 -0600 Subject: [PATCH 102/141] Update noahmpdrv.meta fix typo --- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 3994741d1..5bcc0840e 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -114,7 +114,7 @@ intent = in [input_nml_file] standard_name = filename_of_internal_namelist - long_name = amelist filename for internal file reads + long_name = namelist filename for internal file reads units = none type = character dimensions = (ccpp_constant_one:number_of_lines_in_internal_namelist) From bfbb35de96dcd2fed39df0c4eae14548969bd97d Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 2 Oct 2024 09:26:27 -0600 Subject: [PATCH 103/141] Update noahmpdrv.meta make long names consistent with naming conventions --- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 5bcc0840e..c8a0dd9dc 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -143,14 +143,14 @@ intent = in [nx] standard_name = number_of_points_in_x_direction_for_this_mpi_rank - long_name = number of points in x direction for this MPI rank + long_name = number of points in the x direction units = count dimensions = () type = integer intent = in [ny] standard_name = number_of_points_in_y_direction_for_this_mpi_rank - long_name = number of points in y direction for this MPI rank + long_name = number of points in the y direction units = count dimensions = () type = integer @@ -252,7 +252,7 @@ intent = in [km] standard_name = vertical_dimension_of_soil - long_name = soil vertical layer dimension + long_name = vertical dimension of soil layers units = count dimensions = () type = integer @@ -294,7 +294,7 @@ intent= in [weasd] standard_name = water_equivalent_accumulated_snow_depth_over_land - long_name = water equiv of acc snow depth over land + long_name = water equivalent of accumulated snow depth over land units = mm dimensions = (horizontal_dimension) type = real From 7188fc8a7a73f9de29e470b8a86df90b67eb39e3 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 9 Oct 2024 12:57:01 -0400 Subject: [PATCH 104/141] move declaration of land_iau_mod DDT instances from CCPP physics to host model --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 60 ++++++++++-------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 39 +++++++----- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 63 +++++++++++++++++++ 3 files changed, 121 insertions(+), 41 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index cd7968dba..3249a6e65 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -21,13 +21,17 @@ module land_iau_mod use machine, only: kind_phys, kind_dyn - use physcons, only: pi => con_pi use netcdf implicit none private + !GJF: These variables may need to get moved to the host model and passed in, depending on their use. + ! They are currently allocated/initialized in the CCPP init stage and are used throughout the + ! simulation in the timestep_init phase. Since this module memory exists on the heap, this + ! may cause issues for models that have multiple CCPP instances in one executable if the data + ! differs between CCPP instances. real(kind=kind_phys), allocatable :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) integer, allocatable :: wk3_slmsk(:, :, :) @@ -87,7 +91,6 @@ module land_iau_mod end type land_iau_control_type - type(land_iau_state_type) :: Land_IAU_state public land_iau_control_type, land_iau_external_data_type, land_iau_mod_set_control, & land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, calculate_landinc_mask @@ -232,11 +235,12 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me end subroutine land_iau_mod_set_control -subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) - type (land_iau_control_type), intent(inout) :: Land_IAU_Control - type (land_iau_external_data_type), intent(inout) :: Land_IAU_Data - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg +subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) + type (land_iau_control_type), intent(inout) :: Land_IAU_Control + type (land_iau_external_data_type), intent(inout) :: Land_IAU_Data + type(land_iau_state_type), intent(inout) :: Land_IAU_state + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg ! local character(len=128) :: fname @@ -372,7 +376,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) enddo if (ntimes.EQ.1) then ! only need to get incrments once since constant forcing over window - call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%rdt, Land_IAU_state%wt) + call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) endif if (ntimes.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) @@ -392,12 +396,13 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) end subroutine land_iau_mod_init -subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) +subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) implicit none - type (land_iau_control_type), intent(in) :: Land_IAU_Control + type(land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data + type(land_iau_state_type), intent(inout) :: Land_IAU_state character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -421,11 +426,12 @@ subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, errmsg, errflg end subroutine land_iau_mod_finalize - subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) + subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) implicit none type (land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data + type(land_iau_state_type), intent(inout) :: Land_IAU_state character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg real(kind=kind_phys) t1,t2,sx,wx,wt,dtp @@ -483,7 +489,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',t1,Land_IAU_Control%fhour,t2 Land_IAU_Data%in_interval=.false. else - if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control,Land_IAU_Data, Land_IAU_state%rdt, Land_IAU_state%wt) + if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact,Land_IAU_state%rdt Land_IAU_Data%in_interval=.true. endif @@ -517,18 +523,19 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, e Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) endif Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(itnext-1, :, :) - call updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state%rdt, Land_IAU_state%wt) + call updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) endif endif end subroutine land_iau_mod_getiauforcing -subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) +subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) implicit none - type (land_iau_control_type), intent(in) :: Land_IAU_Control + type (land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data - real(kind=kind_phys) delt, rdt, wt + type(land_iau_state_type), intent(inout) :: Land_IAU_state + real(kind=kind_phys) delt integer i,j,k integer :: is, ie, js, je, npz integer :: ntimes @@ -543,23 +550,24 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) delt = (Land_IAU_state%hr2-(Land_IAU_Control%fhour))/(Land_IAU_state%hr2-Land_IAU_state%hr1) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ntimes ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes), & - " rdt wt delt ", rdt, wt, delt + " rdt wt delt ", Land_IAU_state%rdt, Land_IAU_state%wt, delt do j = js,je do i = is,ie do k = 1,npz ! do k = 1,n_soill ! - Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_state%inc1%stc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%stc_inc(i,j,k))*rdt*wt - Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_state%inc1%slc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%slc_inc(i,j,k))*rdt*wt + Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_state%inc1%stc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%stc_inc(i,j,k))*Land_IAU_state%rdt*Land_IAU_state%wt + Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_state%inc1%slc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%slc_inc(i,j,k))*Land_IAU_state%rdt*Land_IAU_state%wt end do enddo enddo end subroutine updateiauforcing - subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) + subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) implicit none - type (land_iau_control_type), intent(in) :: Land_IAU_Control - type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data - real(kind=kind_phys) delt, rdt,wt + type(land_iau_control_type), intent(in ) :: Land_IAU_Control + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data + type(land_iau_state_type), intent(in ) :: Land_IAU_state + real(kind=kind_phys) delt integer i, j, k integer :: is, ie, js, je, npz @@ -569,12 +577,12 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, rdt, wt) je = js + Land_IAU_Control%ny-1 npz = Land_IAU_Control%lsoil ! this is only called if using 1 increment file - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau setiauforcing rdt = ',rdt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau setiauforcing rdt = ',Land_IAU_state%rdt do j = js, je do i = is, ie do k = 1, npz ! do k = 1,n_soill ! - Land_IAU_Data%stc_inc(i,j,k) = wt*Land_IAU_state%inc1%stc_inc(i,j,k)*rdt - Land_IAU_Data%slc_inc(i,j,k) = wt*Land_IAU_state%inc1%slc_inc(i,j,k)*rdt + Land_IAU_Data%stc_inc(i,j,k) = Land_IAU_state%wt*Land_IAU_state%inc1%stc_inc(i,j,k)*Land_IAU_state%rdt + Land_IAU_Data%slc_inc(i,j,k) = Land_IAU_state%wt*Land_IAU_state%inc1%slc_inc(i,j,k)*Land_IAU_state%rdt end do Land_IAU_Data%snow_land_mask(i, j) = wk3_slmsk(1, i, j) enddo diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index fbc9f15d1..218a0df29 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -14,7 +14,8 @@ module noahmpdrv use module_sf_noahmplsm ! Land IAU increments for soil temperature (can also do soil moisture increments if needed) - use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & + use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & + land_iau_state_type, & land_iau_mod_set_control, land_iau_mod_init, & land_iau_mod_getiauforcing, land_iau_mod_finalize, & calculate_landinc_mask @@ -26,14 +27,7 @@ module noahmpdrv private public :: noahmpdrv_init, noahmpdrv_run, & - noahmpdrv_timestep_init, noahmpdrv_finalize - - !> \Land IAU data and control - ! Land IAU Control holds settings' information, maily read from namelist (e.g., block of global domain that belongs to a process , - ! whether to do IAU increment at this time step, time step informatoin, etc) - type (land_iau_control_type) :: Land_IAU_Control - ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step - type (land_iau_external_data_type) :: Land_IAU_Data !(number of blocks):each proc holds nblks + noahmpdrv_timestep_init, noahmpdrv_finalize contains @@ -48,7 +42,7 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & nlunit, pores, resid, & do_mynnsfclay,do_mynnedmf, & errmsg, errflg, & - mpi_root, & + land_iau_control, land_iau_data, land_iau_state, mpi_root, & fn_nml, input_nml_file, isc, jsc, ncols, nx, ny, tile_num, & nblks, blksz, xlon, xlat, & lsoil, lsnow_lsm, dtp, fhour) @@ -70,6 +64,13 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! land iau mod + + ! Land IAU Control holds settings' information, maily read from namelist (e.g., block of global domain that belongs to a process , + ! whether to do IAU increment at this time step, time step informatoin, etc) + type(land_iau_control_type), intent(inout) :: Land_IAU_Control + ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data !(number of blocks):each proc holds nblks + type(land_iau_state_type), intent(inout) :: Land_IAU_state integer, intent(in) :: mpi_root ! = GFS_Control%master character(*), intent(in) :: fn_nml character(len=:), intent(in), dimension(:) :: input_nml_file @@ -135,7 +136,7 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) ! Initialize IAU for land if (.not. Land_IAU_Control%do_land_iau) return - call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, errmsg, errflg) ! xlon, xlat, errmsg, errflg) + call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) ! xlon, xlat, errmsg, errflg) end subroutine noahmpdrv_init @@ -155,6 +156,7 @@ end subroutine noahmpdrv_init subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & !me, mpi_root, isot, ivegsrc, soiltyp, vegtype, weasd, & + land_iau_control, land_iau_data, land_iau_state, & stc, slc, smc, errmsg, errflg) ! smc, t2mmp, q2mp, use machine, only: kind_phys @@ -175,7 +177,10 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & integer , dimension(:) , intent(in) :: soiltyp ! soil type (integer index) integer , dimension(:) , intent(in) :: vegtype ! vegetation type (integer index) real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] - + + type(land_iau_control_type) , intent(inout) :: Land_IAU_Control + type(land_iau_external_data_type) , intent(inout) :: Land_IAU_Data + type(land_iau_state_type) , intent(inout) :: Land_IAU_State real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! @@ -183,6 +188,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & integer, intent(out) :: errflg ! IAU update + real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat, slc_inc_flat real(kind=kind_phys), dimension(km) :: dz ! layer thickness ! real(kind=kind_phys) :: stc_bck(ncols, km), d_stc(ncols, km) @@ -231,7 +237,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & endif !> read iau increments - call land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) + call land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) if (errflg .ne. 0) then if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" @@ -434,10 +440,13 @@ end subroutine noahmpdrv_timestep_init !! \section arg_table_noahmpdrv_finalize Argument Table !! \htmlinclude noahmpdrv_finalize.html !! - subroutine noahmpdrv_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, + subroutine noahmpdrv_finalize (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) ! smc, t2mmp, q2mp, use machine, only: kind_phys implicit none + type(land_iau_control_type) , intent(in ) :: Land_IAU_Control + type(land_iau_external_data_type) , intent(inout) :: Land_IAU_Data + type(land_iau_state_type) , intent(inout) :: Land_IAU_State character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg integer :: j, k, ib @@ -446,7 +455,7 @@ subroutine noahmpdrv_finalize (errmsg, errflg) ! smc, t2mmp, q2mp, errflg = 0 if (.not. Land_IAU_Control%do_land_iau) return - call land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, errmsg, errflg) !Land_IAU_Control%finalize() + call land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) !Land_IAU_Control%finalize() end subroutine noahmpdrv_finalize diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index c8a0dd9dc..a09f257fd 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -97,6 +97,27 @@ dimensions = () type = integer intent = out +[land_iau_control] + standard_name = land_data_assimilation_control + long_name = land data assimilation control + units = mixed + dimensions = () + type = land_iau_control_type + intent = inout +[land_iau_data] + standard_name = land_data_assimilation_data + long_name = land data assimilation data + units = mixed + dimensions = () + type = land_iau_external_data_type + intent = inout +[land_iau_state] + standard_name = land_data_assimilation_interpolated_data + long_name = land data assimilation space- and time-interpolated + units = mixed + dimensions = () + type = land_iau_state_type + intent = inout [mpi_root] standard_name = mpi_root long_name = master MPI-rank @@ -300,6 +321,27 @@ type = real kind = kind_phys intent = inout +[land_iau_control] + standard_name = land_data_assimilation_control + long_name = land data assimilation control + units = mixed + dimensions = () + type = land_iau_control_type + intent = inout +[land_iau_data] + standard_name = land_data_assimilation_data + long_name = land data assimilation data + units = mixed + dimensions = () + type = land_iau_external_data_type + intent = inout +[land_iau_state] + standard_name = land_data_assimilation_interpolated_data + long_name = land data assimilation space- and time-interpolated + units = mixed + dimensions = () + type = land_iau_state_type + intent = inout [stc] standard_name = soil_temperature long_name = soil temperature @@ -344,6 +386,27 @@ [ccpp-arg-table] name = noahmpdrv_finalize type = scheme +[land_iau_control] + standard_name = land_data_assimilation_control + long_name = land data assimilation control + units = mixed + dimensions = () + type = land_iau_control_type + intent = in +[land_iau_data] + standard_name = land_data_assimilation_data + long_name = land data assimilation data + units = mixed + dimensions = () + type = land_iau_external_data_type + intent = inout +[land_iau_state] + standard_name = land_data_assimilation_interpolated_data + long_name = land data assimilation space- and time-interpolated + units = mixed + dimensions = () + type = land_iau_state_type + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From bf3e1e1659c9ad1240738bcd4e32c5d1301d6277 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 9 Oct 2024 19:59:09 +0000 Subject: [PATCH 105/141] add metadata for land IAU types --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 13 +++++ .../SFC_Models/Land/Noahmp/lnd_iau_mod.meta | 58 +++++++++++++++++++ 2 files changed, 71 insertions(+) create mode 100644 physics/SFC_Models/Land/Noahmp/lnd_iau_mod.meta diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 3249a6e65..6c501167b 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -18,6 +18,9 @@ !> by Xi.Chen and Philip Pegion, PSL !------------------------------------------------------------------------------- +!> \section arg_table_land_iau_mod Argument table +!! \htmlinclude land_iau_mod.html +!! module land_iau_mod use machine, only: kind_phys, kind_dyn @@ -40,6 +43,9 @@ module land_iau_mod real(kind=kind_phys),allocatable :: slc_inc(:,:,:) end type land_iau_internal_data_type +!> \section arg_table_land_iau_external_data_type Argument Table +!! \htmlinclude land_iau_external_data_type.html +!! type land_iau_external_data_type real(kind=kind_phys),allocatable :: stc_inc(:,:,:) real(kind=kind_phys),allocatable :: slc_inc(:,:,:) @@ -47,6 +53,9 @@ module land_iau_mod integer,allocatable :: snow_land_mask(:, :) end type land_iau_external_data_type +!!> \section arg_table_land_iau_state_type Argument Table +!! \htmlinclude land_iau_state_type.html +!! type land_iau_state_type type(land_iau_internal_data_type) :: inc1 type(land_iau_internal_data_type) :: inc2 @@ -57,6 +66,10 @@ module land_iau_mod real(kind=kind_phys) :: rdt end type land_iau_state_type + +!!!> \section arg_table_land_iau_control_type Argument Table +!! \htmlinclude land_iau_control_type.html +!! type land_iau_control_type integer :: isc integer :: jsc diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.meta b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.meta new file mode 100644 index 000000000..8541af659 --- /dev/null +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.meta @@ -0,0 +1,58 @@ +[ccpp-table-properties] + name = land_iau_external_data_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = land_iau_external_data_type + type = ddt + +######################################################################## + +[ccpp-table-properties] + name = land_iau_state_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = land_iau_state_type + type = ddt + +######################################################################## + +[ccpp-table-properties] + name = land_iau_control_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = land_iau_control_type + type = ddt + +######################################################################## +[ccpp-table-properties] + name = land_iau_mod + type = module + dependencies = machine.F + +[ccpp-arg-table] + name = land_iau_mod + type = module +[land_iau_external_data_type] + standard_name = land_iau_external_data_type + long_name = definition of type land_iau_external_data_type + units = DDT + dimensions = () + type = land_iau_external_data_type +[land_iau_state_type] + standard_name = land_iau_state_type + long_name = definition of type land_iau_state_type + units = DDT + dimensions = () + type = land_iau_state_type +[land_iau_control_type] + standard_name = land_iau_control_type + long_name = definition of type land_iau_control_type + units = DDT + dimensions = () + type = land_iau_control_type From 4782f68666a0e719a217ba42d485e4f65ab3b914 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 9 Oct 2024 22:12:26 +0000 Subject: [PATCH 106/141] fix compilation errors --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 4 ++-- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 6c501167b..a1495c433 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -104,7 +104,7 @@ module land_iau_mod end type land_iau_control_type - public land_iau_control_type, land_iau_external_data_type, land_iau_mod_set_control, & + public land_iau_control_type, land_iau_external_data_type, land_iau_state_type, land_iau_mod_set_control, & land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, calculate_landinc_mask contains @@ -130,7 +130,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me logical :: exists character(len=512) :: ioerrmsg - character(len=:), dimension(:) :: input_nml_file => null() + character(len=:), pointer, dimension(:) :: input_nml_file => null() character(len=4) :: iosstr !> land iau setting read from namelist diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 218a0df29..8b624c062 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -73,7 +73,7 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & type(land_iau_state_type), intent(inout) :: Land_IAU_state integer, intent(in) :: mpi_root ! = GFS_Control%master character(*), intent(in) :: fn_nml - character(len=:), intent(in), dimension(:) :: input_nml_file + character(len=:), pointer, intent(in), dimension(:) :: input_nml_file integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks integer, intent(in) :: tile_num !GFS_control_type%tile_num integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz From 6e3bc2f49b389d55e94544407cda905c14be4bd3 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 15 Oct 2024 18:10:53 -0400 Subject: [PATCH 107/141] set land_iau_control from host --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 4 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 54 ++++++++++--------- 2 files changed, 30 insertions(+), 28 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index a1495c433..205623004 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -409,7 +409,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e end subroutine land_iau_mod_init -subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) +subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_state, errmsg, errflg) implicit none @@ -563,7 +563,7 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) delt = (Land_IAU_state%hr2-(Land_IAU_Control%fhour))/(Land_IAU_state%hr2-Land_IAU_state%hr1) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ntimes ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes), & - " rdt wt delt ", Land_IAU_state%rdt, Land_IAU_state%wt, delt + " rdt wt delt_t ", Land_IAU_state%rdt, Land_IAU_state%wt, delt do j = js,je do i = is,ie do k = 1,npz ! do k = 1,n_soill ! diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 8b624c062..497f81570 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -15,10 +15,10 @@ module noahmpdrv ! Land IAU increments for soil temperature (can also do soil moisture increments if needed) use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & - land_iau_state_type, & - land_iau_mod_set_control, land_iau_mod_init, & - land_iau_mod_getiauforcing, land_iau_mod_finalize, & - calculate_landinc_mask + land_iau_state_type + + use land_iau_mod, only: land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, & + calculate_landinc_mask ! land_iau_mod_set_control, implicit none @@ -37,15 +37,16 @@ module noahmpdrv !! \section arg_table_noahmpdrv_init Argument Table !! \htmlinclude noahmpdrv_init.html !! - subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & + subroutine noahmpdrv_init(lsm, lsm_noahmp, & isot, ivegsrc, & nlunit, pores, resid, & do_mynnsfclay,do_mynnedmf, & errmsg, errflg, & - land_iau_control, land_iau_data, land_iau_state, mpi_root, & - fn_nml, input_nml_file, isc, jsc, ncols, nx, ny, tile_num, & - nblks, blksz, xlon, xlat, & - lsoil, lsnow_lsm, dtp, fhour) + Land_IAU_Control, Land_IAU_Data, Land_IAU_state) + ! , me, mpi_root, & + ! fn_nml, input_nml_file, isc, jsc, ncols, nx, ny, tile_num, & + ! nblks, blksz, xlon, xlat, & + ! lsoil, lsnow_lsm, dtp, fhour) use machine, only: kind_phys use set_soilveg_mod, only: set_soilveg @@ -55,8 +56,7 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & implicit none integer, intent(in) :: lsm - integer, intent(in) :: lsm_noahmp - integer, intent(in) :: me ! mpi_rank + integer, intent(in) :: lsm_noahmp integer, intent(in) :: isot, ivegsrc, nlunit real (kind=kind_phys), dimension(:), intent(out) :: pores, resid logical, intent(in) :: do_mynnsfclay @@ -71,17 +71,19 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data !(number of blocks):each proc holds nblks type(land_iau_state_type), intent(inout) :: Land_IAU_state - integer, intent(in) :: mpi_root ! = GFS_Control%master - character(*), intent(in) :: fn_nml - character(len=:), pointer, intent(in), dimension(:) :: input_nml_file - integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks - integer, intent(in) :: tile_num !GFS_control_type%tile_num - integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz - real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon - real(kind_phys), dimension(:), intent(in) :: xlat ! latitude - - integer, intent(in) :: lsoil, lsnow_lsm - real(kind=kind_phys), intent(in) :: dtp, fhour + + ! integer, intent(in) :: me ! mpi_rank + ! integer, intent(in) :: mpi_root ! = GFS_Control%master + ! character(*), intent(in) :: fn_nml + ! character(len=:), pointer, intent(in), dimension(:) :: input_nml_file + ! integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks + ! integer, intent(in) :: tile_num !GFS_control_type%tile_num + ! integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz + ! real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon + ! real(kind_phys), dimension(:), intent(in) :: xlat ! latitude + + ! integer, intent(in) :: lsoil, lsnow_lsm + ! real(kind=kind_phys), intent(in) :: dtp, fhour ! Initialize CCPP error handling variables errmsg = '' @@ -130,10 +132,10 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, & pores (:) = maxsmc (:) resid (:) = drysmc (:) - ! Read Land IAU settings - call land_iau_mod_set_control(Land_IAU_Control, fn_nml, input_nml_file, & - me, mpi_root, isc,jsc, nx, ny, tile_num, nblks, blksz, & - lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) + ! ! Read Land IAU settings + ! call land_iau_mod_set_control(Land_IAU_Control, fn_nml, input_nml_file, & + ! me, mpi_root, isc,jsc, nx, ny, tile_num, nblks, blksz, & + ! lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) ! Initialize IAU for land if (.not. Land_IAU_Control%do_land_iau) return call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) ! xlon, xlat, errmsg, errflg) From 1a6778566bc5e8d99ed1363998ab902f7eb6fcd0 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 16 Oct 2024 07:41:27 -0400 Subject: [PATCH 108/141] calculate snowsoil mask at runtime --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 52 +++++++++---------- 1 file changed, 24 insertions(+), 28 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 205623004..edd8f62b0 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -36,7 +36,7 @@ module land_iau_mod ! may cause issues for models that have multiple CCPP instances in one executable if the data ! differs between CCPP instances. real(kind=kind_phys), allocatable :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) - integer, allocatable :: wk3_slmsk(:, :, :) +! integer, allocatable :: wk3_slmsk(:, :, :) ! Calculate snow soil mask at runtime from (dynamic) swe type land_iau_internal_data_type real(kind=kind_phys),allocatable :: stc_inc(:,:,:) @@ -50,7 +50,7 @@ module land_iau_mod real(kind=kind_phys),allocatable :: stc_inc(:,:,:) real(kind=kind_phys),allocatable :: slc_inc(:,:,:) logical :: in_interval = .false. - integer,allocatable :: snow_land_mask(:, :) + ! integer,allocatable :: snow_land_mask(:, :) ! Calculate snow soil mask at runtime from (dynamic) swe end type land_iau_external_data_type !!> \section arg_table_land_iau_state_type Argument Table @@ -268,8 +268,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e real(kind=kind_phys) :: dt, rdt integer :: im, jm, km, nfiles, ntimes - integer :: n_soill, n_snowl !soil and snow layers - logical :: do_land_iau integer :: is, ie, js, je integer :: npz integer :: i, j @@ -278,9 +276,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e errmsg = '' errflg = 0 - do_land_iau = Land_IAU_Control%do_land_iau - n_soill = Land_IAU_Control%lsoil !4 for sfc updates -! n_snowl = Land_IAU_Control%lsnowl npz = Land_IAU_Control%lsoil km = Land_IAU_Control%lsoil @@ -297,7 +292,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e allocate(Land_IAU_Data%stc_inc(nlon, nlat, km)) allocate(Land_IAU_Data%slc_inc(nlon, nlat, km)) - allocate(Land_IAU_Data%snow_land_mask(nlon, nlat)) + ! allocate(Land_IAU_Data%snow_land_mask(nlon, nlat)) ! allocate arrays that will hold iau state allocate (Land_IAU_state%inc1%stc_inc(nlon, nlat, km)) @@ -332,6 +327,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e ! increment files in fv3 tiles if (trim(Land_IAU_Control%iau_inc_files(1)) .eq. '' .or. Land_IAU_Control%iaufhrs(1) .lt. 0) then ! only 1 file expected print*, "warning! in Land IAU but increment file name is empty or iaufhrs(1) is negative" + Land_IAU_Control%do_land_iau=.false. return endif if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then @@ -394,7 +390,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e if (ntimes.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) - Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(1, :, :) + ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(1, :, :) do k = 1, npz ! do k = 1,n_soill ! do j = 1, nlat @@ -425,11 +421,11 @@ subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_state if (allocated (wk3_stc)) deallocate (wk3_stc) if (allocated (wk3_slc)) deallocate (wk3_slc) - if (allocated (wk3_slmsk)) deallocate (wk3_slmsk) + ! if (allocated (wk3_slmsk)) deallocate (wk3_slmsk) if (allocated(Land_IAU_Data%stc_inc)) deallocate (Land_IAU_Data%stc_inc) if (allocated(Land_IAU_Data%slc_inc)) deallocate (Land_IAU_Data%slc_inc) - if (allocated(Land_IAU_Data%snow_land_mask)) deallocate (Land_IAU_Data%snow_land_mask) + ! if (allocated(Land_IAU_Data%snow_land_mask)) deallocate (Land_IAU_Data%snow_land_mask) if (allocated(Land_IAU_state%inc1%stc_inc)) deallocate(Land_IAU_state%inc1%stc_inc) if (allocated(Land_IAU_state%inc1%slc_inc)) deallocate(Land_IAU_state%inc1%slc_inc) @@ -535,7 +531,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) endif - Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(itnext-1, :, :) + ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(itnext-1, :, :) call updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) endif endif @@ -597,7 +593,7 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) Land_IAU_Data%stc_inc(i,j,k) = Land_IAU_state%wt*Land_IAU_state%inc1%stc_inc(i,j,k)*Land_IAU_state%rdt Land_IAU_Data%slc_inc(i,j,k) = Land_IAU_state%wt*Land_IAU_state%inc1%slc_inc(i,j,k)*Land_IAU_state%rdt end do - Land_IAU_Data%snow_land_mask(i, j) = wk3_slmsk(1, i, j) + ! Land_IAU_Data%snow_land_mask(i, j) = wk3_slmsk(1, i, j) enddo enddo @@ -665,7 +661,7 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) allocate(wk3_stc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) allocate(wk3_slc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) - allocate(wk3_slmsk(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny)) + ! allocate(wk3_slmsk(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny)) do i = 1, size(stc_vars) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(stc_vars(i)) @@ -701,20 +697,20 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) wk3_slc(:, :, :, i) = 0. endif enddo - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(slsn_mask) - status = nf90_inq_varid(ncid, trim(slsn_mask), varid) - if (status == nf90_noerr) then !if (ierr == 0) then - do it = 1, n_t - call get_var3d_values_int(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & - it, 1, wk3_slmsk(it, :, :), status) - call netcdf_err(status, 'reading var: '//trim(slsn_mask), errflg, errmsg) - if (errflg .ne. 0) return - enddo - else - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, 'warning: no values for ',trim(slsn_mask), ' found', & - 'assuming value of 1 for all grid cells. Please make sure the increment files have soil snow mask var' - wk3_slmsk(:, :, :) = 1 - endif + ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(slsn_mask) + ! status = nf90_inq_varid(ncid, trim(slsn_mask), varid) + ! if (status == nf90_noerr) then !if (ierr == 0) then + ! do it = 1, n_t + ! call get_var3d_values_int(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & + ! it, 1, wk3_slmsk(it, :, :), status) + ! call netcdf_err(status, 'reading var: '//trim(slsn_mask), errflg, errmsg) + ! if (errflg .ne. 0) return + ! enddo + ! else + ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, 'warning: no values for ',trim(slsn_mask), ' found', & + ! 'assuming value of 1 for all grid cells. Please make sure the increment files have soil snow mask var' + ! wk3_slmsk(:, :, :) = 1 + ! endif status =nf90_close(ncid) call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) From c58be12171ad858978c5002dc3e0d0a7fe6f58e8 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 16 Oct 2024 15:00:29 -0400 Subject: [PATCH 109/141] combine DDTs holding increments; get rid of scheme level global array --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 173 ++++++++++-------- 1 file changed, 95 insertions(+), 78 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index edd8f62b0..0ff126c9c 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -35,13 +35,13 @@ module land_iau_mod ! simulation in the timestep_init phase. Since this module memory exists on the heap, this ! may cause issues for models that have multiple CCPP instances in one executable if the data ! differs between CCPP instances. - real(kind=kind_phys), allocatable :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) +! real(kind=kind_phys), allocatable :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) ! integer, allocatable :: wk3_slmsk(:, :, :) ! Calculate snow soil mask at runtime from (dynamic) swe - type land_iau_internal_data_type - real(kind=kind_phys),allocatable :: stc_inc(:,:,:) - real(kind=kind_phys),allocatable :: slc_inc(:,:,:) - end type land_iau_internal_data_type +! type land_iau_internal_data_type +! real(kind=kind_phys),allocatable :: stc_inc(:,:,:) +! real(kind=kind_phys),allocatable :: slc_inc(:,:,:) +! end type land_iau_internal_data_type !> \section arg_table_land_iau_external_data_type Argument Table !! \htmlinclude land_iau_external_data_type.html @@ -51,19 +51,24 @@ module land_iau_mod real(kind=kind_phys),allocatable :: slc_inc(:,:,:) logical :: in_interval = .false. ! integer,allocatable :: snow_land_mask(:, :) ! Calculate snow soil mask at runtime from (dynamic) swe + real(kind=kind_phys) :: hr1 ! moved from _state_type + real(kind=kind_phys) :: hr2 end type land_iau_external_data_type !!> \section arg_table_land_iau_state_type Argument Table !! \htmlinclude land_iau_state_type.html !! + ! land_iau_state will hold inrements, read during land_iau_mod_init type land_iau_state_type - type(land_iau_internal_data_type) :: inc1 - type(land_iau_internal_data_type) :: inc2 - real(kind=kind_phys) :: hr1 - real(kind=kind_phys) :: hr2 - real(kind=kind_phys) :: wt - real(kind=kind_phys) :: wt_normfact - real(kind=kind_phys) :: rdt + ! type(land_iau_internal_data_type) :: inc1 + ! type(land_iau_internal_data_type) :: inc2 + real(kind=kind_phys),allocatable :: stc_inc(:,:,:,:) + real(kind=kind_phys),allocatable :: slc_inc(:,:,:,:) + ! real(kind=kind_phys) :: hr1 ! moved to land_iau_external_data_type because they may vary with time + ! real(kind=kind_phys) :: hr2 + ! real(kind=kind_phys) :: wt ! moved to _control_type because they are constant + ! real(kind=kind_phys) :: wt_normfact + ! real(kind=kind_phys) :: rdt end type land_iau_state_type @@ -101,6 +106,11 @@ module land_iau_mod real(kind=kind_phys) :: fhour !< current forecast hour integer :: ntimes + + ! moved from land_iau_state_type because they are constant + real(kind=kind_phys) :: wt + real(kind=kind_phys) :: wt_normfact + real(kind=kind_phys) :: rdt end type land_iau_control_type @@ -265,7 +275,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e logical :: exists integer :: ncid, dimid, varid, status, IDIM - real(kind=kind_phys) :: dt, rdt + real(kind=kind_phys) :: dt !, rdt integer :: im, jm, km, nfiles, ntimes integer :: is, ie, js, je @@ -290,19 +300,19 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e print*, "rank is ie js je nlon nlat", Land_IAU_Control%me, is, ie, js, je, nlon, nlat + ! allocate arrays that will hold iau state allocate(Land_IAU_Data%stc_inc(nlon, nlat, km)) allocate(Land_IAU_Data%slc_inc(nlon, nlat, km)) ! allocate(Land_IAU_Data%snow_land_mask(nlon, nlat)) -! allocate arrays that will hold iau state - allocate (Land_IAU_state%inc1%stc_inc(nlon, nlat, km)) - allocate (Land_IAU_state%inc1%slc_inc(nlon, nlat, km)) - allocate (Land_IAU_state%inc2%stc_inc(nlon, nlat, km)) - allocate (Land_IAU_state%inc2%slc_inc(nlon, nlat, km)) - - Land_IAU_state%hr1=Land_IAU_Control%iaufhrs(1) - Land_IAU_state%wt = 1.0 ! IAU increment filter weights (default 1.0) - Land_IAU_state%wt_normfact = 1.0 + ! allocate (Land_IAU_state%inc1%stc_inc(nlon, nlat, km)) + ! allocate (Land_IAU_state%inc1%slc_inc(nlon, nlat, km)) + ! allocate (Land_IAU_state%inc2%stc_inc(nlon, nlat, km)) + ! allocate (Land_IAU_state%inc2%slc_inc(nlon, nlat, km)) + + Land_IAU_Data%hr1=Land_IAU_Control%iaufhrs(1) + Land_IAU_Control%wt = 1.0 ! IAU increment filter weights (default 1.0) + Land_IAU_Control%wt_normfact = 1.0 if (Land_IAU_Control%iau_filter_increments) then ! compute increment filter weights, sum to obtain normalization factor dtp=Land_IAU_Control%dtp @@ -321,13 +331,15 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e normfact = normfact + wt if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'filter wts',k,kstep,wt enddo - Land_IAU_state%wt_normfact = (2*nstep+1)/normfact + Land_IAU_Control%wt_normfact = (2*nstep+1)/normfact endif ! increment files in fv3 tiles if (trim(Land_IAU_Control%iau_inc_files(1)) .eq. '' .or. Land_IAU_Control%iaufhrs(1) .lt. 0) then ! only 1 file expected - print*, "warning! in Land IAU but increment file name is empty or iaufhrs(1) is negative" - Land_IAU_Control%do_land_iau=.false. + print*, "Error! in Land IAU init: increment file name is empty or iaufhrs(1) is negative" + errmsg = "Error! in Land IAU init: increment file name is empty or iaufhrs(1) is negative" + errflg = 1 + ! Land_IAU_Control%do_land_iau=.false. return endif if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then @@ -365,41 +377,39 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e deallocate(idt) endif dt = (Land_IAU_Control%iau_delthrs*3600.) - rdt = 1.0/dt - Land_IAU_state%rdt = rdt - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval, rdt',Land_IAU_Control%iau_delthrs,Land_IAU_state%rdt + Land_IAU_Control%rdt = 1.0/dt !rdt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval, rdt',Land_IAU_Control%iau_delthrs,Land_IAU_Control%rdt ! Read all increment files at iau init time (at beginning of cycle) ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) - call read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) !, wk3_stc, wk3_slc + call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%stc_inc, Land_IAU_state%slc_inc, errmsg, errflg) !, wk3_stc, wk3_slc ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) ! increments already in the fv3 grid--no need for interpolation - do k = 1, npz ! do k = 1,n_soill ! - do j = 1, nlat - do i = 1, nlon - Land_IAU_state%inc1%stc_inc(i,j,k) = wk3_stc(1, i, j, k) - Land_IAU_state%inc1%slc_inc(i,j,k) = wk3_slc(1, i, j, k) - end do - enddo - enddo + ! do k = 1, npz ! do k = 1,n_soill ! + ! do j = 1, nlat + ! do i = 1, nlon + ! Land_IAU_state%inc1%stc_inc(i,j,k) = wk3_stc(1, i, j, k) + ! Land_IAU_state%inc1%slc_inc(i,j,k) = wk3_slc(1, i, j, k) + ! end do + ! enddo + ! enddo if (ntimes.EQ.1) then ! only need to get incrments once since constant forcing over window call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) endif - if (ntimes.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them - Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(2) - - ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(1, :, :) - - do k = 1, npz ! do k = 1,n_soill ! - do j = 1, nlat - do i = 1, nlon - Land_IAU_state%inc2%stc_inc(i,j,k) = wk3_stc(2, i, j, k) - Land_IAU_state%inc2%slc_inc(i,j,k) = wk3_slc(2, i, j, k) - end do - enddo - enddo + if (ntimes.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them + ! interpolation is now done in land_iau_mod_getiauforcing + Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(2) + ! ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(1, :, :) + ! do k = 1, npz ! do k = 1,n_soill ! + ! do j = 1, nlat + ! do i = 1, nlon + ! Land_IAU_state%inc2%stc_inc(i,j,k) = wk3_stc(2, i, j, k) + ! Land_IAU_state%inc2%slc_inc(i,j,k) = wk3_slc(2, i, j, k) + ! end do + ! enddo + ! enddo endif ! print*,'end of IAU init',dt,rdt @@ -419,19 +429,21 @@ subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_state errmsg = '' errflg = 0 - if (allocated (wk3_stc)) deallocate (wk3_stc) - if (allocated (wk3_slc)) deallocate (wk3_slc) - ! if (allocated (wk3_slmsk)) deallocate (wk3_slmsk) - if (allocated(Land_IAU_Data%stc_inc)) deallocate (Land_IAU_Data%stc_inc) if (allocated(Land_IAU_Data%slc_inc)) deallocate (Land_IAU_Data%slc_inc) ! if (allocated(Land_IAU_Data%snow_land_mask)) deallocate (Land_IAU_Data%snow_land_mask) - if (allocated(Land_IAU_state%inc1%stc_inc)) deallocate(Land_IAU_state%inc1%stc_inc) - if (allocated(Land_IAU_state%inc1%slc_inc)) deallocate(Land_IAU_state%inc1%slc_inc) + if (allocated(Land_IAU_state%stc_inc)) deallocate(Land_IAU_state%stc_inc) + if (allocated(Land_IAU_state%slc_inc)) deallocate(Land_IAU_state%slc_inc) + + ! if (allocated (wk3_stc)) deallocate (wk3_stc) + ! if (allocated (wk3_slc)) deallocate (wk3_slc) + ! ! if (allocated (wk3_slmsk)) deallocate (wk3_slmsk) - if (allocated(Land_IAU_state%inc2%stc_inc)) deallocate(Land_IAU_state%inc2%stc_inc) - if (allocated(Land_IAU_state%inc2%slc_inc)) deallocate(Land_IAU_state%inc2%slc_inc) + ! if (allocated(Land_IAU_state%inc1%stc_inc)) deallocate(Land_IAU_state%inc1%stc_inc) + ! if (allocated(Land_IAU_state%inc1%slc_inc)) deallocate(Land_IAU_state%inc1%slc_inc) + ! if (allocated(Land_IAU_state%inc2%stc_inc)) deallocate(Land_IAU_state%inc2%stc_inc + ! if (allocated(Land_IAU_state%inc2%slc_inc)) deallocate(Land_IAU_state%inc2%slc_inc) end subroutine land_iau_mod_finalize @@ -440,7 +452,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ implicit none type (land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data - type(land_iau_state_type), intent(inout) :: Land_IAU_state + type(land_iau_state_type), intent(in) :: Land_IAU_State character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg real(kind=kind_phys) t1,t2,sx,wx,wt,dtp @@ -455,6 +467,8 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ Land_IAU_Data%in_interval=.false. if (ntimes.LE.0) then + errmsg = 'in land_iau_mod_getiauforcing, but ntimes <=0, probably no increment data. Exiting.' + errflg = 0 return endif @@ -483,10 +497,10 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ else wt = 1. endif - Land_IAU_state%wt = Land_IAU_state%wt_normfact*wt - !if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'kstep,t1,t,t2,filter wt=',kstep,t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact + Land_IAU_Control%wt = Land_IAU_Control%wt_normfact*wt + !if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'kstep,t1,t,t2,filter wt=',kstep,t1,Land_IAU_Control%fhour,t2,Land_IAU_Control%wt/Land_IAU_Control%wt_normfact else - Land_IAU_state%wt = 0. + Land_IAU_Control%wt = 0. endif endif @@ -498,8 +512,10 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',t1,Land_IAU_Control%fhour,t2 Land_IAU_Data%in_interval=.false. else - if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact,Land_IAU_state%rdt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_Control%wt/Land_IAU_Control%wt_normfact,Land_IAU_Control%rdt + endif + if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) Land_IAU_Data%in_interval=.true. endif return @@ -513,7 +529,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',Land_IAU_Control%iaufhrs(1),Land_IAU_Control%fhour,Land_IAU_Control%iaufhrs(nfiles) Land_IAU_Data%in_interval=.false. else - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_state%wt/Land_IAU_state%wt_normfact,Land_IAU_state%rdt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_Control%wt/Land_IAU_Control%wt_normfact,Land_IAU_Control%rdt Land_IAU_Data%in_interval=.true. do k=ntimes, 1, -1 if (Land_IAU_Control%iaufhrs(k) > Land_IAU_Control%fhour) then @@ -521,9 +537,9 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ endif enddo ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'itnext=',itnext - if (Land_IAU_Control%fhour >= Land_IAU_state%hr2) then ! need to read in next increment file - Land_IAU_state%hr1=Land_IAU_state%hr2 - Land_IAU_state%hr2=Land_IAU_Control%iaufhrs(itnext) + if (Land_IAU_Control%fhour >= Land_IAU_Data%hr2) then ! need to read in next increment file + Land_IAU_Data%hr1=Land_IAU_Data%hr2 + Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(itnext) Land_IAU_state%inc1=Land_IAU_state%inc2 ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'reading next lnd iau increment file',trim(Land_IAU_Control%iau_inc_files(itnext)) @@ -557,14 +573,14 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) ntimes = Land_IAU_Control%ntimes - delt = (Land_IAU_state%hr2-(Land_IAU_Control%fhour))/(Land_IAU_state%hr2-Land_IAU_state%hr1) + delt = (Land_IAU_Data%hr2-(Land_IAU_Control%fhour))/(Land_IAU_Data%hr2-Land_IAU_Data%hr1) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ntimes ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes), & - " rdt wt delt_t ", Land_IAU_state%rdt, Land_IAU_state%wt, delt + " rdt wt delt_t ", Land_IAU_Control%rdt, Land_IAU_Control%wt, delt do j = js,je do i = is,ie do k = 1,npz ! do k = 1,n_soill ! - Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_state%inc1%stc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%stc_inc(i,j,k))*Land_IAU_state%rdt*Land_IAU_state%wt - Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_state%inc1%slc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%slc_inc(i,j,k))*Land_IAU_state%rdt*Land_IAU_state%wt + Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_state%inc1%stc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%stc_inc(i,j,k))*Land_IAU_Control%rdt*Land_IAU_Control%wt + Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_state%inc1%slc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%slc_inc(i,j,k))*Land_IAU_Control%rdt*Land_IAU_Control%wt end do enddo enddo @@ -575,7 +591,7 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) implicit none type(land_iau_control_type), intent(in ) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data - type(land_iau_state_type), intent(in ) :: Land_IAU_state + type(land_iau_state_type), intent(in ) :: Land_IAU_State real(kind=kind_phys) delt integer i, j, k integer :: is, ie, js, je, npz @@ -586,12 +602,12 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) je = js + Land_IAU_Control%ny-1 npz = Land_IAU_Control%lsoil ! this is only called if using 1 increment file - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau setiauforcing rdt = ',Land_IAU_state%rdt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau setiauforcing rdt = ',Land_IAU_Control%rdt do j = js, je do i = is, ie do k = 1, npz ! do k = 1,n_soill ! - Land_IAU_Data%stc_inc(i,j,k) = Land_IAU_state%wt*Land_IAU_state%inc1%stc_inc(i,j,k)*Land_IAU_state%rdt - Land_IAU_Data%slc_inc(i,j,k) = Land_IAU_state%wt*Land_IAU_state%inc1%slc_inc(i,j,k)*Land_IAU_state%rdt + Land_IAU_Data%stc_inc(i,j,k) = Land_IAU_Control%wt*Land_IAU_State%stc_inc(1,i,j,k)*Land_IAU_Control%rdt + Land_IAU_Data%slc_inc(i,j,k) = Land_IAU_Control%wt*Land_IAU_State%slc_inc(1,i,j,k)*Land_IAU_Control%rdt end do ! Land_IAU_Data%snow_land_mask(i, j) = wk3_slmsk(1, i, j) enddo @@ -599,9 +615,10 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) end subroutine setiauforcing -subroutine read_iau_forcing_fv3(Land_IAU_Control, errmsg, errflg) +subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errflg) - type (land_iau_control_type), intent(in) :: Land_IAU_Control + type (land_iau_control_type), intent(in) :: Land_IAU_Control + real(kind=kind_phys), allocatable, intent(out) :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg From 590bb8027eabaa30624c70f64e043a5c3d7311d4 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 16 Oct 2024 16:13:03 -0400 Subject: [PATCH 110/141] modify subroutines set/update increments --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 118 +++++++++--------- 1 file changed, 60 insertions(+), 58 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 0ff126c9c..67a4b3a92 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -467,7 +467,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ Land_IAU_Data%in_interval=.false. if (ntimes.LE.0) then - errmsg = 'in land_iau_mod_getiauforcing, but ntimes <=0, probably no increment data. Exiting.' + errmsg = 'in land_iau_mod_getiauforcing, but ntimes <=0, probably no increment files. Exiting.' errflg = 0 return endif @@ -515,8 +515,8 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_Control%wt/Land_IAU_Control%wt_normfact,Land_IAU_Control%rdt endif - if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) Land_IAU_Data%in_interval=.true. + if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) endif return endif @@ -529,42 +529,45 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',Land_IAU_Control%iaufhrs(1),Land_IAU_Control%fhour,Land_IAU_Control%iaufhrs(nfiles) Land_IAU_Data%in_interval=.false. else - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_Control%wt/Land_IAU_Control%wt_normfact,Land_IAU_Control%rdt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_Control%wt/Land_IAU_Control%wt_normfact,Land_IAU_Control%rdt + endif Land_IAU_Data%in_interval=.true. do k=ntimes, 1, -1 if (Land_IAU_Control%iaufhrs(k) > Land_IAU_Control%fhour) then itnext=k endif enddo -! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'itnext=',itnext + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'Land iau increments at times ', itnext-1, ' and ', itnext !trim(Land_IAU_Control%iau_inc_files(itnext)) + endif if (Land_IAU_Control%fhour >= Land_IAU_Data%hr2) then ! need to read in next increment file Land_IAU_Data%hr1=Land_IAU_Data%hr2 Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(itnext) - Land_IAU_state%inc1=Land_IAU_state%inc2 - - ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'reading next lnd iau increment file',trim(Land_IAU_Control%iau_inc_files(itnext)) - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'copying next lnd iau increment ', itnext !trim(Land_IAU_Control%iau_inc_files(itnext)) - Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) + ! Land_IAU_state%inc1=Land_IAU_state%inc2 + ! Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) + ! Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) endif ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(itnext-1, :, :) - call updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) + call updateiauforcing(itnext, Land_IAU_Control, Land_IAU_Data, Land_IAU_State) endif endif end subroutine land_iau_mod_getiauforcing -subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) +subroutine updateiauforcing(t2, Land_IAU_Control, Land_IAU_Data, Land_IAU_State) implicit none + integer, intent(in) :: t2 type (land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data - type(land_iau_state_type), intent(inout) :: Land_IAU_state + type(land_iau_state_type), intent(in) :: Land_IAU_State real(kind=kind_phys) delt integer i,j,k - integer :: is, ie, js, je, npz + integer :: is, ie, js, je, npz, t1 integer :: ntimes + t1 = t2 - 1 is = 1 !Land_IAU_Control%isc ie = is + Land_IAU_Control%nx-1 js = 1 !Land_IAU_Control%jsc @@ -579,8 +582,8 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) do j = js,je do i = is,ie do k = 1,npz ! do k = 1,n_soill ! - Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_state%inc1%stc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%stc_inc(i,j,k))*Land_IAU_Control%rdt*Land_IAU_Control%wt - Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_state%inc1%slc_inc(i,j,k) + (1.-delt)* Land_IAU_state%inc2%slc_inc(i,j,k))*Land_IAU_Control%rdt*Land_IAU_Control%wt + Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_State%stc_inc(t1,i,j,k) + (1.-delt)* Land_IAU_State%stc_inc(t2,i,j,k))*Land_IAU_Control%rdt*Land_IAU_Control%wt + Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_State%slc_inc(t1,i,j,k) + (1.-delt)* Land_IAU_State%slc_inc(t2,i,j,k))*Land_IAU_Control%rdt*Land_IAU_Control%wt end do enddo enddo @@ -738,46 +741,46 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errf end subroutine read_iau_forcing_fv3 !> Calculate soil mask for land on model grid. -!! Output is 1 - soil, 2 - snow-covered, 0 - land ice, -1 not land. -!! -!! @param[in] lensfc Number of land points for this tile -!! @param[in] veg_type_landice Value of vegetion class that indicates land-ice -!! @param[in] stype Soil type -!! @param[in] swe Model snow water equivalent -!! @param[in] vtype Model vegetation type -!! @param[out] mask Land mask for increments -!! @author Clara Draper @date March 2021 -!! @author Yuan Xue: introduce stype to make the mask calculation more generic -subroutine calculate_landinc_mask(swe,vtype,stype,lensfc,veg_type_landice, mask) - - implicit none + !! Output is 1 - soil, 2 - snow-covered, 0 - land ice, -1 not land. + !! + !! @param[in] lensfc Number of land points for this tile + !! @param[in] veg_type_landice Value of vegetion class that indicates land-ice + !! @param[in] stype Soil type + !! @param[in] swe Model snow water equivalent + !! @param[in] vtype Model vegetation type + !! @param[out] mask Land mask for increments + !! @author Clara Draper @date March 2021 + !! @author Yuan Xue: introduce stype to make the mask calculation more generic + subroutine calculate_landinc_mask(swe,vtype,stype,lensfc,veg_type_landice, mask) + + implicit none - integer, intent(in) :: lensfc, veg_type_landice - real, intent(in) :: swe(lensfc) - integer, intent(in) :: vtype(lensfc),stype(lensfc) - integer, intent(out) :: mask(lensfc) + integer, intent(in) :: lensfc, veg_type_landice + real, intent(in) :: swe(lensfc) + integer, intent(in) :: vtype(lensfc),stype(lensfc) + integer, intent(out) :: mask(lensfc) - integer :: i + integer :: i - mask = -1 ! not land + mask = -1 ! not land - ! land (but not land-ice) - do i=1,lensfc - if (stype(i) .GT. 0) then - if (swe(i) .GT. 0.001) then ! snow covered land - mask(i) = 2 - else ! non-snow covered land - mask(i) = 1 + ! land (but not land-ice) + do i=1,lensfc + if (stype(i) .GT. 0) then + if (swe(i) .GT. 0.001) then ! snow covered land + mask(i) = 2 + else ! non-snow covered land + mask(i) = 1 + endif + end if ! else should work here too + if ( vtype(i) == veg_type_landice ) then ! land-ice + mask(i) = 0 endif - end if ! else should work here too - if ( vtype(i) == veg_type_landice ) then ! land-ice - mask(i) = 0 - endif - end do + end do -end subroutine calculate_landinc_mask + end subroutine calculate_landinc_mask - SUBROUTINE NETCDF_ERR(ERR, STRING, errflg, errmsg_out) + subroutine netcdf_err(ERR, STRING, errflg, errmsg_out) !-------------------------------------------------------------- ! IF AT NETCDF CALL RETURNS AN ERROR, PRINT OUT A MESSAGE @@ -804,7 +807,7 @@ SUBROUTINE NETCDF_ERR(ERR, STRING, errflg, errmsg_out) errflg = 1 return - END SUBROUTINE NETCDF_ERR + end subroutine netcdf_err subroutine get_nc_dimlen(ncid, dim_name, dim_len, errflg, errmsg_out ) integer, intent(in):: ncid @@ -840,11 +843,11 @@ subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) errflg = 0 status = nf90_inq_varid(ncid, trim(var_name), varid) - CALL NETCDF_ERR(status, 'getting varid: '//trim(var_name), errflg, errmsg_out) + call netcdf_err(status, 'getting varid: '//trim(var_name), errflg, errmsg_out) if (errflg .ne. 0) return status = nf90_get_var(ncid, varid, var_arr) ! start = (/1/), count = (/dim_len/)) - CALL NETCDF_ERR(status, 'reading var: '//trim(var_name), errflg, errmsg_out) + call netcdf_err(status, 'reading var: '//trim(var_name), errflg, errmsg_out) end subroutine get_var1d @@ -853,15 +856,14 @@ subroutine get_var3d_values(ncid, varid, is,ix, js,jy, ks,kz, var3d, status) integer, intent(in):: is, ix, js, jy, ks,kz real(kind=kind_phys), intent(out):: var3d(ix, jy, kz) !var3d(is:ie,js:je,ks:ke) integer, intent(out):: status - ! integer, dimension(3):: start, nreco - ! start(1) = is; start(2) = js; start(3) = ks - ! nreco(1) = ie - is + 1 - ! nreco(2) = je - js + 1 - ! nreco(3) = ke - ks + 1 + ! integer :: errflg + ! character(len=*) :: errmsg_out status = nf90_get_var(ncid, varid, var3d, & !start = start, count = nreco) start = (/is, js, ks/), count = (/ix, jy, kz/)) - ! start = (/is, js, ks/), count = (/ie - is + 1, je - js + 1, ke - ks + 1/)) + + ! call netcdf_err(status, 'get_var3d_values', errflg, errmsg_out) + end subroutine get_var3d_values From e98f8d85a7112d975071ee3bddc9a33a3d074020 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 17 Oct 2024 08:00:26 -0400 Subject: [PATCH 111/141] default weight factors --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 67a4b3a92..65bed4d11 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -256,6 +256,10 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me ix = ix + blksz(nb) enddo + Land_IAU_Control%wt = 1.0 ! IAU increment filter weights (default 1.0) + Land_IAU_Control%wt_normfact = 1.0 + Land_IAU_Control%rdt = 0 ! 1/ dt + end subroutine land_iau_mod_set_control subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) From 89a1d0bf32f436dc0cfd415906f8ac9544864d2b Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 17 Oct 2024 08:37:50 -0400 Subject: [PATCH 112/141] move weight factors to _IAU_Data --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 57 +++++++++---------- 1 file changed, 27 insertions(+), 30 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 65bed4d11..c36013c73 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -51,8 +51,12 @@ module land_iau_mod real(kind=kind_phys),allocatable :: slc_inc(:,:,:) logical :: in_interval = .false. ! integer,allocatable :: snow_land_mask(:, :) ! Calculate snow soil mask at runtime from (dynamic) swe - real(kind=kind_phys) :: hr1 ! moved from _state_type - real(kind=kind_phys) :: hr2 + ! moved from land_iau_state_type + real(kind=kind_phys) :: hr1 + real(kind=kind_phys) :: hr2 + real(kind=kind_phys) :: wt + real(kind=kind_phys) :: wt_normfact + real(kind=kind_phys) :: rdt end type land_iau_external_data_type !!> \section arg_table_land_iau_state_type Argument Table @@ -64,9 +68,9 @@ module land_iau_mod ! type(land_iau_internal_data_type) :: inc2 real(kind=kind_phys),allocatable :: stc_inc(:,:,:,:) real(kind=kind_phys),allocatable :: slc_inc(:,:,:,:) - ! real(kind=kind_phys) :: hr1 ! moved to land_iau_external_data_type because they may vary with time + ! real(kind=kind_phys) :: hr1 ! moved to land_iau_external_data_type ! real(kind=kind_phys) :: hr2 - ! real(kind=kind_phys) :: wt ! moved to _control_type because they are constant + ! real(kind=kind_phys) :: wt ! real(kind=kind_phys) :: wt_normfact ! real(kind=kind_phys) :: rdt end type land_iau_state_type @@ -106,11 +110,6 @@ module land_iau_mod real(kind=kind_phys) :: fhour !< current forecast hour integer :: ntimes - - ! moved from land_iau_state_type because they are constant - real(kind=kind_phys) :: wt - real(kind=kind_phys) :: wt_normfact - real(kind=kind_phys) :: rdt end type land_iau_control_type @@ -256,10 +255,6 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me ix = ix + blksz(nb) enddo - Land_IAU_Control%wt = 1.0 ! IAU increment filter weights (default 1.0) - Land_IAU_Control%wt_normfact = 1.0 - Land_IAU_Control%rdt = 0 ! 1/ dt - end subroutine land_iau_mod_set_control subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) @@ -315,8 +310,8 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e ! allocate (Land_IAU_state%inc2%slc_inc(nlon, nlat, km)) Land_IAU_Data%hr1=Land_IAU_Control%iaufhrs(1) - Land_IAU_Control%wt = 1.0 ! IAU increment filter weights (default 1.0) - Land_IAU_Control%wt_normfact = 1.0 + Land_IAU_Data%wt = 1.0 ! IAU increment filter weights (default 1.0) + Land_IAU_Data%wt_normfact = 1.0 if (Land_IAU_Control%iau_filter_increments) then ! compute increment filter weights, sum to obtain normalization factor dtp=Land_IAU_Control%dtp @@ -335,7 +330,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e normfact = normfact + wt if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'filter wts',k,kstep,wt enddo - Land_IAU_Control%wt_normfact = (2*nstep+1)/normfact + Land_IAU_Data%wt_normfact = (2*nstep+1)/normfact endif ! increment files in fv3 tiles @@ -381,8 +376,8 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e deallocate(idt) endif dt = (Land_IAU_Control%iau_delthrs*3600.) - Land_IAU_Control%rdt = 1.0/dt !rdt - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval, rdt',Land_IAU_Control%iau_delthrs,Land_IAU_Control%rdt + Land_IAU_Data%rdt = 1.0/dt !rdt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval, rdt',Land_IAU_Control%iau_delthrs,Land_IAU_Data%rdt ! Read all increment files at iau init time (at beginning of cycle) ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) @@ -454,7 +449,7 @@ end subroutine land_iau_mod_finalize subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) implicit none - type (land_iau_control_type), intent(in) :: Land_IAU_Control + type(land_iau_control_type), intent(inout) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data type(land_iau_state_type), intent(in) :: Land_IAU_State character(len=*), intent(out) :: errmsg @@ -501,10 +496,10 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ else wt = 1. endif - Land_IAU_Control%wt = Land_IAU_Control%wt_normfact*wt - !if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'kstep,t1,t,t2,filter wt=',kstep,t1,Land_IAU_Control%fhour,t2,Land_IAU_Control%wt/Land_IAU_Control%wt_normfact + Land_IAU_Data%wt = Land_IAU_Data%wt_normfact*wt + !if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'kstep,t1,t,t2,filter wt=',kstep,t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact else - Land_IAU_Control%wt = 0. + Land_IAU_Data%wt = 0. endif endif @@ -517,7 +512,8 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ Land_IAU_Data%in_interval=.false. else if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_Control%wt/Land_IAU_Control%wt_normfact,Land_IAU_Control%rdt + print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ', & + t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact,Land_IAU_Data%rdt endif Land_IAU_Data%in_interval=.true. if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) @@ -534,7 +530,8 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ Land_IAU_Data%in_interval=.false. else if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ',t1,Land_IAU_Control%fhour,t2,Land_IAU_Control%wt/Land_IAU_Control%wt_normfact,Land_IAU_Control%rdt + print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ', & + t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact,Land_IAU_Data%rdt endif Land_IAU_Data%in_interval=.true. do k=ntimes, 1, -1 @@ -582,12 +579,12 @@ subroutine updateiauforcing(t2, Land_IAU_Control, Land_IAU_Data, Land_IAU_State) delt = (Land_IAU_Data%hr2-(Land_IAU_Control%fhour))/(Land_IAU_Data%hr2-Land_IAU_Data%hr1) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ntimes ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes), & - " rdt wt delt_t ", Land_IAU_Control%rdt, Land_IAU_Control%wt, delt + " rdt wt delt_t ", Land_IAU_Data%rdt, Land_IAU_Data%wt, delt do j = js,je do i = is,ie do k = 1,npz ! do k = 1,n_soill ! - Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_State%stc_inc(t1,i,j,k) + (1.-delt)* Land_IAU_State%stc_inc(t2,i,j,k))*Land_IAU_Control%rdt*Land_IAU_Control%wt - Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_State%slc_inc(t1,i,j,k) + (1.-delt)* Land_IAU_State%slc_inc(t2,i,j,k))*Land_IAU_Control%rdt*Land_IAU_Control%wt + Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_State%stc_inc(t1,i,j,k) + (1.-delt)* Land_IAU_State%stc_inc(t2,i,j,k))*Land_IAU_Data%rdt*Land_IAU_Data%wt + Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_State%slc_inc(t1,i,j,k) + (1.-delt)* Land_IAU_State%slc_inc(t2,i,j,k))*Land_IAU_Data%rdt*Land_IAU_Data%wt end do enddo enddo @@ -609,12 +606,12 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) je = js + Land_IAU_Control%ny-1 npz = Land_IAU_Control%lsoil ! this is only called if using 1 increment file - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau setiauforcing rdt = ',Land_IAU_Control%rdt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau setiauforcing rdt = ',Land_IAU_Data%rdt do j = js, je do i = is, ie do k = 1, npz ! do k = 1,n_soill ! - Land_IAU_Data%stc_inc(i,j,k) = Land_IAU_Control%wt*Land_IAU_State%stc_inc(1,i,j,k)*Land_IAU_Control%rdt - Land_IAU_Data%slc_inc(i,j,k) = Land_IAU_Control%wt*Land_IAU_State%slc_inc(1,i,j,k)*Land_IAU_Control%rdt + Land_IAU_Data%stc_inc(i,j,k) = Land_IAU_Data%wt*Land_IAU_State%stc_inc(1,i,j,k)*Land_IAU_Data%rdt + Land_IAU_Data%slc_inc(i,j,k) = Land_IAU_Data%wt*Land_IAU_State%slc_inc(1,i,j,k)*Land_IAU_Data%rdt end do ! Land_IAU_Data%snow_land_mask(i, j) = wk3_slmsk(1, i, j) enddo From fa3591e321a74110b01b9ec07fdf586f3ee82e97 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Thu, 17 Oct 2024 08:54:32 -0400 Subject: [PATCH 113/141] update noahmpdrv meta --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 19 +-- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 146 ++---------------- 2 files changed, 24 insertions(+), 141 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 497f81570..3060cc1ed 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -42,8 +42,8 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, & nlunit, pores, resid, & do_mynnsfclay,do_mynnedmf, & errmsg, errflg, & - Land_IAU_Control, Land_IAU_Data, Land_IAU_state) - ! , me, mpi_root, & + Land_IAU_Control, Land_IAU_Data, Land_IAU_state, & + me, mpi_root) ! fn_nml, input_nml_file, isc, jsc, ncols, nx, ny, tile_num, & ! nblks, blksz, xlon, xlat, & ! lsoil, lsnow_lsm, dtp, fhour) @@ -54,26 +54,27 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, & use noahmp_tables implicit none - + + integer, intent(in) :: me ! mpi_rank + integer, intent(in) :: mpi_root ! = GFS_Control%master integer, intent(in) :: lsm - integer, intent(in) :: lsm_noahmp + integer, intent(in) :: lsm_noahmp integer, intent(in) :: isot, ivegsrc, nlunit real (kind=kind_phys), dimension(:), intent(out) :: pores, resid logical, intent(in) :: do_mynnsfclay logical, intent(in) :: do_mynnedmf character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! land iau mod - + + ! land iau mod ! Land IAU Control holds settings' information, maily read from namelist (e.g., block of global domain that belongs to a process , ! whether to do IAU increment at this time step, time step informatoin, etc) type(land_iau_control_type), intent(inout) :: Land_IAU_Control ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data !(number of blocks):each proc holds nblks - type(land_iau_state_type), intent(inout) :: Land_IAU_state + type(land_iau_state_type), intent(inout) :: Land_IAU_state ! holds data read from file (before interpolation) + - ! integer, intent(in) :: me ! mpi_rank - ! integer, intent(in) :: mpi_root ! = GFS_Control%master ! character(*), intent(in) :: fn_nml ! character(len=:), pointer, intent(in), dimension(:) :: input_nml_file ! integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index a09f257fd..349d5bb4e 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -10,6 +10,20 @@ [ccpp-arg-table] name = noahmpdrv_init type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[mpi_root] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in [lsm] standard_name = control_for_land_surface_scheme long_name = flag for land surface model @@ -24,13 +38,6 @@ dimensions = () type = integer intent = in -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in [isot] standard_name = control_for_soil_type_dataset long_name = soil type dataset choice @@ -118,131 +125,6 @@ dimensions = () type = land_iau_state_type intent = inout -[mpi_root] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer - intent = in -[fn_nml] - standard_name = filename_of_namelist - long_name = namelist filename - units = none - type = character - dimensions = () - kind = len=* - intent = in -[input_nml_file] - standard_name = filename_of_internal_namelist - long_name = namelist filename for internal file reads - units = none - type = character - dimensions = (ccpp_constant_one:number_of_lines_in_internal_namelist) - kind = len=256 - intent = in -[isc] - standard_name = starting_x_index_for_this_mpi_rank - long_name = starting index in the x direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in -[jsc] - standard_name = starting_y_index_for_this_mpi_rank - long_name = starting index in the y direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in -[ncols] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nx] - standard_name = number_of_points_in_x_direction_for_this_mpi_rank - long_name = number of points in the x direction - units = count - dimensions = () - type = integer - intent = in -[ny] - standard_name = number_of_points_in_y_direction_for_this_mpi_rank - long_name = number of points in the y direction - units = count - dimensions = () - type = integer - intent = in -[tile_num] - standard_name = index_of_cubed_sphere_tile - long_name = tile number - units = none - dimensions = () - type = integer - intent = in -[nblks] - standard_name = ccpp_block_count - long_name = for explicit data blocking: number of blocks - units = count - dimensions = () - type = integer - intent = in -[blksz] - standard_name = ccpp_block_sizes - long_name = for explicit data blocking: block sizes of all blocks - units = count - dimensions = (ccpp_constant_one:ccpp_block_count) - type = integer - intent = in -[xlon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in -[xlat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in -[lsoil] - standard_name = vertical_dimension_of_soil - long_name = number of soil layers - units = count - dimensions = () - type = integer - intent = in -[lsnow_lsm] - standard_name = vertical_dimension_of_surface_snow - long_name = maximum number of snow layers for land surface model - units = count - dimensions = () - type = integer - intent = in -[dtp] - standard_name = timestep_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[fhour] - standard_name = forecast_time - long_name = current forecast time - units = h - dimensions = () - type = real - kind = kind_phys - intent = in ######################################################################## [ccpp-arg-table] From a9c44e65d5d342dbf8f04ce8b0b1b7dfc5bcb42d Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 20 Oct 2024 09:35:53 -0400 Subject: [PATCH 114/141] fix time interval bounds --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 37 +++++++++++-------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index c36013c73..5fa8235d6 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -508,14 +508,14 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ !8.8.24 TBCL: noahmpdrv_timestep_init doesn't get visited at t1, so include t2 ! if ( Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2 ) then if ( Land_IAU_Control%fhour <= t1 .or. Land_IAU_Control%fhour > t2 ) then -! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',t1,Land_IAU_Control%fhour,t2 + ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',t1,Land_IAU_Control%fhour,t2 Land_IAU_Data%in_interval=.false. else + Land_IAU_Data%in_interval=.true. if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ', & t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact,Land_IAU_Data%rdt - endif - Land_IAU_Data%in_interval=.true. + endif if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) endif return @@ -529,26 +529,28 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',Land_IAU_Control%iaufhrs(1),Land_IAU_Control%fhour,Land_IAU_Control%iaufhrs(nfiles) Land_IAU_Data%in_interval=.false. else + Land_IAU_Data%in_interval=.true. if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ', & t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact,Land_IAU_Data%rdt - endif - Land_IAU_Data%in_interval=.true. + endif do k=ntimes, 1, -1 - if (Land_IAU_Control%iaufhrs(k) > Land_IAU_Control%fhour) then + if (Land_IAU_Control%iaufhrs(k) >= Land_IAU_Control%fhour) then itnext=k endif enddo - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'Land iau increments at times ', itnext-1, ' and ', itnext !trim(Land_IAU_Control%iau_inc_files(itnext)) - endif - if (Land_IAU_Control%fhour >= Land_IAU_Data%hr2) then ! need to read in next increment file + + if (Land_IAU_Control%fhour > Land_IAU_Data%hr2) then ! need to read in next increment file Land_IAU_Data%hr1=Land_IAU_Data%hr2 Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(itnext) ! Land_IAU_state%inc1=Land_IAU_state%inc2 ! Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) ! Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) endif + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'Land iau increments at times ', itnext-1, ' and ', itnext, & + ' hr1, hr2 = ', Land_IAU_Data%hr1, Land_IAU_Data%hr2 + endif ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(itnext-1, :, :) call updateiauforcing(itnext, Land_IAU_Control, Land_IAU_Data, Land_IAU_State) endif @@ -563,7 +565,7 @@ subroutine updateiauforcing(t2, Land_IAU_Control, Land_IAU_Data, Land_IAU_State) type (land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data type(land_iau_state_type), intent(in) :: Land_IAU_State - real(kind=kind_phys) delt + real(kind=kind_phys) delt_t integer i,j,k integer :: is, ie, js, je, npz, t1 integer :: ntimes @@ -577,14 +579,17 @@ subroutine updateiauforcing(t2, Land_IAU_Control, Land_IAU_Data, Land_IAU_State) ntimes = Land_IAU_Control%ntimes - delt = (Land_IAU_Data%hr2-(Land_IAU_Control%fhour))/(Land_IAU_Data%hr2-Land_IAU_Data%hr1) - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau updateiauforcing ntimes ',ntimes,Land_IAU_Control%iaufhrs(1:ntimes), & - " rdt wt delt_t ", Land_IAU_Data%rdt, Land_IAU_Data%wt, delt + delt_t = (Land_IAU_Data%hr2-(Land_IAU_Control%fhour))/(Land_IAU_Data%hr2-Land_IAU_Data%hr1) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'in land_iau updateiauforcing ntimes ', & + ntimes,Land_IAU_Control%iaufhrs(1:ntimes), & + " rdt wt delt_t ", Land_IAU_Data%rdt, Land_IAU_Data%wt, delt_t + endif do j = js,je do i = is,ie do k = 1,npz ! do k = 1,n_soill ! - Land_IAU_Data%stc_inc(i,j,k) =(delt*Land_IAU_State%stc_inc(t1,i,j,k) + (1.-delt)* Land_IAU_State%stc_inc(t2,i,j,k))*Land_IAU_Data%rdt*Land_IAU_Data%wt - Land_IAU_Data%slc_inc(i,j,k) =(delt*Land_IAU_State%slc_inc(t1,i,j,k) + (1.-delt)* Land_IAU_State%slc_inc(t2,i,j,k))*Land_IAU_Data%rdt*Land_IAU_Data%wt + Land_IAU_Data%stc_inc(i,j,k) =(delt_t*Land_IAU_State%stc_inc(t1,i,j,k) + (1.-delt_t)* Land_IAU_State%stc_inc(t2,i,j,k))*Land_IAU_Data%rdt*Land_IAU_Data%wt + Land_IAU_Data%slc_inc(i,j,k) =(delt_t*Land_IAU_State%slc_inc(t1,i,j,k) + (1.-delt_t)* Land_IAU_State%slc_inc(t2,i,j,k))*Land_IAU_Data%rdt*Land_IAU_Data%wt end do enddo enddo From 28dc544001a6ee7650ac8fb262376fda567b94dd Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 20 Oct 2024 10:52:21 -0400 Subject: [PATCH 115/141] handle valid time range better --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 38 ++++++++++++------- 1 file changed, 24 insertions(+), 14 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 5fa8235d6..9a0c62dea 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -57,6 +57,8 @@ module land_iau_mod real(kind=kind_phys) :: wt real(kind=kind_phys) :: wt_normfact real(kind=kind_phys) :: rdt + ! track the increment steps here + integer :: itnext end type land_iau_external_data_type !!> \section arg_table_land_iau_state_type Argument Table @@ -359,6 +361,10 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau_init: ntimes = ',ntimes Land_IAU_Control%ntimes = ntimes if (ntimes < 1) then + print*, "Error! in Land IAU init: ntimes < 1" + errmsg = "Error! in Land IAU init: ntimes < 1" + errflg = 1 + ! Land_IAU_Control%do_land_iau=.false. return endif if (ntimes > 1) then @@ -396,10 +402,12 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e if (ntimes.EQ.1) then ! only need to get incrments once since constant forcing over window call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) + Land_IAU_Data%itnext = 0 endif if (ntimes.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them ! interpolation is now done in land_iau_mod_getiauforcing Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(2) + Land_IAU_Data%itnext = 2 ! ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(1, :, :) ! do k = 1, npz ! do k = 1,n_soill ! ! do j = 1, nlat @@ -455,7 +463,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg real(kind=kind_phys) t1,t2,sx,wx,wt,dtp - integer n,i,j,k,kstep,nstep,itnext + integer n,i,j,k,kstep,nstep !,itnext integer :: ntimes ! Initialize CCPP error handling variables @@ -522,7 +530,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ endif if (ntimes > 1) then - itnext=2 + !itnext=2 !Land_IAU_Data%itnext = 2 !8.8.24 TBCL: noahmpdrv_timestep_init doesn't get visited at t1, so include t2 ! if ( Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2 ) then if ( Land_IAU_Control%fhour <= t1 .or. Land_IAU_Control%fhour > t2 ) then @@ -534,34 +542,34 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ', & t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact,Land_IAU_Data%rdt endif - do k=ntimes, 1, -1 - if (Land_IAU_Control%iaufhrs(k) >= Land_IAU_Control%fhour) then - itnext=k - endif - enddo - + ! do k=ntimes, 1, -1 + ! if (Land_IAU_Control%iaufhrs(k) >= Land_IAU_Control%fhour) then + ! itnext=k + ! endif + ! enddo if (Land_IAU_Control%fhour > Land_IAU_Data%hr2) then ! need to read in next increment file + Land_IAU_Data%itnext = Land_IAU_Data%itnext + 1 Land_IAU_Data%hr1=Land_IAU_Data%hr2 - Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(itnext) + Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(Land_IAU_Data%itnext) ! Land_IAU_state%inc1=Land_IAU_state%inc2 ! Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) ! Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) endif if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'Land iau increments at times ', itnext-1, ' and ', itnext, & + print *,'Land iau increments at times ', Land_IAU_Data%itnext-1, ' and ', Land_IAU_Data%itnext, & ' hr1, hr2 = ', Land_IAU_Data%hr1, Land_IAU_Data%hr2 endif ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(itnext-1, :, :) - call updateiauforcing(itnext, Land_IAU_Control, Land_IAU_Data, Land_IAU_State) + call updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) endif endif end subroutine land_iau_mod_getiauforcing -subroutine updateiauforcing(t2, Land_IAU_Control, Land_IAU_Data, Land_IAU_State) +subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) implicit none - integer, intent(in) :: t2 + type (land_iau_control_type), intent(in) :: Land_IAU_Control type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data type(land_iau_state_type), intent(in) :: Land_IAU_State @@ -569,7 +577,9 @@ subroutine updateiauforcing(t2, Land_IAU_Control, Land_IAU_Data, Land_IAU_State) integer i,j,k integer :: is, ie, js, je, npz, t1 integer :: ntimes - + integer :: t2 + + t2 = Land_IAU_Data%itnext t1 = t2 - 1 is = 1 !Land_IAU_Control%isc ie = is + Land_IAU_Control%nx-1 From 7cac448ffb60ab00aaca991ce207ff84c38b3bac Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Sun, 20 Oct 2024 12:26:05 -0400 Subject: [PATCH 116/141] minor edit --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 3060cc1ed..a680fc885 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -252,7 +252,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & !> update land states with iau increments if (.not. Land_IAU_Data%in_interval) then if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "current time step not in IAU interval " + print*, "noahmpdrv_timestep_init: current time step not in Land iau interval " endif return endif From 2097bd01b25b8b03cbb47d94aeb309624df8c250 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 21 Oct 2024 10:44:02 -0400 Subject: [PATCH 117/141] do netcdf error handling inside get_var3d_values --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 48 ++++++++++++------- 1 file changed, 31 insertions(+), 17 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 9a0c62dea..7a87c8332 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -706,9 +706,9 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errf if (status == nf90_noerr) then !if (ierr == 0) then do it = 1, n_t ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) - call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, wk3_stc(it,:, :, i), status) - ! call get_var3d_values(ncid, varid, 1,im, jbeg,jend, it, 1, stc_inc_out(it,:, :, i), status) - call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg) + call get_var3d_values(ncid, varid, trim(stc_vars(i)), Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & + it, 1, wk3_stc(it,:, :, i), status, errflg, errmsg) + ! call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg) if (errflg .ne. 0) return enddo else @@ -722,9 +722,9 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errf status = nf90_inq_varid(ncid, trim(slc_vars(i)), varid) if (status == nf90_noerr) then !if (ierr == 0) then do it = 1, n_t - call get_var3d_values(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, it, 1, wk3_slc(it, :, :, i), status) - ! call get_var3d_values(ncid, varid, 1,im, jbeg,jend, it, 1, slc_inc_out(it, :, :, i), status) - call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg) + call get_var3d_values(ncid, varid, trim(slc_vars(i)), Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & + it, 1, wk3_slc(it, :, :, i), status, errflg, errmsg) + ! call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg) if (errflg .ne. 0) return end do else @@ -737,9 +737,9 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errf ! status = nf90_inq_varid(ncid, trim(slsn_mask), varid) ! if (status == nf90_noerr) then !if (ierr == 0) then ! do it = 1, n_t - ! call get_var3d_values_int(ncid, varid, Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & - ! it, 1, wk3_slmsk(it, :, :), status) - ! call netcdf_err(status, 'reading var: '//trim(slsn_mask), errflg, errmsg) + ! call get_var3d_values_int(ncid, varid, trim(slsn_mask), Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & + ! it, 1, wk3_slmsk(it, :, :), status, errflg, errmsg) + ! ! call netcdf_err(status, 'reading var: '//trim(slsn_mask), errflg, errmsg) ! if (errflg .ne. 0) return ! enddo ! else @@ -747,13 +747,13 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errf ! 'assuming value of 1 for all grid cells. Please make sure the increment files have soil snow mask var' ! wk3_slmsk(:, :, :) = 1 ! endif + + !8.3.24 set too small increments to zero + where(abs(wk3_stc) < Land_IAU_Control%min_T_increment) wk3_stc = 0.0 status =nf90_close(ncid) call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) - !8.3.24 set too small increments to zero - where(abs(wk3_stc) < Land_IAU_Control%min_T_increment) wk3_stc = 0.0 - end subroutine read_iau_forcing_fv3 !> Calculate soil mask for land on model grid. @@ -867,31 +867,45 @@ subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) end subroutine get_var1d - subroutine get_var3d_values(ncid, varid, is,ix, js,jy, ks,kz, var3d, status) + subroutine get_var3d_values(ncid, varid, var_name, is,ix, js,jy, ks,kz, var3d, status, errflg, errmsg_out) integer, intent(in):: ncid, varid integer, intent(in):: is, ix, js, jy, ks,kz + character(len=*), intent(in):: var_name real(kind=kind_phys), intent(out):: var3d(ix, jy, kz) !var3d(is:ie,js:je,ks:ke) integer, intent(out):: status - ! integer :: errflg - ! character(len=*) :: errmsg_out + integer :: errflg + character(len=*) :: errmsg_out + + !Errors messages handled through CCPP error handling variables + errmsg_out = '' + errflg = 0 status = nf90_get_var(ncid, varid, var3d, & !start = start, count = nreco) start = (/is, js, ks/), count = (/ix, jy, kz/)) - ! call netcdf_err(status, 'get_var3d_values', errflg, errmsg_out) + call netcdf_err(status, 'get_var3d_values '//trim(var_name), errflg, errmsg_out) end subroutine get_var3d_values - subroutine get_var3d_values_int(ncid, varid, is,ix, js,jy, ks,kz, var3d, status) + subroutine get_var3d_values_int(ncid, varid, var_name, is,ix, js,jy, ks,kz, var3d, status, errflg, errmsg_out) integer, intent(in):: ncid, varid integer, intent(in):: is, ix, js, jy, ks,kz + character(len=*), intent(in):: var_name integer, intent(out):: var3d(ix, jy, kz) !var3d(is:ie,js:je,ks:ke) integer, intent(out):: status + integer :: errflg + character(len=*) :: errmsg_out + + !Errors messages handled through CCPP error handling variables + errmsg_out = '' + errflg = 0 status = nf90_get_var(ncid, varid, var3d, & !start = start, count = nreco) start = (/is, js, ks/), count = (/ix, jy, kz/)) ! start = (/is, js, ks/), count = (/ie - is + 1, je - js + 1, ke - ks + 1/)) + + call netcdf_err(status, 'get_var3d_values_int '//trim(var_name), errflg, errmsg_out) end subroutine get_var3d_values_int From 403312a8b0e73bad455413beb01786a919e1e781 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 21 Oct 2024 10:50:56 -0400 Subject: [PATCH 118/141] error handling for read_iau_forcing_fv3 --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 7a87c8332..981d6dca1 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -389,6 +389,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%stc_inc, Land_IAU_state%slc_inc, errmsg, errflg) !, wk3_stc, wk3_slc ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) + if (errflg .ne. 0) return ! increments already in the fv3 grid--no need for interpolation ! do k = 1, npz ! do k = 1,n_soill ! From df8ed4821c2e6e0024a6820119243c4b529377bc Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 21 Oct 2024 13:52:15 -0400 Subject: [PATCH 119/141] remove redeclared constants in _timestep_int --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 26 +++++++++++-------- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 24 ++++++++++++++++- 2 files changed, 38 insertions(+), 12 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index a680fc885..846ceff57 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -160,7 +160,8 @@ end subroutine noahmpdrv_init subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & !me, mpi_root, isot, ivegsrc, soiltyp, vegtype, weasd, & land_iau_control, land_iau_data, land_iau_state, & - stc, slc, smc, errmsg, errflg) ! smc, t2mmp, q2mp, + stc, slc, smc, errmsg, errflg, & ! smc, t2mmp, q2mp, + con_g, con_t0c, con_hfus) use machine, only: kind_phys use namelist_soilveg @@ -189,9 +190,11 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + real(kind=kind_phys), intent(in) :: con_g ! grav + real(kind=kind_phys), intent(in) :: con_t0c ! tfreez + real(kind=kind_phys), intent(in) :: con_hfus ! hfus - ! IAU update - + ! IAU update real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat, slc_inc_flat real(kind=kind_phys), dimension(km) :: dz ! layer thickness ! real(kind=kind_phys) :: stc_bck(ncols, km), d_stc(ncols, km) @@ -215,9 +218,10 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! real (kind=kind_phys), dimension(max_soiltyp) :: maxsmc, bb, satpsi ! real, dimension(30) :: maxsmc, bb, satpsi - real(kind=kind_phys), parameter :: tfreez=273.16 !< con_t0c in physcons - real(kind=kind_phys), parameter :: hfus=0.3336e06 !< latent heat of fusion(j/kg) - real(kind=kind_phys), parameter :: grav=9.80616 !< gravity accel.(m/s2) + ! real(kind=kind_phys), parameter :: tfreez=273.16 !< con_t0c in physcons + ! real(kind=kind_phys), parameter :: hfus=0.3336e06 !< latent heat of fusion(j/kg) con_hfus + ! real(kind=kind_phys), parameter :: con_g !grav=9.80616 !< gravity accel.(m/s2) + real(kind=kind_phys) :: smp !< for computing supercooled water real(kind=kind_phys) :: hc_incr @@ -318,7 +322,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & soil_freeze=.false. soil_ice=.false. do k = 1, lsoil_incr ! k = 1, km - if ( stc(ij,k) < tfreez) soil_freeze=.true. + if ( stc(ij,k) < con_t0c) soil_freeze=.true. if ( smc(ij,k) - slc(ij,k) > 0.001 ) soil_ice=.true. if (Land_IAU_Control%upd_stc) then @@ -329,7 +333,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & endif endif - if ( (stc(ij,k) < tfreez) .and. (.not. soil_freeze) .and. (k==1) ) nfrozen_upd = nfrozen_upd + 1 + if ( (stc(ij,k) < con_t0c) .and. (.not. soil_freeze) .and. (k==1) ) nfrozen_upd = nfrozen_upd + 1 ! do not do updates if this layer or any above is frozen if ( (.not. soil_freeze ) .and. (.not. soil_ice ) ) then @@ -383,14 +387,14 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & !case 1: frz ==> frz, recalculate slc, smc remains !case 2: unfrz ==> frz, recalculate slc, smc remains !both cases are considered in the following if case - if (stc(i,l) .LT. tfreez )then + if (stc(i,l) .LT. con_t0c )then !recompute supercool liquid water,smc_anl remain unchanged - smp = hfus*(tfreez-stc(i,l))/(grav*stc(i,l)) !(m) + smp = con_hfus*(con_t0c-stc(i,l))/(con_g*stc(i,l)) !(m) slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) endif !case 3: frz ==> unfrz, melt all soil ice (if any) - if (stc(i,l) .GT. tfreez )then !do not rely on stc_bck + if (stc(i,l) .GT. con_t0c )then !do not rely on stc_bck slc(i,l)=smc(i,l) endif enddo diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 349d5bb4e..c6cce3f53 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -263,7 +263,29 @@ dimensions = () type = integer intent = out - +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + ####################################################################### [ccpp-arg-table] name = noahmpdrv_finalize From 4c78f46ad26345a9b8e6b0e7f7868c34ccb68c2a Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Mon, 21 Oct 2024 14:17:04 -0400 Subject: [PATCH 120/141] fix compilation errors --- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index c6cce3f53..256f47574 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -278,6 +278,7 @@ dimensions = () type = real kind = kind_phys + intent = in [con_hfus] standard_name = latent_heat_of_fusion_of_water_at_0C long_name = latent heat of fusion @@ -285,7 +286,8 @@ dimensions = () type = real kind = kind_phys - + intent = in + ####################################################################### [ccpp-arg-table] name = noahmpdrv_finalize From f25bf2db47247cb55f7d36ef8941c1059ef66009 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 29 Oct 2024 08:20:51 -0400 Subject: [PATCH 121/141] clean up, remove debug print outs --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 176 ++++-------------- 1 file changed, 37 insertions(+), 139 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 981d6dca1..4f51f2ac6 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -30,19 +30,6 @@ module land_iau_mod private - !GJF: These variables may need to get moved to the host model and passed in, depending on their use. - ! They are currently allocated/initialized in the CCPP init stage and are used throughout the - ! simulation in the timestep_init phase. Since this module memory exists on the heap, this - ! may cause issues for models that have multiple CCPP instances in one executable if the data - ! differs between CCPP instances. -! real(kind=kind_phys), allocatable :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) -! integer, allocatable :: wk3_slmsk(:, :, :) ! Calculate snow soil mask at runtime from (dynamic) swe - -! type land_iau_internal_data_type -! real(kind=kind_phys),allocatable :: stc_inc(:,:,:) -! real(kind=kind_phys),allocatable :: slc_inc(:,:,:) -! end type land_iau_internal_data_type - !> \section arg_table_land_iau_external_data_type Argument Table !! \htmlinclude land_iau_external_data_type.html !! @@ -64,17 +51,10 @@ module land_iau_mod !!> \section arg_table_land_iau_state_type Argument Table !! \htmlinclude land_iau_state_type.html !! - ! land_iau_state will hold inrements, read during land_iau_mod_init + ! land_iau_state will hold 'raw' (not interpolated) inrements, read during land_iau_mod_init type land_iau_state_type - ! type(land_iau_internal_data_type) :: inc1 - ! type(land_iau_internal_data_type) :: inc2 real(kind=kind_phys),allocatable :: stc_inc(:,:,:,:) real(kind=kind_phys),allocatable :: slc_inc(:,:,:,:) - ! real(kind=kind_phys) :: hr1 ! moved to land_iau_external_data_type - ! real(kind=kind_phys) :: hr2 - ! real(kind=kind_phys) :: wt - ! real(kind=kind_phys) :: wt_normfact - ! real(kind=kind_phys) :: rdt end type land_iau_state_type @@ -92,7 +72,6 @@ module land_iau_mod integer, allocatable :: blk_strt_indx(:) integer :: lsoil !< number of soil layers - ! this is the max dim (TBC: check it is consitent for noahmpdrv) integer :: lsnow_lsm !< maximum number of snow layers internal to land surface model logical :: do_land_iau real(kind=kind_phys) :: iau_delthrs ! iau time interval (to scale increments) in hours @@ -157,7 +136,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me logical :: land_iau_do_stcsmc_adjustment = .false. real(kind=kind_phys) :: land_iau_min_T_increment = 0.0001 - NAMELIST /land_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, & !land_iau_gaussian_inc_file, & + NAMELIST /land_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, & land_iau_filter_increments, & lsoil_incr, land_iau_upd_stc, land_iau_upd_slc, land_iau_do_stcsmc_adjustment, land_iau_min_T_increment @@ -173,21 +152,18 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me input_nml_file => input_nml_file_i read(input_nml_file, nml=land_iau_nml, ERR=888, END=999, iostat=ios) #else - ! if (file_exist(fn_nml)) then inquire (file=trim(fn_nml), exist=exists) ! TBCL: this maybe be replaced by nlunit passed from ccpp - if (.not. exists) then - write(6,*) 'lnd_iau_mod_set_control: namelist file ',trim(fn_nml),' does not exist' + if (.not. exists) then errmsg = 'lnd_iau_mod_set_control: namelist file '//trim(fn_nml)//' does not exist' errflg = 1 return else - Land_IAU_Control%fn_nml = trim(fn_nml) ! maynot need this + Land_IAU_Control%fn_nml = trim(fn_nml) open (unit=nlunit, file=trim(fn_nml), action='READ', status='OLD', iostat=ios, iomsg=ioerrmsg) rewind(nlunit) read (nlunit, nml=land_iau_nml, ERR=888, END=999, iostat=ios) close (nlunit) - if (ios /= 0) then - write(6,*) trim(ioerrmsg) + if (ios /= 0) then errmsg = 'lnd_iau_mod_set_control: error reading namelist file '//trim(fn_nml) & // 'the error message from file handler:' //trim(ioerrmsg) errflg = 1 @@ -197,10 +173,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me #endif 888 if (ios /= 0) then ! .and. ios /= iostat_end) then - write(iosstr, '(I0)') ios - if (me == mpi_root) then - write(6,*) 'lnd_iau_mod_set_control: I/O error code '//trim(iosstr)//' at land_iau namelist read' - endif + write(iosstr, '(I0)') ios errmsg = 'lnd_iau_mod_set_control: I/O error code '//trim(iosstr)//' at land_iau namelist read' errflg = 1 return @@ -248,8 +221,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me allocate(Land_IAU_Control%blk_strt_indx(nblks)) ! Land_IAU_Control%blk_strt_indx: start index of each block, for flattened (ncol=nx*ny) arrays - ! required in noahmpdriv_run to get subsection of the stc array for each - ! proces/thread + ! required in noahmpdriv_run to get subsection of the stc array for each proces/thread ix = 1 do nb=1, nblks Land_IAU_Control%blksz(nb) = blksz(nb) @@ -296,20 +268,11 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e je = js + Land_IAU_Control%ny-1 nlon = Land_IAU_Control%nx nlat = Land_IAU_Control%ny - !nblks = Land_IAU_Control%nblks - !blksz = Land_IAU_Control%blksz(1) - - print*, "rank is ie js je nlon nlat", Land_IAU_Control%me, is, ie, js, je, nlon, nlat ! allocate arrays that will hold iau state allocate(Land_IAU_Data%stc_inc(nlon, nlat, km)) allocate(Land_IAU_Data%slc_inc(nlon, nlat, km)) ! allocate(Land_IAU_Data%snow_land_mask(nlon, nlat)) - - ! allocate (Land_IAU_state%inc1%stc_inc(nlon, nlat, km)) - ! allocate (Land_IAU_state%inc1%slc_inc(nlon, nlat, km)) - ! allocate (Land_IAU_state%inc2%stc_inc(nlon, nlat, km)) - ! allocate (Land_IAU_state%inc2%slc_inc(nlon, nlat, km)) Land_IAU_Data%hr1=Land_IAU_Control%iaufhrs(1) Land_IAU_Data%wt = 1.0 ! IAU increment filter weights (default 1.0) @@ -335,20 +298,22 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e Land_IAU_Data%wt_normfact = (2*nstep+1)/normfact endif - ! increment files in fv3 tiles + ! increment files are in fv3 tiles if (trim(Land_IAU_Control%iau_inc_files(1)) .eq. '' .or. Land_IAU_Control%iaufhrs(1) .lt. 0) then ! only 1 file expected - print*, "Error! in Land IAU init: increment file name is empty or iaufhrs(1) is negative" errmsg = "Error! in Land IAU init: increment file name is empty or iaufhrs(1) is negative" errflg = 1 ! Land_IAU_Control%do_land_iau=.false. return endif if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,"land_iau_init: Increment file ", trim(adjustl(Land_IAU_Control%iau_inc_files(1))) + print*,"Land_iau_init: Increment file name: ", trim(adjustl(Land_IAU_Control%iau_inc_files(1))) endif ! determine number of valid forecast hours -!TODO: can read this from the increment file ("Time" dim) + ! is read from the increment file ("Time" dim) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *, " Number of forecast times (in hours) with valid increment values" + endif ntimesall = size(Land_IAU_Control%iaufhrs) ntimes = 0 do k=1,ntimesall @@ -358,10 +323,9 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e endif ntimes = ntimes + 1 enddo - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau_init: ntimes = ',ntimes + Land_IAU_Control%ntimes = ntimes if (ntimes < 1) then - print*, "Error! in Land IAU init: ntimes < 1" errmsg = "Error! in Land IAU init: ntimes < 1" errflg = 1 ! Land_IAU_Control%do_land_iau=.false. @@ -372,8 +336,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e idt = Land_IAU_Control%iaufhrs(2:ntimes)-Land_IAU_Control%iaufhrs(1:ntimes-1) do k=1,ntimes-1 if (idt(k) .ne. Land_IAU_Control%iaufhrs(2)-Land_IAU_Control%iaufhrs(1)) then - print *,'in land_iau_init: forecast intervals in iaufhrs must be constant' - ! call mpp_error (FATAL,' forecast intervals in iaufhrs must be constant') errmsg = 'Fatal error in land_iau_init. forecast intervals in iaufhrs must be constant' errflg = 1 return @@ -383,43 +345,24 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e endif dt = (Land_IAU_Control%iau_delthrs*3600.) Land_IAU_Data%rdt = 1.0/dt !rdt - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'land_iau interval, rdt',Land_IAU_Control%iau_delthrs,Land_IAU_Data%rdt - + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'Land_iau_init: IAU interval(dt), rdt (1/dt)',Land_IAU_Control%iau_delthrs,Land_IAU_Data%rdt + endif ! Read all increment files at iau init time (at beginning of cycle) - ! allocate (wk3_stc(n_t, 1:im,jbeg:jend, 1:km)) + ! increments are already in the fv3 grid--no need for interpolation call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%stc_inc, Land_IAU_state%slc_inc, errmsg, errflg) !, wk3_stc, wk3_slc - ! call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%inc1%stc_inc, Land_IAU_state%inc1%slc_inc, errmsg, errflg) if (errflg .ne. 0) return - - ! increments already in the fv3 grid--no need for interpolation - ! do k = 1, npz ! do k = 1,n_soill ! - ! do j = 1, nlat - ! do i = 1, nlon - ! Land_IAU_state%inc1%stc_inc(i,j,k) = wk3_stc(1, i, j, k) - ! Land_IAU_state%inc1%slc_inc(i,j,k) = wk3_slc(1, i, j, k) - ! end do - ! enddo - ! enddo if (ntimes.EQ.1) then ! only need to get incrments once since constant forcing over window call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) Land_IAU_Data%itnext = 0 endif - if (ntimes.GT.1) then !have multiple files, but only need 2 at a time and interpoalte for timesteps between them - ! interpolation is now done in land_iau_mod_getiauforcing + if (ntimes.GT.1) then !have increments at multiple forecast hours, + ! but only need 2 at a time and interpoalte for timesteps between them + ! interpolation is done in land_iau_mod_getiauforcing Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(2) Land_IAU_Data%itnext = 2 - ! ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(1, :, :) - ! do k = 1, npz ! do k = 1,n_soill ! - ! do j = 1, nlat - ! do i = 1, nlon - ! Land_IAU_state%inc2%stc_inc(i,j,k) = wk3_stc(2, i, j, k) - ! Land_IAU_state%inc2%slc_inc(i,j,k) = wk3_slc(2, i, j, k) - ! end do - ! enddo - ! enddo endif -! print*,'end of IAU init',dt,rdt end subroutine land_iau_mod_init @@ -444,15 +387,6 @@ subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_state if (allocated(Land_IAU_state%stc_inc)) deallocate(Land_IAU_state%stc_inc) if (allocated(Land_IAU_state%slc_inc)) deallocate(Land_IAU_state%slc_inc) - ! if (allocated (wk3_stc)) deallocate (wk3_stc) - ! if (allocated (wk3_slc)) deallocate (wk3_slc) - ! ! if (allocated (wk3_slmsk)) deallocate (wk3_slmsk) - - ! if (allocated(Land_IAU_state%inc1%stc_inc)) deallocate(Land_IAU_state%inc1%stc_inc) - ! if (allocated(Land_IAU_state%inc1%slc_inc)) deallocate(Land_IAU_state%inc1%slc_inc) - ! if (allocated(Land_IAU_state%inc2%stc_inc)) deallocate(Land_IAU_state%inc2%stc_inc - ! if (allocated(Land_IAU_state%inc2%slc_inc)) deallocate(Land_IAU_state%inc2%slc_inc) - end subroutine land_iau_mod_finalize subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) @@ -475,8 +409,8 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ Land_IAU_Data%in_interval=.false. if (ntimes.LE.0) then - errmsg = 'in land_iau_mod_getiauforcing, but ntimes <=0, probably no increment files. Exiting.' - errflg = 0 + errmsg = 'called land_iau_mod_getiauforcing, but ntimes <=0, probably there is no increment file. Exiting.' + errflg = 1 return endif @@ -489,10 +423,8 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ endif if (Land_IAU_Control%iau_filter_increments) then ! compute increment filter weight - ! t1 is beginning of window, t2 end of window - ! Land_IAU_Control%fhour current time - ! in window kstep=-nstep,nstep (2*nstep+1 total) - ! time step Land_IAU_Control%dtp + ! t1 is beginning of window, t2 end of window, and Land_IAU_Control%fhour is current time + ! in window kstep=-nstep,nstep (2*nstep+1 total) with time step of Land_IAU_Control%dtp dtp=Land_IAU_Control%dtp nstep = 0.5*Land_IAU_Control%iau_delthrs*3600/dtp ! compute normalized filter weight @@ -506,7 +438,6 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ wt = 1. endif Land_IAU_Data%wt = Land_IAU_Data%wt_normfact*wt - !if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'kstep,t1,t,t2,filter wt=',kstep,t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact else Land_IAU_Data%wt = 0. endif @@ -514,15 +445,14 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ if (ntimes.EQ.1) then ! check to see if we are in the IAU window, no need to update the states since they are fixed over the window -!8.8.24 TBCL: noahmpdrv_timestep_init doesn't get visited at t1, so include t2 +!TBCL: noahmpdrv_timestep_init doesn't get visited at t1 (when running from global workflow), so include t2? ! if ( Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2 ) then if ( Land_IAU_Control%fhour <= t1 .or. Land_IAU_Control%fhour > t2 ) then - ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',t1,Land_IAU_Control%fhour,t2 Land_IAU_Data%in_interval=.false. else Land_IAU_Data%in_interval=.true. if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ', & + print *,'land_iau_mod_getiauforcing: applying forcing at t for t1,t,t2,filter wt rdt ', & t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact,Land_IAU_Data%rdt endif if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) @@ -531,34 +461,23 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ endif if (ntimes > 1) then - !itnext=2 !Land_IAU_Data%itnext = 2 -!8.8.24 TBCL: noahmpdrv_timestep_init doesn't get visited at t1, so include t2 - ! if ( Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2 ) then if ( Land_IAU_Control%fhour <= t1 .or. Land_IAU_Control%fhour > t2 ) then -! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'no iau forcing',Land_IAU_Control%iaufhrs(1),Land_IAU_Control%fhour,Land_IAU_Control%iaufhrs(nfiles) Land_IAU_Data%in_interval=.false. else Land_IAU_Data%in_interval=.true. if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'apply lnd iau forcing t1,t,t2,filter wt rdt= ', & + print *,'land_iau_mod_getiauforcing: applying forcing at t for t1,t,t2,filter wt rdt ', & t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact,Land_IAU_Data%rdt - endif - ! do k=ntimes, 1, -1 - ! if (Land_IAU_Control%iaufhrs(k) >= Land_IAU_Control%fhour) then - ! itnext=k - ! endif - ! enddo + endif if (Land_IAU_Control%fhour > Land_IAU_Data%hr2) then ! need to read in next increment file Land_IAU_Data%itnext = Land_IAU_Data%itnext + 1 Land_IAU_Data%hr1=Land_IAU_Data%hr2 Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(Land_IAU_Data%itnext) - ! Land_IAU_state%inc1=Land_IAU_state%inc2 - ! Land_IAU_state%inc2%stc_inc(:, :, :) = wk3_stc(itnext, :, :, :) !Land_IAU_state%inc1%stc_inc(is:ie, js:je, km)) - ! Land_IAU_state%inc2%slc_inc(:, :, :) = wk3_slc(itnext, :, :, :) endif if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'Land iau increments at times ', Land_IAU_Data%itnext-1, ' and ', Land_IAU_Data%itnext, & - ' hr1, hr2 = ', Land_IAU_Data%hr1, Land_IAU_Data%hr2 + print *,'land_iau_mod_getiauforcing: Land iau increments interplated between time steps ', & + Land_IAU_Data%itnext-1, ' and ', Land_IAU_Data%itnext, & + ' times (hr1, hr2) ', Land_IAU_Data%hr1, Land_IAU_Data%hr2 endif ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(itnext-1, :, :) call updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) @@ -622,14 +541,13 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) je = js + Land_IAU_Control%ny-1 npz = Land_IAU_Control%lsoil ! this is only called if using 1 increment file - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'in land_iau setiauforcing rdt = ',Land_IAU_Data%rdt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) do j = js, je do i = is, ie do k = 1, npz ! do k = 1,n_soill ! Land_IAU_Data%stc_inc(i,j,k) = Land_IAU_Data%wt*Land_IAU_State%stc_inc(1,i,j,k)*Land_IAU_Data%rdt Land_IAU_Data%slc_inc(i,j,k) = Land_IAU_Data%wt*Land_IAU_State%slc_inc(1,i,j,k)*Land_IAU_Data%rdt end do - ! Land_IAU_Data%snow_land_mask(i, j) = wk3_slmsk(1, i, j) enddo enddo @@ -642,14 +560,13 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errf character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg - integer :: i, it, km !j, k, l, npz, + integer :: i, it, km logical :: exists integer :: ncid, status, varid integer :: ierr character(len=500) :: fname character(len=2) :: tile_str integer :: n_t, n_y, n_x - ! integer :: isc, jsc character(len=32), dimension(4) :: stc_vars = [character(len=32) :: 'soilt1_inc', 'soilt2_inc', 'soilt3_inc', 'soilt4_inc'] character(len=32), dimension(4) :: slc_vars = [character(len=32) :: 'slc1_inc', 'slc2_inc', 'slc3_inc', 'slc4_inc'] @@ -664,8 +581,6 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errf write(tile_str, '(I0)') Land_IAU_Control%tile_num fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1))//".tile"//trim(tile_str)//".nc" - ! isc = Land_IAU_Control%isc - ! jsc = Land_IAU_Control%jsc inquire (file=trim(fname), exist=exists) if (exists) then @@ -721,11 +636,10 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errf do i = 1, size(slc_vars) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(slc_vars(i)) status = nf90_inq_varid(ncid, trim(slc_vars(i)), varid) - if (status == nf90_noerr) then !if (ierr == 0) then + if (status == nf90_noerr) then !if (status == 0) do it = 1, n_t call get_var3d_values(ncid, varid, trim(slc_vars(i)), Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & it, 1, wk3_slc(it, :, :, i), status, errflg, errmsg) - ! call netcdf_err(status, 'reading var: '//trim(slc_vars(i)), errflg, errmsg) if (errflg .ne. 0) return end do else @@ -734,22 +648,8 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errf wk3_slc(:, :, :, i) = 0. endif enddo - ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(slsn_mask) - ! status = nf90_inq_varid(ncid, trim(slsn_mask), varid) - ! if (status == nf90_noerr) then !if (ierr == 0) then - ! do it = 1, n_t - ! call get_var3d_values_int(ncid, varid, trim(slsn_mask), Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & - ! it, 1, wk3_slmsk(it, :, :), status, errflg, errmsg) - ! ! call netcdf_err(status, 'reading var: '//trim(slsn_mask), errflg, errmsg) - ! if (errflg .ne. 0) return - ! enddo - ! else - ! if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, 'warning: no values for ',trim(slsn_mask), ' found', & - ! 'assuming value of 1 for all grid cells. Please make sure the increment files have soil snow mask var' - ! wk3_slmsk(:, :, :) = 1 - ! endif - !8.3.24 set too small increments to zero + !set too small increments to zero where(abs(wk3_stc) < Land_IAU_Control%min_T_increment) wk3_stc = 0.0 status =nf90_close(ncid) @@ -800,8 +700,7 @@ end subroutine calculate_landinc_mask subroutine netcdf_err(ERR, STRING, errflg, errmsg_out) !-------------------------------------------------------------- - ! IF AT NETCDF CALL RETURNS AN ERROR, PRINT OUT A MESSAGE - ! AND STOP PROCESSING. + ! Process the error flag from a NETCDF call and return it as (human readable) MESSAGE !-------------------------------------------------------------- IMPLICIT NONE @@ -819,7 +718,6 @@ subroutine netcdf_err(ERR, STRING, errflg, errmsg_out) IF (ERR == NF90_NOERR) RETURN ERRMSG = NF90_STRERROR(ERR) - PRINT*,'FATAL ERROR in Land IAU ', TRIM(STRING), ': ', TRIM(ERRMSG) errmsg_out = 'FATAL ERROR in Land IAU '//TRIM(STRING)//': '//TRIM(ERRMSG) errflg = 1 return From 941323bacb6104136cd750a0a07b896d65f5c83a Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Tue, 29 Oct 2024 11:05:42 -0400 Subject: [PATCH 122/141] restore if (cpllnd .and. cpllnd2atm) check --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 846ceff57..b0169401d 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -499,7 +499,7 @@ subroutine noahmpdrv_run & iopt_trs,iopt_diag,xlatin, xcoszin, iyrlen, julian, garea, & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, rhonewsn1,& con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - con_fvirt, con_rd, con_hfus, thsfc_loc, & + con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd,cpllnd2atm, & ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & @@ -673,6 +673,9 @@ subroutine noahmpdrv_run & logical , intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation + logical , intent(in) :: cpllnd ! Flag for land coupling (atm->lnd) + logical , intent(in) :: cpllnd2atm ! Flag for land coupling (lnd->atm) + real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! ground surface skin temperature [K] @@ -1033,7 +1036,7 @@ subroutine noahmpdrv_run & logical :: is_snowing ! used for penman calculation logical :: is_freeze_rain ! used for penman calculation integer :: i, k - + ! ! --- local derived constants: ! @@ -1050,6 +1053,11 @@ subroutine noahmpdrv_run & errmsg = '' errflg = 0 +! +! --- Just return if external land component is activated for two-way interaction +! + if (cpllnd .and. cpllnd2atm) return + do i = 1, im if (flag_iter(i) .and. dry(i)) then From 753676c660d86443c9a9a4043e192ca88f324ea5 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 29 Oct 2024 11:09:54 -0400 Subject: [PATCH 123/141] clean noahmpdrv --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 22 +++--- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 68 ++++--------------- 2 files changed, 26 insertions(+), 64 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 4f51f2ac6..d9c5b7e92 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -68,24 +68,24 @@ module land_iau_mod integer :: ny integer :: tile_num integer :: nblks - integer, allocatable :: blksz(:) ! this could vary for the last block + integer, allocatable :: blksz(:) ! this could vary for the last block integer, allocatable :: blk_strt_indx(:) - integer :: lsoil !< number of soil layers + integer :: lsoil !< number of soil layers integer :: lsnow_lsm !< maximum number of snow layers internal to land surface model logical :: do_land_iau real(kind=kind_phys) :: iau_delthrs ! iau time interval (to scale increments) in hours - character(len=240) :: iau_inc_files(7)! list of increment files + character(len=240) :: iau_inc_files(7) ! list of increment files real(kind=kind_phys) :: iaufhrs(7) ! forecast hours associated with increment files logical :: iau_filter_increments - integer :: lsoil_incr ! soil layers (from top) updated by DA + integer :: lsoil_incr ! soil layers (from top) updated by DA logical :: upd_stc logical :: upd_slc logical :: do_stcsmc_adjustment !do moisture/temperature adjustment for consistency after increment add real(kind=kind_phys) :: min_T_increment integer :: me !< MPI rank designator - integer :: mpi_root !< MPI rank of master atmosphere processor + integer :: mpi_root !< MPI rank of master atmosphere processor character(len=64) :: fn_nml !< namelist filename for surface data cycling real(kind=kind_phys) :: dtp !< physics timestep in seconds real(kind=kind_phys) :: fhour !< current forecast hour @@ -101,16 +101,16 @@ module land_iau_mod subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me, mpi_root, & isc, jsc, nx, ny, tile_num, nblks, blksz, & - lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) !nlunit + lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) type (land_iau_control_type), intent(inout) :: Land_IAU_Control - character(*), intent(in) :: fn_nml !< namelist filename for surface data cycling + character(*), intent(in) :: fn_nml !< namelist filename for surface data cycling character(len=:), intent(in), dimension(:), pointer :: input_nml_file_i integer, intent(in) :: me, mpi_root !< MPI rank of master atmosphere processor integer, intent(in) :: isc, jsc, nx, ny, tile_num, nblks, lsoil, lsnow_lsm - integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz - real(kind=kind_phys), intent(in) :: dtp !< physics timestep in seconds - real(kind=kind_phys), intent(in) :: fhour !< current forecast hour + integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz + real(kind=kind_phys), intent(in) :: dtp !< physics timestep in seconds + real(kind=kind_phys), intent(in) :: fhour !< current forecast hour character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -127,7 +127,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me logical :: do_land_iau = .false. real(kind=kind_phys) :: land_iau_delthrs = 0 !< iau time interval (to scale increments) character(len=240) :: land_iau_inc_files(7) = '' !< list of increment files - real(kind=kind_phys) :: land_iau_fhrs(7) = -1 !< forecast hours associated with increment files + real(kind=kind_phys) :: land_iau_fhrs(7) = -1 !< forecast hours associated with increment files logical :: land_iau_filter_increments = .false. !< filter IAU increments integer :: lsoil_incr = 4 diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 846ceff57..42297d334 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -13,7 +13,7 @@ module noahmpdrv use module_sf_noahmplsm - ! Land IAU increments for soil temperature (can also do soil moisture increments if needed) + ! Land IAU increments for soil temperature (plan to extend to soil moisture increments) use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & land_iau_state_type @@ -44,9 +44,6 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, & errmsg, errflg, & Land_IAU_Control, Land_IAU_Data, Land_IAU_state, & me, mpi_root) - ! fn_nml, input_nml_file, isc, jsc, ncols, nx, ny, tile_num, & - ! nblks, blksz, xlon, xlat, & - ! lsoil, lsnow_lsm, dtp, fhour) use machine, only: kind_phys use set_soilveg_mod, only: set_soilveg @@ -66,26 +63,16 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! land iau mod - ! Land IAU Control holds settings' information, maily read from namelist (e.g., block of global domain that belongs to a process , + ! land iau mod DDTs + ! Land IAU Control holds settings' information, maily read from namelist + ! (e.g., block of global domain that belongs to current process, ! whether to do IAU increment at this time step, time step informatoin, etc) type(land_iau_control_type), intent(inout) :: Land_IAU_Control - ! Land IAU Data holds spatially and temporally interpolated soil temperature increments per time step - type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data !(number of blocks):each proc holds nblks - type(land_iau_state_type), intent(inout) :: Land_IAU_state ! holds data read from file (before interpolation) - - - ! character(*), intent(in) :: fn_nml - ! character(len=:), pointer, intent(in), dimension(:) :: input_nml_file - ! integer, intent(in) :: isc, jsc, ncols, nx, ny, nblks !=GFS_Control%ncols, %nx, %ny, nblks - ! integer, intent(in) :: tile_num !GFS_control_type%tile_num - ! integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz - ! real(kind_phys), dimension(:), intent(in) :: xlon ! longitude !GFS_Data(cdata%blk_no)%Grid%xlon - ! real(kind_phys), dimension(:), intent(in) :: xlat ! latitude - - ! integer, intent(in) :: lsoil, lsnow_lsm - ! real(kind=kind_phys), intent(in) :: dtp, fhour - + ! land iau state holds increment data read from file (before interpolation) + type(land_iau_state_type), intent(inout) :: Land_IAU_state + ! Land IAU Data holds spatially and temporally interpolated increments per time step + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data ! arry of (number of blocks):each proc holds nblks + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -125,7 +112,6 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, & call read_mp_table_parameters(errmsg, errflg) ! initialize psih and psim - if ( do_mynnsfclay ) then call psi_init(psi_opt,errmsg,errflg) endif @@ -133,34 +119,22 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, & pores (:) = maxsmc (:) resid (:) = drysmc (:) - ! ! Read Land IAU settings - ! call land_iau_mod_set_control(Land_IAU_Control, fn_nml, input_nml_file, & - ! me, mpi_root, isc,jsc, nx, ny, tile_num, nblks, blksz, & - ! lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) - ! Initialize IAU for land + ! Initialize IAU for land--land_iau_control was set by host model if (.not. Land_IAU_Control%do_land_iau) return - call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) ! xlon, xlat, errmsg, errflg) + call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) end subroutine noahmpdrv_init !> \ingroup NoahMP_LSM !! \brief This subroutine is called before noahmpdrv_run -!! to update states with iau increments, if available--- +!! to update states with iau increments, if available !! \section arg_table_noahmpdrv_timestep_init Argument Table !! \htmlinclude noahmpdrv_timestep_init.html !! -!! For Noah-MP, the adjustment scheme shown below is applied to soil moisture and temp: -!! Case 1: frozen ==> frozen, recalculate slc following opt_frz=1, smc remains -!! Case 2: unfrozen ==> frozen, recalculate slc following opt_frz=1, smc remains -!! Case 3: frozen ==> unfrozen, melt all soil ice (if any) -!! Case 4: unfrozen ==> unfrozen along with other cases, (e.g., soil temp=tfrz),do nothing -!! Note: For Case 3, Yuan Xue thoroughly evaluated a total of four options and -!! current option is found to be the best as of 11/09/2023 - -subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & !me, mpi_root, +subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & isot, ivegsrc, soiltyp, vegtype, weasd, & land_iau_control, land_iau_data, land_iau_state, & - stc, slc, smc, errmsg, errflg, & ! smc, t2mmp, q2mp, + stc, slc, smc, errmsg, errflg, & con_g, con_t0c, con_hfus) use machine, only: kind_phys @@ -197,33 +171,21 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & ! IAU update real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat, slc_inc_flat real(kind=kind_phys), dimension(km) :: dz ! layer thickness - ! real(kind=kind_phys) :: stc_bck(ncols, km), d_stc(ncols, km) - ! integer, allocatable, dimension(:) :: diff_indices -!TODO: 7.31.24: This is hard-coded in noahmpdrv +!TODO: This is hard-coded in noahmpdrv real(kind=kind_phys) :: zsoil(4) = (/ -0.1, -0.4, -1.0, -2.0 /) !zsoil(km) integer :: lsoil_incr - ! integer :: veg_type_landice - integer, allocatable :: mask_tile(:) integer,allocatable :: stc_updated(:), slc_updated(:) logical :: soil_freeze, soil_ice - ! integer :: n_freeze, n_thaw integer :: soiltype, n_stc, n_slc real(kind=kind_phys) :: slc_new integer :: i, j, ij, l, k, ib integer :: lensfc - - ! real (kind=kind_phys), dimension(max_soiltyp) :: maxsmc, bb, satpsi - ! real, dimension(30) :: maxsmc, bb, satpsi - ! real(kind=kind_phys), parameter :: tfreez=273.16 !< con_t0c in physcons - ! real(kind=kind_phys), parameter :: hfus=0.3336e06 !< latent heat of fusion(j/kg) con_hfus - ! real(kind=kind_phys), parameter :: con_g !grav=9.80616 !< gravity accel.(m/s2) real(kind=kind_phys) :: smp !< for computing supercooled water - real(kind=kind_phys) :: hc_incr integer :: nother, nsnowupd From ee1b463f2327fd0e5c9917819f93d19589aabf70 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Tue, 29 Oct 2024 12:04:56 -0400 Subject: [PATCH 124/141] remove debug prints --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 12 +++++------ physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 21 ++++++------------- 2 files changed, 12 insertions(+), 21 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index d9c5b7e92..2d79863c4 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -293,7 +293,9 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e wt = 1.0 endif normfact = normfact + wt - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,'filter wts',k,kstep,wt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'Land IAU init: IAU filter weights params k, kstep, wt ',k, kstep, wt + endif enddo Land_IAU_Data%wt_normfact = (2*nstep+1)/normfact endif @@ -302,7 +304,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e if (trim(Land_IAU_Control%iau_inc_files(1)) .eq. '' .or. Land_IAU_Control%iaufhrs(1) .lt. 0) then ! only 1 file expected errmsg = "Error! in Land IAU init: increment file name is empty or iaufhrs(1) is negative" errflg = 1 - ! Land_IAU_Control%do_land_iau=.false. return endif if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then @@ -312,7 +313,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e ! determine number of valid forecast hours ! is read from the increment file ("Time" dim) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *, " Number of forecast times (in hours) with valid increment values" + print *, "Land_iau_init: timesetps and forecast times (in hours) with valid increment values" endif ntimesall = size(Land_IAU_Control%iaufhrs) ntimes = 0 @@ -326,9 +327,8 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e Land_IAU_Control%ntimes = ntimes if (ntimes < 1) then - errmsg = "Error! in Land IAU init: ntimes < 1" + errmsg = "Error! in Land IAU init: ntimes < 1 (no valid hour with increments); do_land_iau should not be .true." errflg = 1 - ! Land_IAU_Control%do_land_iau=.false. return endif if (ntimes > 1) then @@ -350,7 +350,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e endif ! Read all increment files at iau init time (at beginning of cycle) ! increments are already in the fv3 grid--no need for interpolation - call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%stc_inc, Land_IAU_state%slc_inc, errmsg, errflg) !, wk3_stc, wk3_slc + call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%stc_inc, Land_IAU_state%slc_inc, errmsg, errflg) if (errflg .ne. 0) return if (ntimes.EQ.1) then ! only need to get incrments once since constant forcing over window diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 680be4df4..1b63ed22a 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -323,22 +323,14 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) -! (consistency) adjustments for updated soil temp and moisture - - ! call set_soilveg_noahmp(isot, ivegsrc, maxsmc, bb, satpsi, errflg) - call read_mp_table_parameters(errmsg, errflg) - ! maxsmc(1:slcats) = smcmax_table(1:slcats) - ! bb(1:slcats) = bexp_table(1:slcats) - ! satpsi(1:slcats) = psisat_table(1:slcats) + !!do moisture/temperature adjustment for consistency after increment add + call read_mp_table_parameters(errmsg, errflg) if (errflg .ne. 0) then - print *, 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' return endif - n_stc = 0 - n_slc = 0 - !!do moisture/temperature adjustment for consistency after increment add + n_slc = 0 if (Land_IAU_Control%do_stcsmc_adjustment) then if (Land_IAU_Control%upd_stc) then do i=1,lensfc @@ -369,7 +361,6 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & do l = 2, km dz(l) = -zsoil(l) + zsoil(l-1) enddo - ! print *, 'Applying soil moisture mins ' do i=1,lensfc if (slc_updated(i) == 1 ) then n_slc = n_slc+1 @@ -389,7 +380,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & deallocate(mask_tile) - write(*,'(a,i2)') ' statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me + write(*,'(a,i2)') ' noahmpdrv_timestep_init: statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me write(*,'(a,i8)') ' soil grid total', lensfc write(*,'(a,i8)') ' soil grid cells stc updated = ',nstcupd write(*,'(a,i8)') ' soil grid cells slc updated = ',nslcupd @@ -409,7 +400,7 @@ end subroutine noahmpdrv_timestep_init !! \section arg_table_noahmpdrv_finalize Argument Table !! \htmlinclude noahmpdrv_finalize.html !! - subroutine noahmpdrv_finalize (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) ! smc, t2mmp, q2mp, + subroutine noahmpdrv_finalize (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) use machine, only: kind_phys implicit none @@ -461,7 +452,7 @@ subroutine noahmpdrv_run & iopt_trs,iopt_diag,xlatin, xcoszin, iyrlen, julian, garea, & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, rhonewsn1,& con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd,cpllnd2atm, & + con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd, cpllnd2atm, & ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & From 84cddc3b621d37ebfc275b11cf0bcbc530f02690 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 30 Oct 2024 07:52:50 -0400 Subject: [PATCH 125/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 1b63ed22a..aa2f45cd0 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -9,7 +9,7 @@ !! as diagnotics calculation. !> This module contains the CCPP-compliant NoahMP land surface model driver. - module noahmpdrv + module noahmpdrv use module_sf_noahmplsm From e428689032a47fc1bb14456096643798590f5411 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 30 Oct 2024 07:54:20 -0400 Subject: [PATCH 126/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index aa2f45cd0..501104b98 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -9,9 +9,9 @@ !! as diagnotics calculation. !> This module contains the CCPP-compliant NoahMP land surface model driver. - module noahmpdrv + module noahmpdrv - use module_sf_noahmplsm + use module_sf_noahmplsm ! Land IAU increments for soil temperature (plan to extend to soil moisture increments) use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & From cd03ce70990877b78dab90fadb6fa8e570a06102 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 30 Oct 2024 07:55:12 -0400 Subject: [PATCH 127/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 501104b98..1779da50e 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -9,9 +9,9 @@ !! as diagnotics calculation. !> This module contains the CCPP-compliant NoahMP land surface model driver. - module noahmpdrv + module noahmpdrv - use module_sf_noahmplsm + use module_sf_noahmplsm ! Land IAU increments for soil temperature (plan to extend to soil moisture increments) use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & From 1442fdb31bb573e803183bac5c94fb49461464f6 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 30 Oct 2024 07:55:52 -0400 Subject: [PATCH 128/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 1779da50e..07c7cff49 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -9,9 +9,9 @@ !! as diagnotics calculation. !> This module contains the CCPP-compliant NoahMP land surface model driver. - module noahmpdrv + module noahmpdrv - use module_sf_noahmplsm + use module_sf_noahmplsm ! Land IAU increments for soil temperature (plan to extend to soil moisture increments) use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & From 9b88ec3bfec0357d4cc42b2665f4b593cc57adb2 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 30 Oct 2024 07:57:43 -0400 Subject: [PATCH 129/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 07c7cff49..52d0f0bcc 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -13,16 +13,16 @@ module noahmpdrv use module_sf_noahmplsm - ! Land IAU increments for soil temperature (plan to extend to soil moisture increments) - use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & +! Land IAU increments for soil temperature (plan to extend to soil moisture increments) + use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & land_iau_state_type - use land_iau_mod, only: land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, & + use land_iau_mod, only: land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, & calculate_landinc_mask ! land_iau_mod_set_control, - implicit none + implicit none - integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS + integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS private From 3672889b93ff57a1b5adcaaeac4e115be9d14f48 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 30 Oct 2024 07:58:51 -0400 Subject: [PATCH 130/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 52d0f0bcc..a6b9bf41e 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -24,12 +24,12 @@ module noahmpdrv integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS - private + private - public :: noahmpdrv_init, noahmpdrv_run, & + public :: noahmpdrv_init, noahmpdrv_run, & noahmpdrv_timestep_init, noahmpdrv_finalize - contains + contains !> \ingroup NoahMP_LSM !! \brief This subroutine is called during the CCPP initialization phase and calls set_soilveg() to From a61f437b8b0f3d471fc5087c335c4592f2a4e454 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 30 Oct 2024 08:00:36 -0400 Subject: [PATCH 131/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index a6b9bf41e..916cae943 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -37,13 +37,11 @@ module noahmpdrv !! \section arg_table_noahmpdrv_init Argument Table !! \htmlinclude noahmpdrv_init.html !! - subroutine noahmpdrv_init(lsm, lsm_noahmp, & - isot, ivegsrc, & + subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & nlunit, pores, resid, & do_mynnsfclay,do_mynnedmf, & errmsg, errflg, & - Land_IAU_Control, Land_IAU_Data, Land_IAU_state, & - me, mpi_root) + Land_IAU_Control, Land_IAU_Data, Land_IAU_state) use machine, only: kind_phys use set_soilveg_mod, only: set_soilveg From 71ab42571bfa284db03d65e886c9612aef6b1ea7 Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 30 Oct 2024 08:14:45 -0400 Subject: [PATCH 132/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 916cae943..59bcf4eb6 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -38,9 +38,9 @@ module noahmpdrv !! \htmlinclude noahmpdrv_init.html !! subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & - nlunit, pores, resid, & - do_mynnsfclay,do_mynnedmf, & - errmsg, errflg, & + nlunit, pores, resid, & + do_mynnsfclay,do_mynnedmf, & + errmsg, errflg, & Land_IAU_Control, Land_IAU_Data, Land_IAU_state) use machine, only: kind_phys From ec2a299098d90ee39c308b4cd7907a41a308bd7c Mon Sep 17 00:00:00 2001 From: "Tseganeh Z. Gichamo" Date: Wed, 30 Oct 2024 08:42:06 -0400 Subject: [PATCH 133/141] Update noahmpdrv.F90 --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 59bcf4eb6..916cae943 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -38,9 +38,9 @@ module noahmpdrv !! \htmlinclude noahmpdrv_init.html !! subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & - nlunit, pores, resid, & - do_mynnsfclay,do_mynnedmf, & - errmsg, errflg, & + nlunit, pores, resid, & + do_mynnsfclay,do_mynnedmf, & + errmsg, errflg, & Land_IAU_Control, Land_IAU_Data, Land_IAU_state) use machine, only: kind_phys From 1391585123d573834b0b7c0c2e5a0cafcb1ad955 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 30 Oct 2024 11:42:33 -0400 Subject: [PATCH 134/141] change DDTs in noahmpdrv_init to optional --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 157 ++++++----- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 260 ++---------------- 2 files changed, 102 insertions(+), 315 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 916cae943..ec3c2d5c3 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -12,14 +12,13 @@ module noahmpdrv use module_sf_noahmplsm - + ! Land IAU increments for soil temperature (plan to extend to soil moisture increments) use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & land_iau_state_type use land_iau_mod, only: land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, & calculate_landinc_mask ! land_iau_mod_set_control, - implicit none integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS @@ -27,7 +26,7 @@ module noahmpdrv private public :: noahmpdrv_init, noahmpdrv_run, & - noahmpdrv_timestep_init, noahmpdrv_finalize + noahmpdrv_timestep_init, noahmpdrv_finalize contains @@ -38,90 +37,96 @@ module noahmpdrv !! \htmlinclude noahmpdrv_init.html !! subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & - nlunit, pores, resid, & - do_mynnsfclay,do_mynnedmf, & - errmsg, errflg, & + nlunit, pores, resid, & + do_mynnsfclay,do_mynnedmf, & + errmsg, errflg, & Land_IAU_Control, Land_IAU_Data, Land_IAU_state) - use machine, only: kind_phys - use set_soilveg_mod, only: set_soilveg - use namelist_soilveg - use noahmp_tables + use machine, only: kind_phys + use set_soilveg_mod, only: set_soilveg + use namelist_soilveg + use noahmp_tables + + implicit none + integer, intent(in) :: lsm + integer, intent(in) :: lsm_noahmp + integer, intent(in) :: me, isot, ivegsrc, nlunit - implicit none - - integer, intent(in) :: me ! mpi_rank - integer, intent(in) :: mpi_root ! = GFS_Control%master - integer, intent(in) :: lsm - integer, intent(in) :: lsm_noahmp - integer, intent(in) :: isot, ivegsrc, nlunit - real (kind=kind_phys), dimension(:), intent(out) :: pores, resid - logical, intent(in) :: do_mynnsfclay - logical, intent(in) :: do_mynnedmf - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + real (kind=kind_phys), dimension(:), intent(out) :: pores, resid + + logical, intent(in) :: do_mynnsfclay + logical, intent(in) :: do_mynnedmf + + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! land iau mod DDTs ! Land IAU Control holds settings' information, maily read from namelist ! (e.g., block of global domain that belongs to current process, - ! whether to do IAU increment at this time step, time step informatoin, etc) - type(land_iau_control_type), intent(inout) :: Land_IAU_Control - ! land iau state holds increment data read from file (before interpolation) - type(land_iau_state_type), intent(inout) :: Land_IAU_state - ! Land IAU Data holds spatially and temporally interpolated increments per time step - type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data ! arry of (number of blocks):each proc holds nblks - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 + ! whether to do IAU increment at this time step, time step informatoin, etc) + ! made optional to allow NoahMP Component model call this function without having to deal with IAU + type(land_iau_control_type), intent(inout), optional :: Land_IAU_Control + ! land iau state holds increment data read from file (before interpolation) + type(land_iau_state_type), intent(inout), optional :: Land_IAU_state + ! Land IAU Data holds spatially and temporally interpolated increments per time step + type(land_iau_external_data_type), intent(inout), optional :: Land_IAU_Data ! arry of (number of blocks):each proc holds nblks + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (lsm/=lsm_noahmp) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of ', & + & 'LSM is different from Noah' + errflg = 1 + return + end if - ! Consistency checks - if (lsm/=lsm_noahmp) then - write(errmsg,'(*(a))') 'Logic error: namelist choice of ', & - & 'LSM is different from Noah' - errflg = 1 - return - end if + if (ivegsrc /= 1) then + errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// & + 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + if (isot /= 1) then + errmsg = 'The NOAHMP LSM expects that the isot physics '// & + 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if - if (ivegsrc /= 1) then - errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// & - 'namelist parameter is 1. Exiting...' - errflg = 1 - return - end if - if (isot /= 1) then - errmsg = 'The NOAHMP LSM expects that the isot physics '// & - 'namelist parameter is 1. Exiting...' - errflg = 1 - return - end if + if ( do_mynnsfclay .and. .not. do_mynnedmf) then + errmsg = 'Problem : do_mynnsfclay = .true.' // & + 'but mynnpbl is .false.. Exiting ...' + errflg = 1 + return + end if - if ( do_mynnsfclay .and. .not. do_mynnedmf) then - errmsg = 'Problem : do_mynnsfclay = .true.' // & - 'but mynnpbl is .false.. Exiting ...' - errflg = 1 - return - end if - !--- initialize soil vegetation - call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) + !--- initialize soil vegetation + call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) - !--- read in noahmp table - call read_mp_table_parameters(errmsg, errflg) + !--- read in noahmp table + call read_mp_table_parameters(errmsg, errflg) - ! initialize psih and psim - if ( do_mynnsfclay ) then - call psi_init(psi_opt,errmsg,errflg) - endif + ! initialize psih and psim - pores (:) = maxsmc (:) - resid (:) = drysmc (:) + if ( do_mynnsfclay ) then + call psi_init(psi_opt,errmsg,errflg) + endif - ! Initialize IAU for land--land_iau_control was set by host model - if (.not. Land_IAU_Control%do_land_iau) return - call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) + pores (:) = maxsmc (:) + resid (:) = drysmc (:) + + if (present(Land_IAU_Control) .and. present(Land_IAU_Data) .and. present(Land_IAU_State)) then + ! Initialize IAU for land--land_iau_control was set by host model + if (.not. Land_IAU_Control%do_land_iau) return + call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) + endif - end subroutine noahmpdrv_init + end subroutine noahmpdrv_init !> \ingroup NoahMP_LSM !! \brief This subroutine is called before noahmpdrv_run @@ -441,7 +446,7 @@ end subroutine noahmpdrv_finalize subroutine noahmpdrv_run & !................................... ! --- inputs: - (im, km, lsnowl, itime, ps, u1, v1, t1, q1, soiltyp,soilcol,& + ( im, km, lsnowl, itime, ps, u1, v1, t1, q1, soiltyp,soilcol,& vegtype, sigmaf, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & prsl1, prslk1, prslki, prsik1, zf,pblh, dry, wind, slopetyp,& shdmin, shdmax, snoalb, sfalb, flag_iter,con_g, & @@ -450,7 +455,7 @@ subroutine noahmpdrv_run & iopt_trs,iopt_diag,xlatin, xcoszin, iyrlen, julian, garea, & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, rhonewsn1,& con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd, cpllnd2atm, & + con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd, cpllnd2atm,& ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & @@ -546,7 +551,7 @@ subroutine noahmpdrv_run & integer , intent(in) :: im ! horiz dimension and num of used pts integer , intent(in) :: km ! vertical soil layer dimension integer , intent(in) :: lsnowl ! lower bound for snow level arrays - integer , intent(in) :: itime ! NOT USED current forecast iteration + integer , intent(in) :: itime ! NOT USED real(kind=kind_phys), dimension(:) , intent(in) :: ps ! surface pressure [Pa] real(kind=kind_phys), dimension(:) , intent(in) :: u1 ! u-component of wind [m/s] real(kind=kind_phys), dimension(:) , intent(in) :: v1 ! u-component of wind [m/s] @@ -987,7 +992,7 @@ subroutine noahmpdrv_run & logical :: is_snowing ! used for penman calculation logical :: is_freeze_rain ! used for penman calculation integer :: i, k - + ! ! --- local derived constants: ! @@ -2064,4 +2069,4 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & ! ---------------------------------------------------------------------- end subroutine penman -end module noahmpdrv + end module noahmpdrv diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 256f47574..753550016 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -4,26 +4,11 @@ dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90 dependencies = ../Noah/set_soilveg.f - dependencies = lnd_iau_mod.F90 ######################################################################## [ccpp-arg-table] name = noahmpdrv_init type = scheme -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in -[mpi_root] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer - intent = in [lsm] standard_name = control_for_land_surface_scheme long_name = flag for land surface model @@ -38,6 +23,13 @@ dimensions = () type = integer intent = in +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in [isot] standard_name = control_for_soil_type_dataset long_name = soil type dataset choice @@ -104,232 +96,8 @@ dimensions = () type = integer intent = out -[land_iau_control] - standard_name = land_data_assimilation_control - long_name = land data assimilation control - units = mixed - dimensions = () - type = land_iau_control_type - intent = inout -[land_iau_data] - standard_name = land_data_assimilation_data - long_name = land data assimilation data - units = mixed - dimensions = () - type = land_iau_external_data_type - intent = inout -[land_iau_state] - standard_name = land_data_assimilation_interpolated_data - long_name = land data assimilation space- and time-interpolated - units = mixed - dimensions = () - type = land_iau_state_type - intent = inout ######################################################################## -[ccpp-arg-table] - name = noahmpdrv_timestep_init - type = scheme -[itime] - standard_name = index_of_timestep - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in -[fhour] - standard_name = forecast_time - long_name = current forecast time - units = h - dimensions = () - type = real - kind = kind_phys - intent = in -[delt] - standard_name = timestep_for_dynamics - long_name = dynamics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[km] - standard_name = vertical_dimension_of_soil - long_name = vertical dimension of soil layers - units = count - dimensions = () - type = integer - intent = in -[ncols] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[isot] - standard_name = control_for_soil_type_dataset - long_name = soil type dataset choice - units = index - dimensions = () - type = integer - intent = in -[ivegsrc] - standard_name = control_for_vegetation_dataset - long_name = land use dataset choice - units = index - dimensions = () - type = integer - intent = in -[soiltyp] - standard_name = soil_type_classification - long_name = soil type at each grid cell - units = index - dimensions = (horizontal_dimension) - type = integer - intent= in -[vegtype] - standard_name = vegetation_type_classification - long_name = vegetation type at each grid cell - units = index - dimensions = (horizontal_dimension) - type = integer - intent= in -[weasd] - standard_name = water_equivalent_accumulated_snow_depth_over_land - long_name = water equivalent of accumulated snow depth over land - units = mm - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout -[land_iau_control] - standard_name = land_data_assimilation_control - long_name = land data assimilation control - units = mixed - dimensions = () - type = land_iau_control_type - intent = inout -[land_iau_data] - standard_name = land_data_assimilation_data - long_name = land data assimilation data - units = mixed - dimensions = () - type = land_iau_external_data_type - intent = inout -[land_iau_state] - standard_name = land_data_assimilation_interpolated_data - long_name = land data assimilation space- and time-interpolated - units = mixed - dimensions = () - type = land_iau_state_type - intent = inout -[stc] - standard_name = soil_temperature - long_name = soil temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension_of_soil) - type = real - kind = kind_phys - intent = inout -[slc] - standard_name = volume_fraction_of_unfrozen_water_in_soil - long_name = liquid soil moisture - units = frac - dimensions = (horizontal_dimension,vertical_dimension_of_soil) - type = real - kind = kind_phys - intent = inout -[smc] - standard_name = volume_fraction_of_condensed_water_in_soil - long_name = total soil moisture - units = frac - dimensions = (horizontal_dimension,vertical_dimension_of_soil) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out -[con_g] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_t0c] - standard_name = temperature_at_zero_celsius - long_name = temperature at 0 degree Celsius - units = K - dimensions = () - type = real - kind = kind_phys - intent = in -[con_hfus] - standard_name = latent_heat_of_fusion_of_water_at_0C - long_name = latent heat of fusion - units = J kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - -####################################################################### -[ccpp-arg-table] - name = noahmpdrv_finalize - type = scheme -[land_iau_control] - standard_name = land_data_assimilation_control - long_name = land data assimilation control - units = mixed - dimensions = () - type = land_iau_control_type - intent = in -[land_iau_data] - standard_name = land_data_assimilation_data - long_name = land data assimilation data - units = mixed - dimensions = () - type = land_iau_external_data_type - intent = inout -[land_iau_state] - standard_name = land_data_assimilation_interpolated_data - long_name = land data assimilation space- and time-interpolated - units = mixed - dimensions = () - type = land_iau_state_type - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -####################################################################### [ccpp-arg-table] name = noahmpdrv_run type = scheme @@ -872,6 +640,20 @@ dimensions = () type = logical intent = in +[cpllnd] + standard_name = flag_for_land_coupling + long_name = flag controlling cpllnd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[cpllnd2atm] + standard_name = flag_for_one_way_land_coupling_to_atmosphere + long_name = flag controlling land coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in [weasd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land From b008e259020b5421989da9704fc57215b6dc1dac Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 30 Oct 2024 11:51:20 -0400 Subject: [PATCH 135/141] update noahmpdrv.meta for edits to accomodate component model NoahMP --- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 224 ++++++++++++++++++ 1 file changed, 224 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 753550016..38b21db57 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -96,6 +96,230 @@ dimensions = () type = integer intent = out +[land_iau_control] + standard_name = land_data_assimilation_control + long_name = land data assimilation control + units = mixed + dimensions = () + type = land_iau_control_type + intent = inout +[land_iau_data] + standard_name = land_data_assimilation_data + long_name = land data assimilation data + units = mixed + dimensions = () + type = land_iau_external_data_type + intent = inout +[land_iau_state] + standard_name = land_data_assimilation_interpolated_data + long_name = land data assimilation space- and time-interpolated + units = mixed + dimensions = () + type = land_iau_state_type + intent = inout + +######################################################################## +[ccpp-arg-table] + name = noahmpdrv_timestep_init + type = scheme +[itime] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[delt] + standard_name = timestep_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[km] + standard_name = vertical_dimension_of_soil + long_name = vertical dimension of soil layers + units = count + dimensions = () + type = integer + intent = in +[ncols] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[isot] + standard_name = control_for_soil_type_dataset + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in +[ivegsrc] + standard_name = control_for_vegetation_dataset + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent= in +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent= in +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equivalent of accumulated snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[land_iau_control] + standard_name = land_data_assimilation_control + long_name = land data assimilation control + units = mixed + dimensions = () + type = land_iau_control_type + intent = inout +[land_iau_data] + standard_name = land_data_assimilation_data + long_name = land data assimilation data + units = mixed + dimensions = () + type = land_iau_external_data_type + intent = inout +[land_iau_state] + standard_name = land_data_assimilation_interpolated_data + long_name = land data assimilation space- and time-interpolated + units = mixed + dimensions = () + type = land_iau_state_type + intent = inout +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[slc] + standard_name = volume_fraction_of_unfrozen_water_in_soil + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[smc] + standard_name = volume_fraction_of_condensed_water_in_soil + long_name = total soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + +####################################################################### +[ccpp-arg-table] + name = noahmpdrv_finalize + type = scheme +[land_iau_control] + standard_name = land_data_assimilation_control + long_name = land data assimilation control + units = mixed + dimensions = () + type = land_iau_control_type + intent = in +[land_iau_data] + standard_name = land_data_assimilation_data + long_name = land data assimilation data + units = mixed + dimensions = () + type = land_iau_external_data_type + intent = inout +[land_iau_state] + standard_name = land_data_assimilation_interpolated_data + long_name = land data assimilation space- and time-interpolated + units = mixed + dimensions = () + type = land_iau_state_type + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out ######################################################################## [ccpp-arg-table] From ebb7b6b70679c88bb3e31fd3865741bbe166661c Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Wed, 30 Oct 2024 14:11:07 -0400 Subject: [PATCH 136/141] fix compile error --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 2d79863c4..1b06ff63e 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -541,7 +541,6 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) je = js + Land_IAU_Control%ny-1 npz = Land_IAU_Control%lsoil ! this is only called if using 1 increment file - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) do j = js, je do i = is, ie do k = 1, npz ! do k = 1,n_soill ! From db2c10f6f45a7a396e29cb6ac018ae6d31b59a2a Mon Sep 17 00:00:00 2001 From: tsga Date: Thu, 31 Oct 2024 12:57:25 +0000 Subject: [PATCH 137/141] fix real type for mask --- physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 1b06ff63e..2be8d52db 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -672,7 +672,7 @@ subroutine calculate_landinc_mask(swe,vtype,stype,lensfc,veg_type_landice, mask) implicit none integer, intent(in) :: lensfc, veg_type_landice - real, intent(in) :: swe(lensfc) + real(kind=kind_phys), intent(in) :: swe(lensfc) integer, intent(in) :: vtype(lensfc),stype(lensfc) integer, intent(out) :: mask(lensfc) From 82f1ec3eb0a498a9cf54f712737dd13138fd43cc Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 15 Nov 2024 08:14:28 -0500 Subject: [PATCH 138/141] add optional=True for lndiau ddts --- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 38b21db57..7d1150c80 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -103,6 +103,7 @@ dimensions = () type = land_iau_control_type intent = inout + optional = True [land_iau_data] standard_name = land_data_assimilation_data long_name = land data assimilation data @@ -110,6 +111,7 @@ dimensions = () type = land_iau_external_data_type intent = inout + optional = True [land_iau_state] standard_name = land_data_assimilation_interpolated_data long_name = land data assimilation space- and time-interpolated @@ -117,6 +119,7 @@ dimensions = () type = land_iau_state_type intent = inout + optional = True ######################################################################## [ccpp-arg-table] From 13e8e786c98093ada1a23c5140c3fbe20473bdc7 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 15 Nov 2024 08:33:11 -0500 Subject: [PATCH 139/141] clean lnd_iau_mod --- .../SFC_Models/Land/Noahmp/lnd_iau_mod.F90 | 90 +++++++------------ 1 file changed, 33 insertions(+), 57 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index 2be8d52db..40f3eb8f7 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -37,21 +37,19 @@ module land_iau_mod real(kind=kind_phys),allocatable :: stc_inc(:,:,:) real(kind=kind_phys),allocatable :: slc_inc(:,:,:) logical :: in_interval = .false. - ! integer,allocatable :: snow_land_mask(:, :) ! Calculate snow soil mask at runtime from (dynamic) swe - ! moved from land_iau_state_type real(kind=kind_phys) :: hr1 real(kind=kind_phys) :: hr2 real(kind=kind_phys) :: wt real(kind=kind_phys) :: wt_normfact - real(kind=kind_phys) :: rdt - ! track the increment steps here - integer :: itnext + real(kind=kind_phys) :: rdt + integer :: itnext ! track the increment steps here end type land_iau_external_data_type !!> \section arg_table_land_iau_state_type Argument Table !! \htmlinclude land_iau_state_type.html !! - ! land_iau_state will hold 'raw' (not interpolated) inrements, read during land_iau_mod_init + ! land_iau_state_type holds 'raw' (not interpolated) inrements, + ! read during land_iau_mod_init type land_iau_state_type real(kind=kind_phys),allocatable :: stc_inc(:,:,:,:) real(kind=kind_phys),allocatable :: slc_inc(:,:,:,:) @@ -152,7 +150,7 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me input_nml_file => input_nml_file_i read(input_nml_file, nml=land_iau_nml, ERR=888, END=999, iostat=ios) #else - inquire (file=trim(fn_nml), exist=exists) ! TBCL: this maybe be replaced by nlunit passed from ccpp + inquire (file=trim(fn_nml), exist=exists) ! TODO: this maybe be replaced by nlunit passed from ccpp if (.not. exists) then errmsg = 'lnd_iau_mod_set_control: namelist file '//trim(fn_nml)//' does not exist' errflg = 1 @@ -172,14 +170,14 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me endif #endif -888 if (ios /= 0) then ! .and. ios /= iostat_end) then +888 if (ios /= 0) then write(iosstr, '(I0)') ios errmsg = 'lnd_iau_mod_set_control: I/O error code '//trim(iosstr)//' at land_iau namelist read' errflg = 1 return end if -999 if (ios /= 0) then ! ios .eq. iostat_end) then +999 if (ios /= 0) then write(iosstr, '(I0)') ios if (me == mpi_root) then WRITE(6, * ) 'lnd_iau_mod_set_control: Warning! EoF ('//trim(iosstr)//') while reading land_iau namelist,' & @@ -220,8 +218,8 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file_i, me allocate(Land_IAU_Control%blksz(nblks)) allocate(Land_IAU_Control%blk_strt_indx(nblks)) - ! Land_IAU_Control%blk_strt_indx: start index of each block, for flattened (ncol=nx*ny) arrays - ! required in noahmpdriv_run to get subsection of the stc array for each proces/thread + ! Land_IAU_Control%blk_strt_indx = start index of each block, for flattened (ncol=nx*ny) arrays + ! It's required in noahmpdriv_run to get subsection of the stc array for each proces/thread ix = 1 do nb=1, nblks Land_IAU_Control%blksz(nb) = blksz(nb) @@ -272,7 +270,6 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e ! allocate arrays that will hold iau state allocate(Land_IAU_Data%stc_inc(nlon, nlat, km)) allocate(Land_IAU_Data%slc_inc(nlon, nlat, km)) - ! allocate(Land_IAU_Data%snow_land_mask(nlon, nlat)) Land_IAU_Data%hr1=Land_IAU_Control%iaufhrs(1) Land_IAU_Data%wt = 1.0 ! IAU increment filter weights (default 1.0) @@ -310,8 +307,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e print*,"Land_iau_init: Increment file name: ", trim(adjustl(Land_IAU_Control%iau_inc_files(1))) endif - ! determine number of valid forecast hours - ! is read from the increment file ("Time" dim) + ! determine number of valid forecast hours; read from the increment file ("Time" dim) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print *, "Land_iau_init: timesetps and forecast times (in hours) with valid increment values" endif @@ -345,9 +341,7 @@ subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, e endif dt = (Land_IAU_Control%iau_delthrs*3600.) Land_IAU_Data%rdt = 1.0/dt !rdt - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'Land_iau_init: IAU interval(dt), rdt (1/dt)',Land_IAU_Control%iau_delthrs,Land_IAU_Data%rdt - endif + ! Read all increment files at iau init time (at beginning of cycle) ! increments are already in the fv3 grid--no need for interpolation call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%stc_inc, Land_IAU_state%slc_inc, errmsg, errflg) @@ -382,7 +376,6 @@ subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_state if (allocated(Land_IAU_Data%stc_inc)) deallocate (Land_IAU_Data%stc_inc) if (allocated(Land_IAU_Data%slc_inc)) deallocate (Land_IAU_Data%slc_inc) - ! if (allocated(Land_IAU_Data%snow_land_mask)) deallocate (Land_IAU_Data%snow_land_mask) if (allocated(Land_IAU_state%stc_inc)) deallocate(Land_IAU_state%stc_inc) if (allocated(Land_IAU_state%slc_inc)) deallocate(Land_IAU_state%slc_inc) @@ -398,7 +391,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg real(kind=kind_phys) t1,t2,sx,wx,wt,dtp - integer n,i,j,k,kstep,nstep !,itnext + integer n,i,j,k,kstep,nstep integer :: ntimes ! Initialize CCPP error handling variables @@ -445,8 +438,6 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ if (ntimes.EQ.1) then ! check to see if we are in the IAU window, no need to update the states since they are fixed over the window -!TBCL: noahmpdrv_timestep_init doesn't get visited at t1 (when running from global workflow), so include t2? - ! if ( Land_IAU_Control%fhour < t1 .or. Land_IAU_Control%fhour >= t2 ) then if ( Land_IAU_Control%fhour <= t1 .or. Land_IAU_Control%fhour > t2 ) then Land_IAU_Data%in_interval=.false. else @@ -474,12 +465,7 @@ subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_ Land_IAU_Data%hr1=Land_IAU_Data%hr2 Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(Land_IAU_Data%itnext) endif - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'land_iau_mod_getiauforcing: Land iau increments interplated between time steps ', & - Land_IAU_Data%itnext-1, ' and ', Land_IAU_Data%itnext, & - ' times (hr1, hr2) ', Land_IAU_Data%hr1, Land_IAU_Data%hr2 - endif - ! Land_IAU_Data%snow_land_mask(:, :) = wk3_slmsk(itnext-1, :, :) + call updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) endif endif @@ -495,26 +481,18 @@ subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) type(land_iau_state_type), intent(in) :: Land_IAU_State real(kind=kind_phys) delt_t integer i,j,k - integer :: is, ie, js, je, npz, t1 - integer :: ntimes - integer :: t2 + integer :: is, ie, js, je, npz, t1, t2 t2 = Land_IAU_Data%itnext t1 = t2 - 1 - is = 1 !Land_IAU_Control%isc + is = 1 ! Land_IAU_Control%isc ie = is + Land_IAU_Control%nx-1 - js = 1 !Land_IAU_Control%jsc + js = 1 ! Land_IAU_Control%jsc je = js + Land_IAU_Control%ny-1 npz = Land_IAU_Control%lsoil - ntimes = Land_IAU_Control%ntimes - delt_t = (Land_IAU_Data%hr2-(Land_IAU_Control%fhour))/(Land_IAU_Data%hr2-Land_IAU_Data%hr1) - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print *,'in land_iau updateiauforcing ntimes ', & - ntimes,Land_IAU_Control%iaufhrs(1:ntimes), & - " rdt wt delt_t ", Land_IAU_Data%rdt, Land_IAU_Data%wt, delt_t - endif + do j = js,je do i = is,ie do k = 1,npz ! do k = 1,n_soill ! @@ -535,15 +513,15 @@ subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) integer i, j, k integer :: is, ie, js, je, npz - is = 1 !Land_IAU_Control%isc + is = 1 ie = is + Land_IAU_Control%nx-1 - js = 1 !Land_IAU_Control%jsc + js = 1 je = js + Land_IAU_Control%ny-1 npz = Land_IAU_Control%lsoil - ! this is only called if using 1 increment file + do j = js, je do i = is, ie - do k = 1, npz ! do k = 1,n_soill ! + do k = 1, npz Land_IAU_Data%stc_inc(i,j,k) = Land_IAU_Data%wt*Land_IAU_State%stc_inc(1,i,j,k)*Land_IAU_Data%rdt Land_IAU_Data%slc_inc(i,j,k) = Land_IAU_Data%wt*Land_IAU_State%slc_inc(1,i,j,k)*Land_IAU_Data%rdt end do @@ -612,38 +590,37 @@ subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errf allocate(wk3_stc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) allocate(wk3_slc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) - ! allocate(wk3_slmsk(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny)) do i = 1, size(stc_vars) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(stc_vars(i)) - ! call check_var_exists(ncid, trim(stc_vars(i)), ierr) status = nf90_inq_varid(ncid, trim(stc_vars(i)), varid) - if (status == nf90_noerr) then !if (ierr == 0) then + if (status == nf90_noerr) then do it = 1, n_t ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) call get_var3d_values(ncid, varid, trim(stc_vars(i)), Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & it, 1, wk3_stc(it,:, :, i), status, errflg, errmsg) - ! call netcdf_err(status, 'reading var: '//trim(stc_vars(i)), errflg, errmsg) if (errflg .ne. 0) return enddo else - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, & - 'warning: no increment for ',trim(stc_vars(i)),' found, assuming zero' + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *, 'warning! No increment for ',trim(stc_vars(i)),' found, assuming zero' + endif wk3_stc(:, :, :, i) = 0. endif enddo do i = 1, size(slc_vars) if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(slc_vars(i)) status = nf90_inq_varid(ncid, trim(slc_vars(i)), varid) - if (status == nf90_noerr) then !if (status == 0) + if (status == nf90_noerr) then do it = 1, n_t call get_var3d_values(ncid, varid, trim(slc_vars(i)), Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & it, 1, wk3_slc(it, :, :, i), status, errflg, errmsg) if (errflg .ne. 0) return end do else - if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *,& - 'warning: no increment for ',trim(slc_vars(i)),' found, assuming zero' + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *, 'warning! No increment for ',trim(slc_vars(i)),' found, assuming zero' + endif wk3_slc(:, :, :, i) = 0. endif enddo @@ -759,8 +736,8 @@ subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) status = nf90_inq_varid(ncid, trim(var_name), varid) call netcdf_err(status, 'getting varid: '//trim(var_name), errflg, errmsg_out) if (errflg .ne. 0) return + status = nf90_get_var(ncid, varid, var_arr) - ! start = (/1/), count = (/dim_len/)) call netcdf_err(status, 'reading var: '//trim(var_name), errflg, errmsg_out) end subroutine get_var1d @@ -769,7 +746,7 @@ subroutine get_var3d_values(ncid, varid, var_name, is,ix, js,jy, ks,kz, var3d, s integer, intent(in):: ncid, varid integer, intent(in):: is, ix, js, jy, ks,kz character(len=*), intent(in):: var_name - real(kind=kind_phys), intent(out):: var3d(ix, jy, kz) !var3d(is:ie,js:je,ks:ke) + real(kind=kind_phys), intent(out):: var3d(ix, jy, kz) integer, intent(out):: status integer :: errflg character(len=*) :: errmsg_out @@ -778,7 +755,7 @@ subroutine get_var3d_values(ncid, varid, var_name, is,ix, js,jy, ks,kz, var3d, s errmsg_out = '' errflg = 0 - status = nf90_get_var(ncid, varid, var3d, & !start = start, count = nreco) + status = nf90_get_var(ncid, varid, var3d, & start = (/is, js, ks/), count = (/ix, jy, kz/)) call netcdf_err(status, 'get_var3d_values '//trim(var_name), errflg, errmsg_out) @@ -790,7 +767,7 @@ subroutine get_var3d_values_int(ncid, varid, var_name, is,ix, js,jy, ks,kz, var3 integer, intent(in):: ncid, varid integer, intent(in):: is, ix, js, jy, ks,kz character(len=*), intent(in):: var_name - integer, intent(out):: var3d(ix, jy, kz) !var3d(is:ie,js:je,ks:ke) + integer, intent(out):: var3d(ix, jy, kz) integer, intent(out):: status integer :: errflg character(len=*) :: errmsg_out @@ -801,7 +778,6 @@ subroutine get_var3d_values_int(ncid, varid, var_name, is,ix, js,jy, ks,kz, var3 status = nf90_get_var(ncid, varid, var3d, & !start = start, count = nreco) start = (/is, js, ks/), count = (/ix, jy, kz/)) - ! start = (/is, js, ks/), count = (/ie - is + 1, je - js + 1, ke - ks + 1/)) call netcdf_err(status, 'get_var3d_values_int '//trim(var_name), errflg, errmsg_out) From b9e04297fc568d426921f1027b1e5a1036f94fc1 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 15 Nov 2024 08:54:36 -0500 Subject: [PATCH 140/141] clean noahmpdrv_timestep_init --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 80 +++++++------------- 1 file changed, 28 insertions(+), 52 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index ec3c2d5c3..a33da9c8f 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -13,12 +13,13 @@ module noahmpdrv use module_sf_noahmplsm -! Land IAU increments for soil temperature (plan to extend to soil moisture increments) +! These hold and apply Land IAU increments for soil temperature +! (possibly will extend to soil moisture increments) use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & land_iau_state_type use land_iau_mod, only: land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, & - calculate_landinc_mask ! land_iau_mod_set_control, + calculate_landinc_mask implicit none integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS @@ -61,14 +62,16 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! land iau mod DDTs - ! Land IAU Control holds settings' information, maily read from namelist - ! (e.g., block of global domain that belongs to current process, - ! whether to do IAU increment at this time step, time step informatoin, etc) - ! made optional to allow NoahMP Component model call this function without having to deal with IAU + ! Land iau mod DDTs ! made optional to allow NoahMP Component model call this function without having to deal with IAU + + ! Land IAU Control holds settings' information, maily read from namelist + ! (e.g., block of global domain that belongs to current process, + ! whether to do IAU increment at this time step, time step informatoin, etc) type(land_iau_control_type), intent(inout), optional :: Land_IAU_Control + ! land iau state holds increment data read from file (before interpolation) - type(land_iau_state_type), intent(inout), optional :: Land_IAU_state + type(land_iau_state_type), intent(inout), optional :: Land_IAU_state + ! Land IAU Data holds spatially and temporally interpolated increments per time step type(land_iau_external_data_type), intent(inout), optional :: Land_IAU_Data ! arry of (number of blocks):each proc holds nblks @@ -121,9 +124,11 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & resid (:) = drysmc (:) if (present(Land_IAU_Control) .and. present(Land_IAU_Data) .and. present(Land_IAU_State)) then + ! Initialize IAU for land--land_iau_control was set by host model if (.not. Land_IAU_Control%do_land_iau) return call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) + endif end subroutine noahmpdrv_init @@ -193,6 +198,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & integer :: nother, nsnowupd integer :: nstcupd, nslcupd, nfrozen, nfrozen_upd + logical :: print_update_stats = .False. ! --- Initialize CCPP error handling variables errmsg = '' @@ -200,33 +206,20 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & if (.not. Land_IAU_Control%do_land_iau) return - !> update current forecast hour - ! GFS_control%jdat(:) = jdat(:) - Land_IAU_Control%fhour=fhour - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*,"itime ",itime," GFScont%fhour ",fhour," IauCon%fhour",Land_IAU_Control%fhour, & - " delt ",delt," IauCont%dtp",Land_IAU_Control%dtp - endif + !> update current forecast hour + Land_IAU_Control%fhour=fhour !> read iau increments - call land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state, errmsg, errflg) !call getiauforcing(GFS_control,IAU_data) + call land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state, errmsg, errflg) if (errflg .ne. 0) then - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "noahmpdrv_timestep_init: lnd_iau_mod_getiauforcing returned nonzero value" - print*, errmsg - endif return endif - !> update land states with iau increments + !> If no increment at the current timestep simply proceed forward if (.not. Land_IAU_Data%in_interval) then - if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "noahmpdrv_timestep_init: current time step not in Land iau interval " - endif return endif - ! if (Land_IAU_Data%in_interval) then if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then print*, "adding land iau increments " endif @@ -242,23 +235,22 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) allocate(slc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) - !copy background stc + !copy background stc stc_updated = 0 slc_updated = 0 ib = 1 - do j = 1, Land_IAU_Control%ny !ny + do j = 1, Land_IAU_Control%ny do k = 1, km stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%stc_inc(:,j, k) slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) enddo - ib = ib + Land_IAU_Control%nx !nlon + ib = ib + Land_IAU_Control%nx enddo - ! delt=GFS_Control%dtf if ((Land_IAU_Control%dtp - delt) > 0.0001) then if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then - print*, "Warning noahmpdrv_timestep_init delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp + print*, "Warning! noahmpdrv_timestep_init delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp endif endif @@ -276,14 +268,14 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & !TODO---if only fv3 increment files are used, this can be read from file allocate(mask_tile(lensfc)) - call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) !& !veg_type_landice, + call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) !IAU increments are in units of 1/sec !Land_IAU_Control%dtp !* only updating soil temp for now ij_loop : do ij = 1, lensfc ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land if (mask_tile(ij) == 1) then - ! if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*, "root proc layer 1 stc, inc ", stc(ij,1), stc_inc_flat(ij,1) + soil_freeze=.false. soil_ice=.false. do k = 1, lsoil_incr ! k = 1, km @@ -309,22 +301,16 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & endif ! apply zero limit here (higher, model-specific limits are later) slc(ij,k) = max(slc(ij,k) + slc_inc_flat(ij,k)*delt, 0.0) - smc(ij,k) = max(smc(ij,k) + slc_inc_flat(ij,k)*delt, 0.0) - ! slc_state(ij,k) = max(slc_state(ij,k) + slcinc(ij,k), 0.0) - ! smc_state(ij,k) = max(smc_state(ij,k) + slcinc(ij,k), 0.0) + smc(ij,k) = max(smc(ij,k) + slc_inc_flat(ij,k)*delt, 0.0) endif else if (k==1) nfrozen = nfrozen+1 - ! ! moisture updates not done if this layer or any above is frozen - ! if ( soil_freeze .or. soil_ice ) then - ! if (k==1) nfrozen = nfrozen+1 - ! endif endif enddo endif ! if soil/snow point enddo ij_loop - deallocate(stc_inc_flat, slc_inc_flat) !, tmp2m_inc_flat,spfh2m_inc_flat) + deallocate(stc_inc_flat, slc_inc_flat) !!do moisture/temperature adjustment for consistency after increment add call read_mp_table_parameters(errmsg, errflg) @@ -382,17 +368,7 @@ subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & deallocate(stc_updated, slc_updated) deallocate(mask_tile) - - write(*,'(a,i2)') ' noahmpdrv_timestep_init: statistics of grids with stc/smc updates for rank : ', Land_IAU_Control%me - write(*,'(a,i8)') ' soil grid total', lensfc - write(*,'(a,i8)') ' soil grid cells stc updated = ',nstcupd - write(*,'(a,i8)') ' soil grid cells slc updated = ',nslcupd - write(*,'(a,i8)') ' soil grid cells not updated, frozen = ',nfrozen - write(*,'(a,i8)') ' soil grid cells update, became frozen = ',nfrozen_upd - write(*,'(a,i8)') ' (not updated yet) snow grid cells = ', nsnowupd - write(*,'(a,i8)') ' grid cells, without soil or snow = ', nother - write(*,'(a,i8)') ' soil grid cells with stc adjustment', n_stc - write(*,'(a,i8)') ' soil grid cells with slc adjustment', n_slc + write(*,'(a,i4,a,i8)') 'noahmpdrv_timestep_init rank ', Land_IAU_Control%me, ' # of cells with stc update ', nstcupd end subroutine noahmpdrv_timestep_init @@ -418,7 +394,7 @@ subroutine noahmpdrv_finalize (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errflg = 0 if (.not. Land_IAU_Control%do_land_iau) return - call land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) !Land_IAU_Control%finalize() + call land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) end subroutine noahmpdrv_finalize From 4343656a098516517257c0913689f70a81579e74 Mon Sep 17 00:00:00 2001 From: Tseganeh Gichamo <1621305073113305@mil> Date: Fri, 15 Nov 2024 12:40:29 -0500 Subject: [PATCH 141/141] combine use lnd_iau_mod lines --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index a33da9c8f..d4971efd9 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -15,11 +15,9 @@ module noahmpdrv ! These hold and apply Land IAU increments for soil temperature ! (possibly will extend to soil moisture increments) - use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, & - land_iau_state_type - - use land_iau_mod, only: land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, & - calculate_landinc_mask + use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, land_iau_state_type, & + land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, calculate_landinc_mask + implicit none integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS