diff --git a/CMakeLists.txt b/CMakeLists.txt index d7fd01640..d6de00314 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -89,6 +89,9 @@ list(APPEND fv3_io_srcs io/fv3atm_history_io.F90 io/fv3atm_restart_io.F90) +list(APPEND ufs_srcs + ${PROJECT_SOURCE_DIR}/CDEPS-interface/ufs/cdeps_share/shr_is_restart_fh_mod.F90) + ############################################################################### ### UFSATM with FV3 dynamical core ############################################################################### @@ -186,6 +189,7 @@ if (FV3) ${moving_nest_srcs} ${cdeps_inline_srcs} ${POST_SRC} + ${ufs_srcs} ) add_dependencies(${DYCORE_TARGET} fv3 fv3ccpp stochastic_physics) @@ -248,6 +252,7 @@ if (MPAS) mpas/ufs_mpas_constituents.F90 ${coupling_srcs} ${io_srcs} + ${ufs_srcs} ccpp/data/MPAS_typedefs.F90 ccpp/driver/MPAS_init.F90 ) diff --git a/ccpp/CMakeLists.txt b/ccpp/CMakeLists.txt index 5eba68b73..f354efdfb 100644 --- a/ccpp/CMakeLists.txt +++ b/ccpp/CMakeLists.txt @@ -133,7 +133,10 @@ endif() if(NOT HYDRO) add_definitions(-DMOIST_CAPPA -DUSE_COND -DNEMS_GSM) endif() -add_definitions(-DINTERNAL_FILE_NML -DNEMS_GSM) +add_definitions(-DNEMS_GSM) +if (FV3) + add_definitions(-DINTERNAL_FILE_NML) +endif() if(MULTI_GASES) add_definitions(-DMULTI_GASES) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index c719a8f04..63a8e5693 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -43,6 +43,7 @@ module GFS_typedefs integer, parameter :: physics_no_tracer = -99 + !> \section arg_table_GFS_typedefs !! \htmlinclude GFS_typedefs.html !! @@ -8805,10 +8806,34 @@ function get_physics_tracer_index (name, Model) !--- local variables integer :: get_physics_tracer_index - get_physics_tracer_index = get_tracer_index(MODEL_ATMOS, name, verbose = (Model%me == Model%master) .and. Model%debug) + ! UFS-FV3 uses FMS + if (Model%dycore_active == Model%dycore_fv3) then + get_physics_tracer_index = get_tracer_index(MODEL_ATMOS, name, verbose = (Model%me == Model%master) .and. Model%debug) + endif + + ! UFS-MPAS does not use FMS + if (Model%dycore_active == Model%dycore_mpas) then + get_physics_tracer_index = get_constituent_index(name, Model%tracer_names) + endif if (get_physics_tracer_index == NO_TRACER) get_physics_tracer_index = physics_no_tracer end function get_physics_tracer_index + ! We don't use FMS when using the MPAS dynamical core. Here we simply grab the + ! index from the input tracer list. This is the same as FMS get_tracer_index(). + function get_constituent_index(const_name, tracer_names) + character(len=*), intent(in) :: const_name + character(len=*), intent(in) :: tracer_names(:) + integer :: itracer + integer :: get_constituent_index + + get_constituent_index = 0 + do itracer=1,size(tracer_names) + if (trim(const_name) == trim(tracer_names(itracer))) then + get_constituent_index = itracer + endif + enddo + end function get_constituent_index + end module GFS_typedefs diff --git a/mpas/atmos_coupling.F90 b/mpas/atmos_coupling.F90 index d4c33e220..05665e7eb 100644 --- a/mpas/atmos_coupling.F90 +++ b/mpas/atmos_coupling.F90 @@ -489,8 +489,7 @@ subroutine ufs_mpas_grid_to_physics(physics_grid) use mpas_kind_types, only : RKIND use mpas_constants, only : pii use mpas_log, only : mpas_log_write - use mpas_derived_types, only : MPAS_LOG_ERR, MPAS_LOG_WARN - use mpp_mod, only : mpp_error, FATAL + use mpas_derived_types, only : MPAS_LOG_ERR, MPAS_LOG_WARN, MPAS_LOG_CRIT ! Arguments type(GFS_grid_type), intent(inout) :: physics_grid ! Locals @@ -502,6 +501,7 @@ subroutine ufs_mpas_grid_to_physics(physics_grid) real(RKIND), pointer :: nominalMinDc real(RKIND), pointer :: config_len_disp real(RKIND) :: rad2deg + character(len=*), parameter :: subname = 'atmos_coupling::ufs_mpas_grid_to_physics' ierr = 0 rad2deg = 180.0_RKIND/pii @@ -528,10 +528,10 @@ subroutine ufs_mpas_grid_to_physics(physics_grid) if (config_len_disp > 0.0_RKIND) then ! But if nominalMinDc was available in the input file and is different, print a warning if (nominalMinDc > 0.0_RKIND .and. abs(nominalMinDc - config_len_disp) > 1.0e-6_RKIND * config_len_disp) then - call mpas_log_write('nominalMinDc was read from input file as a positive value ($r) that differs', & - realArgs=[nominalMinDc], messageType=MPAS_LOG_WARN) - call mpas_log_write('from the specified config_len_disp value ($r)', & - realArgs=[config_len_disp], messageType=MPAS_LOG_WARN) + call mpas_log_write(subname // ' WARNING: nominalMinDc was read from input file as a positive value ($r) that differs', & + realArgs=[nominalMinDc], messageType=MPAS_LOG_WARN) + call mpas_log_write(subname // ' WARNING: from the specified config_len_disp value ($r)', & + realArgs=[config_len_disp], messageType=MPAS_LOG_WARN) end if nominalMinDc = config_len_disp ! Otherwise, try to use nominalMinDc @@ -540,15 +540,16 @@ subroutine ufs_mpas_grid_to_physics(physics_grid) call mpas_log_write('Setting config_len_disp to $r based on nominalMinDc value in input file', realArgs=[nominalMinDc]) config_len_disp = nominalMinDc else - call mpas_log_write('Both config_len_disp and nominalMinDc are <= 0.0.', messageType=MPAS_LOG_ERR) - call mpas_log_write('Please either specify config_len_disp in the &nhyd_model namelist group,', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('or use an input file that provides a valid value for the nominalMinDc variable.', & - messageType=MPAS_LOG_ERR) + call mpas_log_write(subname // ' ERROR: Both config_len_disp and nominalMinDc are <= 0.0.', & + messageType=MPAS_LOG_ERR) + call mpas_log_write(subname // ' ERROR: Please either specify config_len_disp in the &nhyd_model namelist group,', & + messageType=MPAS_LOG_ERR) + call mpas_log_write(subname // ' ERROR: or use an input file that provides a valid value for the nominalMinDc variable.', & + messageType=MPAS_LOG_ERR) ierr = 1 end if end if - if (ierr/=0) call mpp_error(FATAL, 'Call to ufs_mpas_grid_to_physics() failed') + if (ierr/=0) call mpas_log_write(subname // ' ERROR: Call to ufs_mpas_grid_to_physics() failed', messageType=MPAS_LOG_CRIT) do i=1, nCellsSolve physics_grid % xlat(i) = lat(i) diff --git a/mpas/atmos_model.F90 b/mpas/atmos_model.F90 index 2ae082fca..cf41e75ff 100644 --- a/mpas/atmos_model.F90 +++ b/mpas/atmos_model.F90 @@ -5,11 +5,12 @@ !> ! ########################################################################################### module atmos_model_mod - ! Fortran - use mpi_f08, only : MPI_Comm, MPI_CHARACTER, MPI_INTEGER, MPI_REAL8, MPI_LOGICAL + use esmf + use mpi_f08 ! MPAS use MPAS_typedefs, only : MPAS_kind_phys => kind_phys use atmos_coupling_mod, only : MPAS_statein_type, MPAS_stateout_type + use ufs_mpas_constituents, only : constituent_name, is_water_species ! CCPP use CCPP_data, only : UFSATM_control => GFS_control use CCPP_data, only : UFSATM_intdiag => GFS_intdiag @@ -24,20 +25,18 @@ module atmos_model_mod use CCPP_data, only : UFSATM_coupling => GFS_coupling use CCPP_data, only : ccpp_suite use CCPP_driver, only : CCPP_step - ! FMS - use time_manager_mod, only : time_type, get_time, get_date, operator(+), operator(-) - use field_manager_mod, only : MODEL_ATMOS - use tracer_manager_mod, only : get_number_tracers, get_tracer_names, get_tracer_index - use mpp_mod, only : input_nml_file, mpp_error, FATAL - use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_clock_id, mpp_clock_begin - use mpp_mod, only : mpp_clock_end, CLOCK_COMPONENT, MPP_CLOCK_SYNC - use fms_mod, only : clock_flag_default - use fms_mod, only : stdlog - use mpp_mod, only : stdout + ! MPAS + use mpas_log, only : mpas_log_write + use mpas_derived_types, only : MPAS_LOG_CRIT ! UFSATM use module_mpas_config, only : nCellsGlobal, ic_filename, lbc_filename, nCellsSolve + use module_mpas_config, only : stream_list_history, stream_list_restart, stream_list_diag use module_mpas_config, only : lonCell, latCell, areaCellGlobal - use module_mpas_config, only : pi + use module_mpas_config, only : mpas_errfile_funit, mpas_errfilename + use module_mpas_config, only : mpas_logfile_funit, mpas_logfilename + use module_mpas_config, only : nml_filename, nml_funit + use module_mpas_config, only : tracer_funit, tracer_filename + use module_mpas_config, only : pi, dt_atmos use mod_ufsatm_util, only : get_atmos_tracer_types #ifdef _OPENMP use omp_lib @@ -59,11 +58,10 @@ module atmos_model_mod !> !> ######################################################################################### type atmos_control_type - type(time_type) :: Time ! current time - type(time_type) :: Time_step ! atmospheric time step. - type(time_type) :: Time_init ! reference time. logical :: isAtCapTime ! true if currTime is at the cap driverClock's currTime integer :: nblks ! Number of physics blocks. + type(ESMF_Time) :: CurrTime, StartTime, StopTime + type(ESMF_TimeInterval) :: timeStep end type atmos_control_type ! Index map between MPAS tracers and UFS constituents @@ -78,16 +76,14 @@ module atmos_model_mod logical :: regional = .false. namelist /atmos_model_nml/ blocksize, dycore_only, debug, ccpp_suite, ic_filename, lbc_filename, & - regional + regional, stream_list_history, stream_list_restart, stream_list_diag ! Component Timers - integer :: setupClock, radClock, physClock, mpasClock, mpClock, atmiClock, outClock - - ! DJS2025: For UFS WM RTs unitl output is setup for MPAS. - integer, parameter :: mpas_logfile_handle = 42323 + real(MPAS_kind_phys) :: setupClock, atmiClock, radClock, physClock,mpasClock, mpClock, outClock type(MPAS_statein_type) :: MPAS_statein type(MPAS_stateout_type) :: MPAS_stateout + contains !> ######################################################################################### !> Procedure to initialize UWM ATMosphere with MPAS dynamical core. @@ -102,109 +98,112 @@ module atmos_model_mod !> - Initialize CCPP Physics !> !> ######################################################################################### - subroutine atmos_model_init(Atmos, Time_init, Time, Time_end, Time_step, mpicomm, calendar) + subroutine atmos_model_init(Atmos, mpicomm, calendar, CurrTime, StartTime, StopTime) use ufs_mpas_subdriver, only : MPAS_control_type use ufs_mpas_subdriver, only : ufs_mpas_init - use ufs_mpas_io, only : ufs_mpas_open_init, ufs_mpas_open_lbc - use ufs_mpas_constituents, only : constituent_name, is_water_species + use ufs_mpas_io, only : ufs_mpas_open_init, ufs_mpas_open_lbc, ufs_mpas_read_stream_lists use atmos_coupling_mod, only : ufs_mpas_to_physics, ufs_mpas_grid_to_physics use MPAS_init, only : MPAS_initialize ! Arguments type(atmos_control_type), intent(inout) :: Atmos - type(time_type), intent(in ) :: Time_init, Time, Time_step, Time_end type(MPI_Comm), intent(in ) :: mpicomm - character(17), intent(in ) :: calendar + character(17), intent(in ) :: calendar + type(ESMF_Time), intent(in ) :: CurrTime, StartTime, StopTime ! Locals - integer :: i, io, ierr, nConstituents, sec, iCol + integer :: i, io, ierr, nConstituents, sec, iCol, mpi_size, mpi_rank, rc type(MPAS_control_type) :: Cfg integer :: times(6), timee(6), ttime, logUnits(2), nthrds logical :: file_exists + real(MPAS_kind_phys) :: start_time, stop_time + character(len=*), parameter :: subname = 'atmos_model::atmos_model_init' - ! Set up timers - setupClock = mpp_clock_id( 'Time-Step Setup ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - atmiClock = mpp_clock_id( 'ATMosphere Setup ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - radClock = mpp_clock_id( 'Radiation ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - physClock = mpp_clock_id( 'Physics ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - mpasClock = mpp_clock_id( 'MPAS Dycore ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - mpClock = mpp_clock_id( 'Microphysics ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - outClock = mpp_clock_id( 'MPAS Output ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - ! Start timer for this procedure (init). - call mpp_clock_begin(atmiClock) + start_time = MPI_Wtime() + + ! Set MPI bookeeping parameters. + Cfg%master = 0 + Cfg%mpi_comm = mpicomm + call MPI_Comm_rank(MPI_COMM_WORLD, Cfg%me, ierr) + + ! Open log files. + if (Cfg % master == Cfg % me) then + open(newunit=mpas_logfile_funit, file=trim(mpas_logfilename), action='write', status='unknown') + open(newunit=mpas_errfile_funit, file=trim(mpas_errfilename), action='write', status='unknown') + logunits(1) = mpas_logfile_funit + logunits(2) = mpas_errfile_funit + endif ! Set atmospheric model time. Atmos % isAtCapTime = .false. - Atmos % Time_init = Time_init - Atmos % Time = Time - Atmos % Time_step = Time_step - - call get_time (Atmos % Time_step, sec) - Cfg%dt_phys = real(sec) + Atmos % StartTime = StartTime + Atmos % CurrTime = CurrTime + Atmos % StopTime = StopTime + + Cfg%dt_phys = real(dt_atmos) ! Get forecast start/stop times (year/month/day/hour/minute/second) - call get_date(Time_init,times(1),times(2),times(3),times(4),times(5),times(6)) - call get_date(Time_end, timee(1),timee(2),timee(3),timee(4),timee(5),timee(6)) - call get_time(Time_end - Time_init, ttime) - - ! Set MPI bookeeping parameters. - Cfg%me = mpp_pe() - Cfg%master = mpp_root_pe() - Cfg%mpi_comm = mpicomm - - ! Read in ATMosphere namelist. - inquire(file = 'input.nml', exist=file_exists) - if (file_exists) then - read(input_nml_file, nml=atmos_model_nml, iostat=ierr) - if (ierr/=0) call mpp_error(FATAL, 'ERROR When Reading in ATM Namelist') - endif + call ESMF_TimeIntervalGet(StopTime-StartTime, s=ttime, rc=rc) + call ESMF_TimeGet (StartTime, YY=times(1),MM=times(2),DD=times(3),H=times(4),M=times(5),S=times(6),rc=rc) + call ESMF_TimeGet (StopTime, YY=timee(1),MM=timee(2),DD=timee(3),H=timee(4),M=timee(5),S=timee(6),rc=rc) + ! Set forecast time interval + call ESMF_TimeIntervalSet(Atmos % timeStep, s=dt_atmos, rc=rc) + ! - ! Handle constituents (scalars/tracers) + ! Read in ATMosphere namelist (master processor only) ! - - ! Get constituent name(s) and type(s). - ! Active constituents are defined in the FMS "field_table". - call get_number_tracers(MODEL_ATMOS, num_tracers=Cfg % nConstituents) - allocate (Cfg % tracer_names(Cfg % nConstituents), Cfg % tracer_types(Cfg % nConstituents)) - do i = 1, Cfg % nConstituents - call get_tracer_names(MODEL_ATMOS, i, Cfg % tracer_names(i)) - enddo - call get_atmos_tracer_types(Cfg % tracer_types) - - ! Get number of water species. - ! DJS Asks? With FV3, this is set during dycore initialization. How do we get this information - ! here? Does MPAS have a routine for this? - ! - ! It would be simple, albeit not the most elegant thing, but we could create a simple routine - ! that has a list of "known MPAS water species" and compare each "tracer_name" to that. - ! A more robust solution IMO would be to quiery the field table entries for a "water-species" - ! attribute, or something along those lines. Actually, I think this is straightforward if we - ! extend ../ufsatm_util.F90. + if ( Cfg%me == Cfg%master) then + inquire(file = trim(nml_filename), exist=file_exists) + if (file_exists) then + open(newunit=nml_funit,file=trim(nml_filename),status='unknown') + read(nml_funit, nml=atmos_model_nml, iostat=ierr) + if (ierr/=0) then + print*,'ERROR: When Reading in ATM Namelist' + stop + endif + endif + end if + ! Broadcast ATMosphere namelist to all processors. + call mpi_barrier(Cfg%mpi_comm, ierr) + call mpi_bcast(regional, 1, MPI_LOGICAL, Cfg%master, Cfg%mpi_comm, ierr) + call mpi_bcast(dycore_only, 1, MPI_LOGICAL, Cfg%master, Cfg%mpi_comm, ierr) + call mpi_bcast(debug, 1, MPI_LOGICAL, Cfg%master, Cfg%mpi_comm, ierr) + call mpi_bcast(ccpp_suite, len(ccpp_suite), MPI_CHARACTER, Cfg%master, Cfg%mpi_comm, ierr) + call mpi_bcast(blocksize, 1, MPI_INTEGER, Cfg%master, Cfg%mpi_comm, ierr) + call mpi_bcast(ic_filename, len(ic_filename), MPI_CHARACTER, Cfg%master, Cfg%mpi_comm, ierr) + call mpi_bcast(lbc_filename, len(lbc_filename), MPI_CHARACTER, Cfg%master, Cfg%mpi_comm, ierr) + call mpi_bcast(stream_list_history, len(stream_list_history), MPI_CHARACTER, Cfg%master, Cfg%mpi_comm, ierr) + call mpi_bcast(stream_list_restart, len(stream_list_restart), MPI_CHARACTER, Cfg%master, Cfg%mpi_comm, ierr) + call mpi_bcast(stream_list_diag, len(stream_list_diag), MPI_CHARACTER, Cfg%master, Cfg%mpi_comm, ierr) ! - ! From field_tables: - ! For RRFS MPAS we have: 11 water tracers (ql,qc,qi,qr,qs,qg,nc,nc,ni,nr,ng) - ! 2 prog. tracers (o3,sgs-tke) - ! For GFSv17 MPAS we have: 6 water species (ql,qc,qi,qr,qs,qg) - ! 4 prog. tracers (o3,sgs-tke,cld_amt,sigma_b) + ! Handle constituents (scalars/tracers) + ! Cfg % nwat = 6 - - call get_number_tracers(MODEL_ATMOS, num_tracers=Cfg % nConstituents) + call get_number_tracers(tracer_funit, tracer_filename, Cfg % nConstituents) allocate (constituent_name(Cfg % nConstituents), is_water_species(Cfg % nConstituents)) + allocate (Cfg % tracer_names(Cfg % nConstituents), Cfg % tracer_types(Cfg % nConstituents)) + call get_tracer_names(tracer_funit, tracer_filename, Cfg % nConstituents, Cfg % nwat) do i = 1, Cfg % nConstituents - call get_tracer_names(MODEL_ATMOS, i, constituent_name(i)) + Cfg % tracer_names(i) = trim(constituent_name(i)) enddo - is_water_species(:) = .false. - is_water_species(1:Cfg % nwat) = .true. ! Open (PIO) MPAS Initial Condition (IC) file. - call ufs_mpas_open_init() + call ufs_mpas_open_init(ierr) + if (ierr/=0) then + print*,'ERROR: Could not open MPAS IC file' + stop + end if ! Open (PIO) MPAS Lateral Boundary Condition (LBC) file. if (regional) then - call ufs_mpas_open_lbc() + call ufs_mpas_open_lbc(ierr) + if (ierr/=0) then + print*,'ERROR: Could not open MPAS LBC file' + stop + endif endif ! Call MPAS initialization. @@ -213,17 +212,12 @@ subroutine atmos_model_init(Atmos, Time_init, Time, Time_end, Time_step, mpicomm ! - Set up MPAS logging ! - Read in static data, setup MPAS invariant stream ! - Setup physical constants used by MPAS dycore - logUnits(1) = stdout() - logUnits(2) = stdlog() + call ufs_mpas_init(Cfg, times, timee, ttime, calendar, logUnits, mpas_from_ufs_cnst, ufs_from_mpas_cnst, debug) - ! DJS2025: This is for UWM RT logging only. Can be removed when MPAS output is added. - if (Cfg % master == Cfg % me) then - open(unit=mpas_logfile_handle, file='mpas_log.txt', action='write', status='unknown') - logunits(1) = mpas_logfile_handle - logunits(2) = mpas_logfile_handle - endif - - call ufs_mpas_init(Cfg, times, timee, ttime, calendar, logUnits, mpas_from_ufs_cnst, ufs_from_mpas_cnst) + ! + ! Read in MPAS Stream_list file(s) (master processor only in ufs_mpas_read_stream_lists) + ! + call ufs_mpas_read_stream_lists(Cfg%me, Cfg%master, Cfg%mpi_comm) !> ######################################################################################### !> ######################################################################################### @@ -241,8 +235,8 @@ subroutine atmos_model_init(Atmos, Time_init, Time, Time_end, Time_step, mpicomm #else nthrds = 1 #endif - ! Set file ID for log file - Cfg%nlunit = stdlog() + ! Set file ID for namelist file + Cfg%nlunit = nml_funit ! Number of physics blocks Atmos % nblks = nCellsSolve / blocksize @@ -258,16 +252,12 @@ subroutine atmos_model_init(Atmos, Time_init, Time, Time_end, Time_step, mpicomm ! Update time (UFS specific time formatting array) Cfg%bdat(:) = 0 - call get_date (Time_init, Cfg%bdat(1), Cfg%bdat(2), Cfg%bdat(3), Cfg%bdat(5), Cfg%bdat(6), Cfg%bdat(7)) + call ESMF_TimeGet (StartTime, YY=Cfg%bdat(1),MM=Cfg%bdat(2),DD=Cfg%bdat(3),H=Cfg%bdat(4),M=Cfg%bdat(5),S=Cfg%bdat(6),rc=rc) Cfg%cdat(:) = 0 - call get_date (Time, Cfg%cdat(1), Cfg%cdat(2), Cfg%cdat(3), Cfg%cdat(5), Cfg%cdat(6), Cfg%cdat(7)) - - ! Allocate required to work around GNU compiler bug 100886 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886 - allocate(Cfg%input_nml_file, mold=input_nml_file) - Cfg%input_nml_file => input_nml_file - Cfg%fn_nml='using internal file' + call ESMF_TimeGet (CurrTime, YY=Cfg%cdat(1),MM=Cfg%cdat(2),DD=Cfg%cdat(3),H=Cfg%cdat(4),M=Cfg%cdat(5),S=Cfg%cdat(6),rc=rc) ! Read in physics namelist and allocate data containers. + Cfg%fn_nml = nml_filename call MPAS_initialize(UFSATM_control, UFSATM_intdiag, UFSATM_grid, UFSATM_tbd, UFSATM_sfcprop, & UFSATM_statein, UFSATM_stateout, UFSATM_cldprop, UFSATM_radtend, UFSATM_coupling, Cfg) @@ -287,11 +277,11 @@ subroutine atmos_model_init(Atmos, Time_init, Time, Time_end, Time_step, mpicomm ! Initialize the CCPP framework call CCPP_step (step="init", nblks=Atmos % nblks, ierr=ierr, dycore='mpas') - if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP init step failed') + if (ierr/=0) call mpas_log_write(subname // " ERROR: Call to CCPP init step failed",messageType=MPAS_LOG_CRIT) ! Initialize the CCPP physics call CCPP_step (step="physics_init", nblks=Atmos % nblks, ierr=ierr, dycore='mpas') - if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP physics_init step failed') + if (ierr/=0) call mpas_log_write(subname // " ERROR: Call to CCPP physics_init step failed",messageType=MPAS_LOG_CRIT) ! Initialize stochastic physics pattern generation / cellular automata ! NOT YET IMPLEMENTED @@ -299,7 +289,8 @@ subroutine atmos_model_init(Atmos, Time_init, Time, Time_end, Time_step, mpicomm ! Initialize three-dimensional physics. ! NOT YET IMPLEMENTED - call mpp_clock_end(atmiClock) + stop_time = MPI_Wtime() + atmiClock = atmiClock + (stop_time - start_time) ! end subroutine atmos_model_init @@ -308,16 +299,29 @@ end subroutine atmos_model_init !> !> ######################################################################################### subroutine atmos_model_end(Atmos) + use ufs_mpas_tools, only : stringify type (atmos_control_type), intent(inout) :: Atmos ! Locals integer :: ierr - - close(unit=mpas_logfile_handle) + character(len=*), parameter :: subname = 'atmos_model::atmos_model_end' ! Finalize the CCPP physics. call CCPP_step (step="finalize", nblks=Atmos % nblks, ierr=ierr, dycore='mpas') - if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP finalize step failed') - + if (ierr/=0) call mpas_log_write(subname // " ERROR: Call to CCPP finalize step failed",messageType=MPAS_LOG_CRIT) + + call mpas_log_write('------------------------------------------------------------------') + call mpas_log_write('UFSATM-MPAS Timing Information (seconds):') + call mpas_log_write('Total runtime: '// stringify([setupClock+atmiClock+radClock+physClock+mpasClock+mpClock+outClock])) + call mpas_log_write('Time-Step Setup: '// stringify([setupClock])) + call mpas_log_write('ATMosphere Initialization: '// stringify([atmiClock])) + call mpas_log_write('CCPP Radiation: '// stringify([radClock])) + call mpas_log_write('CCPP Physics: '// stringify([physClock])) + call mpas_log_write('MPAS Dynamics: '// stringify([mpasClock])) + call mpas_log_write('CCPP Microphysics: '// stringify([mpClock])) + call mpas_log_write('MPAS Output '// stringify([outClock])) + call mpas_log_write('------------------------------------------------------------------') + close(unit=mpas_logfile_funit) + close(unit=mpas_errfile_funit) end subroutine atmos_model_end !> ######################################################################################### @@ -329,18 +333,21 @@ subroutine atmos_model_radiation_physics(Atmos) type (atmos_control_type), intent(inout) :: Atmos ! Locals integer :: ierr + real(MPAS_kind_phys) :: start_time, stop_time + character(len=*), parameter :: subname = 'atmos_model::atmos_model_radiation_physics' ! Populate physics inputs with MPAS data. call ufs_mpas_to_physics(UFSATM_statein, UFSATM_sfcprop) ! Call CCPP Timestep_initialize Group - call mpp_clock_begin(setupClock) + start_time = MPI_Wtime() call CCPP_step (step="timestep_init", nblks=Atmos % nblks, ierr=ierr, dycore='mpas') - if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_init step failed') - call mpp_clock_end(setupClock) + if (ierr/=0) call mpas_log_write(subname // " ERROR: Call to CCPP timestep_init step failed",messageType=MPAS_LOG_CRIT) + stop_time = MPI_Wtime() + setupClock = setupClock + (stop_time - start_time) ! Call CCPP Radiation Group - call mpp_clock_begin(radClock) + start_time = MPI_Wtime() if (UFSATM_control%lsswr .or. UFSATM_control%lslwr) then ! DJS to GJF: If you un comment this line, you will get an error in the RRTMG radiation. ! Needless to say, I didn't see why, but I assume it is due to one of the many instances @@ -349,16 +356,18 @@ subroutine atmos_model_radiation_physics(Atmos) ! already, GFS_rad_time_vary.mpas.F90. I don't think it is complete. ! !call CCPP_step (step="radiation", nblks=Atmos % nblks, ierr=ierr, dycore='mpas') - if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP radiation step failed') + if (ierr/=0) call mpas_log_write(subname // " ERROR: Call to CCPP radiation step failed",messageType=MPAS_LOG_CRIT) endif - call mpp_clock_end(radClock) + stop_time = MPI_Wtime() + radClock = radClock + (stop_time - start_time) ! Call CCPP Physics Group ! NOT YET IMPLEMENTED in SDF - call mpp_clock_begin(physClock) + start_time = MPI_Wtime() call CCPP_step (step="physics", nblks=Atmos % nblks, ierr=ierr, dycore='mpas') - if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP physics step failed') - call mpp_clock_end(physClock) + if (ierr/=0) call mpas_log_write(subname // " ERROR: Call to CCPP physics step failed",messageType=MPAS_LOG_CRIT) + stop_time = MPI_Wtime() + physClock = physClock + (stop_time - start_time) end subroutine atmos_model_radiation_physics @@ -372,13 +381,14 @@ subroutine atmos_model_dynamics(Atmos) use MPAS_init, only : MPAS_initialize type (atmos_control_type), intent(inout) :: Atmos - + real(MPAS_kind_phys) :: start_time, stop_time + ! Prepare MPAS dycore inputs with CCPP physics outputs. ! NOT YET IMPLEMENTED call ufs_physics_to_mpas() ! Call MPAS dycore - call ufs_mpas_run(mpasClock, outClock) + call ufs_mpas_run(mpasClock, outClock, debug) end subroutine atmos_model_dynamics @@ -391,24 +401,28 @@ subroutine atmos_model_microphysics(Atmos) type (atmos_control_type), intent(inout) :: Atmos ! Locals integer :: ierr - + character(len=*), parameter :: subname = 'atmos_model::atmos_model_microphysics' + real(MPAS_kind_phys) :: start_time, stop_time + ! Prepare CCPP physics inputs with MPAS dycore outputs. ! NOT YET IMPLEMENTED call ufs_mpas_to_microphysics(UFSATM_statein) ! Call CCPP Microphysics Group ! NOT YET IMPLEMENTED in SDF - call mpp_clock_begin(mpClock) + start_time = MPI_Wtime() call CCPP_step (step="microphysics", nblks=Atmos % nblks, ierr=ierr, dycore='mpas') - if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP microphysics step failed') - call mpp_clock_end(mpClock) + if (ierr/=0) call mpas_log_write(subname // " ERROR: Call to CCPP microphysics step failed",messageType=MPAS_LOG_CRIT) + stop_time = MPI_Wtime() + mpClock = mpClock + (stop_time - start_time) ! Call CCPP Timestep_finalize Group - call mpp_clock_begin(setupClock) + start_time = MPI_Wtime() call CCPP_step (step="timestep_finalize", nblks=Atmos % nblks, ierr=ierr, dycore='mpas') - if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_finalize step failed') - call mpp_clock_end(setupClock) - + if (ierr/=0) call mpas_log_write(subname // " ERROR: Call to CCPP timestep_finalize step failed",messageType=MPAS_LOG_CRIT) + stop_time = MPI_Wtime() + setupClock = setupClock + (stop_time - start_time) + ! Prepare MPAS dycore inputs with CCPP physics outputs. call ufs_microphysics_to_mpas(UFSATM_stateout) @@ -420,9 +434,65 @@ end subroutine atmos_model_microphysics !> ######################################################################################### subroutine update_atmos_model_state(Atmos) type (atmos_control_type), intent(inout) :: Atmos + character(len=*), parameter :: subname = 'atmos_model::update_atmos_model_state' ! Advance time - Atmos % Time = Atmos % Time + Atmos % Time_step + !Atmos % Time = Atmos % Time + Atmos % Time_step + Atmos % CurrTime = Atmos % CurrTime + Atmos % TimeStep end subroutine update_atmos_model_state + !> ######################################################################################### + !> Internal procedure to get the number of tracers (lines) in the tracer table file. + !> + !> ######################################################################################### + subroutine get_number_tracers(funit, fname, flines) + integer, intent(inout) :: funit + character(len=*), intent(in) :: fname + integer, intent(out) :: flines + character(len=1) :: dummy + integer :: status + + ! Get number of lines (tracers) in file + flines = 0 + open(newunit=funit,file=trim(fname),status='unknown') + do + read(funit, "(a)",iostat=status) dummy + if (status /= 0) exit + flines = flines + 1 + enddo + close(funit) + end subroutine get_number_tracers + !> ######################################################################################### + !> Internal procedure to get tracer names from the tracer table file. + !> ach line of the tracer table is of this format: (a10,a,a40,a,a10,a,i1) + !> + !> ######################################################################################### + subroutine get_tracer_names(funit, fname, ntracers, nwat) + integer, intent(inout) :: funit + character(len=*), intent(in) :: fname + integer, intent(in) :: ntracers + integer, intent(out) :: nwat + + integer :: itracer, status + character(len=10) :: tracer_name + character(len=1) :: c1,c2,c3 + character(len=40) :: tracer_long_name + character(len=10) :: tracer_unit + integer :: tracer_type + + nwat = 0 + is_water_species(:) = .false. + open(newunit=funit,file=trim(fname),status='unknown') + do itracer=1,ntracers + read(funit, "(a10,a,a40,a,a10,a,i1)",iostat=status) tracer_name,c1,tracer_long_name,c2,tracer_unit,c3,tracer_type + constituent_name(itracer) = tracer_name + if (tracer_type == 0) then + is_water_species(itracer) = .true. + nwat = nwat+1 + endif + enddo + close(funit) + + end subroutine get_tracer_names + end module atmos_model_mod diff --git a/mpas/module_fcst_grid_comp.F90 b/mpas/module_fcst_grid_comp.F90 index 210b63a85..cd0d0a247 100644 --- a/mpas/module_fcst_grid_comp.F90 +++ b/mpas/module_fcst_grid_comp.F90 @@ -10,25 +10,13 @@ module module_fcst_grid_comp use mpi_f08 use esmf use nuopc - use time_manager_mod, only: time_type, set_calendar_type, set_time, set_date, & - month_name, operator(+), operator(-), operator (<), & - operator (>), operator (/=), operator (/), operator (==), & - operator (*), THIRTY_DAY_MONTHS, JULIAN, GREGORIAN, NOLEAP, & - NO_CALENDAR, date_to_string, get_date, get_time use atmos_model_mod, only: atmos_model_init, atmos_model_end, atmos_control_type use atmos_model_mod, only: atmos_model_radiation_physics, atmos_model_dynamics, & atmos_model_microphysics, update_atmos_model_state - use constants_mod, only: constants_init - use fms_mod, only: error_mesg, fms_init, fms_end, write_version_number, & - uppercase - use mpp_mod, only: mpp_init, mpp_pe, mpp_npes, mpp_root_pe, & - mpp_set_current_pelist, mpp_error, FATAL, WARNING, NOTE - use mpp_mod, only: mpp_clock_id, mpp_clock_begin - use sat_vapor_pres_mod, only: sat_vapor_pres_init - use diag_manager_mod, only: diag_manager_init, diag_manager_end, & - diag_manager_set_time_end use module_mpas_config, only: dt_atmos, fcst_mpi_comm, fcst_ntasks, calendar use CCPP_data, only: GFS_control + use mpas_log, only : mpas_log_write + use mpas_derived_types, only : MPAS_LOG_CRIT implicit none private @@ -42,7 +30,11 @@ module module_fcst_grid_comp integer :: date_init(6) integer :: mype = 0 + integer, parameter :: THIRTY_DAY_MONTHS = 1, JULIAN = 2, & + GREGORIAN = 3, NOLEAP = 4, & + NO_CALENDAR = 0, INVALID_CALENDAR =-1 + public SetServices contains @@ -105,9 +97,8 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) type(ESMF_Config) :: cf real(kind=8) :: tbeg1 logical :: fexist - integer :: initClock, io_unit, calendar_type_res, date_res(6), date_init_res(6) + integer :: io_unit, calendar_type_res, date_res(6), date_init_res(6) integer,dimension(6) :: date, date_end, days - type(time_type) :: Time_init, Time, Time_step, Time_end, Time_restart, Time_step_restart ! Initialize ESMF error message. rc = ESMF_SUCCESS @@ -130,15 +121,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) call ESMF_ConfigLoadFile(config=CF ,filename='model_configure' ,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call fms_init(fcst_mpi_comm%mpi_val) - call mpp_init() - initClock = mpp_clock_id( 'Initialization' ) - call mpp_clock_begin (initClock) !nesting problem - - call constants_init - call sat_vapor_pres_init - - select case( uppercase(trim(calendar)) ) + select case( ESMF_UtilStringUpperCase(trim(calendar)) ) case( 'JULIAN' ) calendar_type = JULIAN case( 'GREGORIAN' ) @@ -150,11 +133,12 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) case( 'NO_CALENDAR' ) calendar_type = NO_CALENDAR case default - call mpp_error ( FATAL, 'fcst_initialize: calendar must be one of '// & - 'JULIAN|GREGORIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) + call mpas_log_write( 'fcst_initialize: calendar must be one of '// & + 'JULIAN|GREGORIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.',& + messageType=MPAS_LOG_CRIT) end select - call set_calendar_type (calendar_type) + !call set_calendar_type (calendar_type) ! ! Set atmos time. @@ -168,9 +152,6 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) YY=date_init(1), MM=date_init(2), DD=date_init(3), & H=date_init(4), M =date_init(5), S =date_init(6), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - Time_init = set_date (date_init(1), date_init(2), date_init(3), & - date_init(4), date_init(5), date_init(6)) if (mype == 0) write(*,'(A,6I5)') 'in fcst_initialize, StartTime=',date_init date=0 @@ -178,9 +159,6 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) YY=date(1), MM=date(2), DD=date(3), & H=date(4), M =date(5), S =date(6), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - Time = set_date (date(1), date(2), date(3), & - date(4), date(5), date(6)) if (mype == 0) write(*,'(A,6I5)') 'in fcst_initialize, CurrTime =',date date_end=0 @@ -188,9 +166,6 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) YY=date_end(1), MM=date_end(2), DD=date_end(3), & H=date_end(4), M =date_end(5), S =date_end(6), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - Time_end = set_date (date_end(1), date_end(2), date_end(3), & - date_end(4), date_end(5), date_end(6)) if (mype == 0) write(*,'(A,6I5)') 'in fcst_initialize, StopTime =',date_end ! @@ -239,17 +214,13 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) endif ! fexist endif ! mype == 0 - call diag_manager_init (TIME_INIT=date) - call diag_manager_set_time_end(Time_end) - - Time_step = set_time (dt_atmos,0) if (mype == 0) write(*,*)'fcst_initialize, time_init=', date_init,'time=',date,'time_end=',date_end,'dt_atmos=',dt_atmos ! ####################################################################################### ! Initialize component models. ! atmos_model_init() calls the MPAS dycore initialization. ! ####################################################################################### - call atmos_model_init(Atmos, Time_init, Time, Time_end, Time_step, fcst_mpi_comm, calendar) + call atmos_model_init(Atmos, fcst_mpi_comm, calendar, CurrTime, StartTime, StopTime) ! Timing info (debug mode) if (mype == 0) write(*,*)'PASS(fcst_initialize): Time is ', mpi_wtime() - tbeg1 @@ -298,17 +269,18 @@ subroutine fcst_run_phase_1(fcst_comp, importState, exportState, clock, rc) real(kind=8) :: mpi_wtime, tbeg1 logical,save :: first=.true. integer,save :: dt_cap=0 - type(ESMF_Time) :: currTime,stopTime + type(ESMF_Time) :: currTime,stopTime,startTIme ! Timing info. tbeg1 = mpi_wtime() ! Initialize ESMF error message. rc = ESMF_SUCCESS - - call get_time(Atmos%Time - Atmos%Time_init, seconds) + + call ESMF_ClockGet(clock, currTime=currTime, startTime=startTime, rc=rc) + call ESMF_TimeIntervalGet(currTime-StartTime, s=seconds, rc=rc) n_atmsteps = seconds/dt_atmos - + if (first) then call ESMF_ClockGet(clock, currTime=currTime, stopTime=stopTime, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -329,7 +301,6 @@ subroutine fcst_run_phase_1(fcst_comp, importState, exportState, clock, rc) call atmos_model_radiation_physics (Atmos) call atmos_model_dynamics (Atmos) call atmos_model_microphysics (Atmos) - !call update_atmos_model_state(Atmos) ! Timing info (debug mode) if (mype == 0) write(*,'(A,I16,A,F16.6)')'PASS(fcstRUN phase 1), n_atmsteps = ', & @@ -414,8 +385,6 @@ subroutine fcst_finalize(fcst_comp, importState, exportState, clock, rc) tbeg1 = mpi_wtime() call atmos_model_end (Atmos) - call diag_manager_end (Atmos%Time) - call fms_end ! Timing info (debug mode) if (mype == 0) write(*,*)'PASS(fcst_finalize): total is ', mpi_wtime() - tbeg1 diff --git a/mpas/module_mpas_config.F90 b/mpas/module_mpas_config.F90 index 16a9f5961..196bec74d 100644 --- a/mpas/module_mpas_config.F90 +++ b/mpas/module_mpas_config.F90 @@ -9,6 +9,7 @@ module module_mpas_config use mpi_f08 use pio, only : iosystem_desc_t, file_desc_t, io_desc_t use esmf + use mpas_derived_types, only : MPAS_Time_Type implicit none @@ -44,26 +45,54 @@ module module_mpas_config !! hours real,dimension(:),allocatable :: output_fh + !> Restart frequency + real,dimension(:),allocatable :: restart_fh + + !> + integer :: out_file_index = 1 + integer :: restart_file_index = 1 + type (MPAS_Time_Type), allocatable :: mpas_output_times(:) + type (MPAS_Time_Type), allocatable :: mpas_restart_times(:) + !> Calendar type character(17) :: calendar=' ' !> MPAS Initial Condition file (via UFSATM NML) - character(len=256) :: ic_filename + character(len=256) :: ic_filename="" !> MPAS Lateral Boundary Condition file (via UFSATM NML) - character(len=256) :: lbc_filename - - !> MPAS output filenames - character(len=256) :: output_filename = "output.mpas.nc" - character(len=256) :: restart_filename = "restart.mpas.nc" - + character(len=256) :: lbc_filename="" + + !> MPAS stream_list files (i.e. runtime contol over which fields to write) + character(len=256) :: stream_list_history="" + character(len=256) :: stream_list_restart="" + character(len=256) :: stream_list_diag="" + integer :: stream_list_history_funit + integer :: stream_list_restart_funit + integer :: stream_list_diag_funit + + !> MPAS tracer file (via UFSATM NML) + character(len=256) :: tracer_filename="tracer_table" + integer :: tracer_funit + + !> UFSATM namelist filename + character(len=256) :: nml_filename = "input.nml" + integer :: nml_funit + character(len=256) :: mpas_errfilename = "mpas_err.log" + integer :: mpas_errfile_funit + character(len=256) :: mpas_logfilename = "mpas_out.log" + integer :: mpas_logfile_funit + + !> PIO type(iosystem_desc_t), pointer :: pio_subsystem_ic type(iosystem_desc_t), pointer :: pio_subsystem_lbc type(iosystem_desc_t), pointer :: pio_subsystem_output + type(iosystem_desc_t), pointer :: pio_subsystem_restart type(file_desc_t), target :: pioid_ic type(file_desc_t), target :: pioid_lbc type(file_desc_t), target :: pioid_output + type(file_desc_t), target :: pioid_restart type(io_desc_t) :: pio_iodesc integer :: pio_iotype integer :: pio_ioformat diff --git a/mpas/ufs_mpas_boundaries.F90 b/mpas/ufs_mpas_boundaries.F90 index 8f4d72962..add2410ae 100644 --- a/mpas/ufs_mpas_boundaries.F90 +++ b/mpas/ufs_mpas_boundaries.F90 @@ -34,7 +34,7 @@ module ufs_mpas_boundaries !> \update: Dustin Swales September 2025 - Modified for use in UWM !> !> ######################################################################################### - subroutine ufs_mpas_atm_update_bdy_tend(clock, block, firstCall, nRecord, ierr) + subroutine ufs_mpas_atm_update_bdy_tend(clock, block, firstCall, nRecord, ierr, debug) use mpas_constants, only : rvord use mpas_log, only : mpas_log_write use mpas_derived_types, only : MPAS_STREAM_MGR_NOERR, MPAS_LOG_ERR @@ -58,6 +58,7 @@ subroutine ufs_mpas_atm_update_bdy_tend(clock, block, firstCall, nRecord, ierr) logical, intent(in) :: firstCall integer, intent(in) :: nRecord integer, intent(out) :: ierr + logical, intent(in) :: debug character(len=StrKIND) :: lbc_intv_start_string character(len=StrKIND) :: lbc_intv_end_string @@ -112,7 +113,7 @@ subroutine ufs_mpas_atm_update_bdy_tend(clock, block, firstCall, nRecord, ierr) if (firstCall) then call dyn_mpas_read_write_stream(clock, 'r', 'lbc_in', pio_file_desc=pioid_lbc, ierr=ierr, timeLevel=2, & - whence = MPAS_STREAM_LATEST_BEFORE, actualWhen=read_time, nRecord=nRecord) + whence = MPAS_STREAM_LATEST_BEFORE, actualWhen=read_time, nRecord=nRecord, debug=debug) if (ierr /= MPAS_STREAM_MGR_NOERR) then call mpas_log_write('Could not read from ''lbc_in'' stream on or before the current date '// & 'to update lateral boundary tendencies', messageType=MPAS_LOG_ERR) @@ -121,7 +122,7 @@ subroutine ufs_mpas_atm_update_bdy_tend(clock, block, firstCall, nRecord, ierr) else call mpas_pool_shift_time_levels(lbc) call dyn_mpas_read_write_stream(clock, 'r', 'lbc_in', pio_file_desc=pioid_lbc, ierr=ierr, timeLevel=2, & - whence = MPAS_STREAM_EARLIEST_STRICTLY_AFTER, actualWhen=read_time, nRecord=nRecord) + whence = MPAS_STREAM_EARLIEST_STRICTLY_AFTER, actualWhen=read_time, nRecord=nRecord, debug=debug) if (ierr /= MPAS_STREAM_MGR_NOERR) then call mpas_log_write('Could not read from ''lbc_in'' stream after the current date '// & 'to update lateral boundary tendencies', messageType=MPAS_LOG_ERR) diff --git a/mpas/ufs_mpas_constituents.F90 b/mpas/ufs_mpas_constituents.F90 index 9b55be52b..59e15b572 100644 --- a/mpas/ufs_mpas_constituents.F90 +++ b/mpas/ufs_mpas_constituents.F90 @@ -5,8 +5,10 @@ !> !> ########################################################################################### module ufs_mpas_constituents - use mpas_kind_types, only : StrKIND - use ufs_mpas_io, only : domain_ptr + use mpas_kind_types, only : StrKIND + use mpas_log, only : mpas_log_write + use mpas_derived_types, only : MPAS_LOG_CRIT + use ufs_mpas_io, only : domain_ptr implicit none public @@ -41,10 +43,6 @@ subroutine ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_field, & mpas_pool_get_dimension, mpas_pool_add_dimension use mpas_attlist, only : mpas_add_att - use mpas_log, only : mpas_log_write - use mpas_derived_types, only : MPAS_LOG_ERR - ! FMS - use mpp_mod, only : FATAL, mpp_error ! Arguments integer, dimension(:), pointer :: mpas_from_ufs_cnst, ufs_from_mpas_cnst @@ -71,10 +69,8 @@ subroutine ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'state', statePool) if (.not. associated(statePool)) then - call mpas_log_write(trim(subname)//': ERROR: The ''state'' pool was not found.', & - messageType=MPAS_LOG_ERR) - ierr = 1 - return + call mpas_log_write(trim(subname) // 'ERROR: The ''state'' pool was not found.', & + messageType=MPAS_LOG_CRIT) end if nullify(num_scalars) @@ -85,10 +81,8 @@ subroutine ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) ! if this dimension does not exist, something has gone wrong ! if (.not. associated(num_scalars)) then - call mpas_log_write(trim(subname)//': ERROR: The ''num_scalars'' dimension does not exist in the ''state'' pool.', & - messageType=MPAS_LOG_ERR) - ierr = 1 - return + call mpas_log_write(trim(subname) // 'ERROR: The ''num_scalars'' dimension does not exist in the ''state'' pool.', & + messageType=MPAS_LOG_CRIT) end if ! @@ -96,12 +90,10 @@ subroutine ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) ! something has gone wrong ! if (size(constituent_name) /= num_scalars) then - call mpas_log_write(trim(subname)//': ERROR: The number of constituent names is not equal to the num_scalars dimension', & - messageType=MPAS_LOG_ERR) + call mpas_log_write(trim(subname) // 'ERROR: The number of constituent names is not equal to the num_scalars dimension', & + messageType=MPAS_LOG_CRIT) call mpas_log_write('size(constituent_name) = $i, num_scalars = $i', intArgs=[size(constituent_name), num_scalars], & - messageType=MPAS_LOG_ERR) - ierr = 1 - return + messageType=MPAS_LOG_CRIT) end if ! @@ -110,9 +102,8 @@ subroutine ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) ! if (size(constituent_name) > 0) then if (trim(constituent_name(1)) /= 'qv') then - call mpas_log_write(trim(subname)//': ERROR: The first constituent is not qv', messageType=MPAS_LOG_ERR) - ierr = 1 - return + call mpas_log_write(trim(subname) // 'ERROR: The first constituent is not qv', & + messageType=MPAS_LOG_CRIT) end if end if @@ -120,7 +111,10 @@ subroutine ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) ! Determine which of the constituents are moisture species ! allocate(mpas_from_ufs_cnst(num_scalars), stat=ierr) - if( ierr /= 0 ) call mpp_error(FATAL,subname//':failed to allocate mpas_from_ufs_cnst array') + if( ierr /= 0 ) then + call mpas_log_write(trim(subname) // 'ERROR: failed to allocate mpas_from_ufs_cnst array', & + messageType=MPAS_LOG_CRIT) + end if mpas_from_ufs_cnst(:) = 0 num_moist = 0 do i = 1, size(constituent_name) @@ -153,7 +147,10 @@ subroutine ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) ! Create inverse map, ufs_from_mpas_cnst ! allocate(ufs_from_mpas_cnst(num_scalars), stat=ierr) - if( ierr /= 0 ) call mpp_error(FATAL,subname//':failed to allocate ufs_from_mpas_cnst array') + if( ierr /= 0 ) then + call mpas_log_write(trim(subname)//'ERROR: failed to allocate ufs_from_mpas_cnst array', & + messageType=MPAS_LOG_CRIT) + end if ufs_from_mpas_cnst(:) = 0 do i = 1, size(constituent_name) @@ -167,8 +164,8 @@ subroutine ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) call mpas_pool_get_field(statePool, 'scalars', scalarsField, timeLevel=i) if (.not. associated(scalarsField)) then - call mpas_log_write(trim(subname)//': ERROR: The ''scalars'' field was not found in the ''state'' pool', & - messageType=MPAS_LOG_ERR) + call mpas_log_write(trim(subname)//'ERROR: The ''scalars'' field was not found in the ''state'' pool', & + messageType=MPAS_LOG_CRIT) ierr = 1 return end if @@ -217,9 +214,7 @@ subroutine ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) if (.not. associated(tendPool)) then call mpas_log_write(trim(subname)//': ERROR: The ''tend'' pool was not found.', & - messageType=MPAS_LOG_ERR) - ierr = 1 - return + messageType=MPAS_LOG_CRIT) end if timeLevs = 1 @@ -230,9 +225,7 @@ subroutine ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) if (.not. associated(scalarsField)) then call mpas_log_write(trim(subname)//': ERROR: The ''scalars_tend'' field was not found in the ''tend'' pool', & - messageType=MPAS_LOG_ERR) - ierr = 1 - return + messageType=MPAS_LOG_CRIT) end if if (i == 1) call mpas_pool_add_dimension(tendPool, 'index_qv', 1) @@ -260,11 +253,10 @@ end subroutine ufs_mpas_define_scalars !> !> ######################################################################################### subroutine ufs_mpas_define_lbc_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) - use mpas_derived_types, only : mpas_pool_type, field3dReal, MPAS_LOG_ERR + use mpas_derived_types, only : mpas_pool_type, field3dReal use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_field use mpas_pool_routines, only : mpas_pool_get_dimension, mpas_pool_add_dimension use mpas_attlist, only : mpas_add_att - use mpas_log, only : mpas_log_write ! Arguments integer, dimension(:), pointer :: mpas_from_ufs_cnst, ufs_from_mpas_cnst @@ -286,10 +278,8 @@ subroutine ufs_mpas_define_lbc_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, i call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'lbc', lbcPool) if (.not. associated(lbcPool)) then - call mpas_log_write(trim(subname)//': ERROR: The ''lbc'' pool was not found.', & - messageType=MPAS_LOG_ERR) - ierr = 1 - return + call mpas_log_write(trim(subname) // 'ERROR: The ''lbc'' pool was not found.', & + messageType=MPAS_LOG_CRIT) end if nullify(num_scalars) @@ -300,10 +290,8 @@ subroutine ufs_mpas_define_lbc_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, i ! if this dimension does not exist, something has gone wrong. ! if (.not. associated(num_scalars)) then - call mpas_log_write(trim(subname)//': ERROR: The ''num_scalars'' dimension does not exist in the ''lbc'' pool.', & - messageType=MPAS_LOG_ERR) - ierr = 1 - return + call mpas_log_write(trim(subname) // 'ERROR: The ''num_scalars'' dimension does not exist in the ''lbc'' pool.', & + messageType=MPAS_LOG_CRIT) end if timeLevs = 2 @@ -313,8 +301,8 @@ subroutine ufs_mpas_define_lbc_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, i call mpas_pool_get_field(lbcPool, 'lbc_scalars', scalarsField, timeLevel=i) if (.not. associated(scalarsField)) then - call mpas_log_write(trim(subname)//': ERROR: The ''lbc_scalars'' field was not found in the ''lbc'' pool', & - messageType=MPAS_LOG_ERR) + call mpas_log_write(trim(subname) // 'ERROR: The ''lbc_scalars'' field was not found in the ''lbc'' pool', & + messageType=MPAS_LOG_CRIT) ierr = 1 return end if diff --git a/mpas/ufs_mpas_io.F90 b/mpas/ufs_mpas_io.F90 index 046f57315..926963d6c 100644 --- a/mpas/ufs_mpas_io.F90 +++ b/mpas/ufs_mpas_io.F90 @@ -16,12 +16,19 @@ module ufs_mpas_io use mpas_derived_types, only : core_type, domain_type, mpas_Clock_type use mpas_derived_types, only : MPAS_Time_Type use mpas_kind_types, only : StrKIND + use mpas_log, only : mpas_log_write + use mpas_derived_types, only : MPAS_LOG_CRIT, MPAS_LOG_WARN use module_mpas_config, only : pio_iotype, pio_stride, pio_numiotasks, pio_iodesc - use module_mpas_config, only : lbc_filename, pioid_lbc, pio_subsystem_lbc - use module_mpas_config, only : ic_filename, pioid_ic, pio_subsystem_ic - use module_mpas_config, only : pioid_output, pio_subsystem_output + use module_mpas_config, only : lbc_filename, pioid_lbc, pio_subsystem_lbc + use module_mpas_config, only : ic_filename, pioid_ic, pio_subsystem_ic + use module_mpas_config, only : pioid_restart, pio_subsystem_restart + use module_mpas_config, only : pioid_output, pio_subsystem_output + use module_mpas_config, only : stream_list_history, stream_list_history_funit + use module_mpas_config, only : stream_list_diag, stream_list_diag_funit + use module_mpas_config, only : stream_list_restart, stream_list_restart_funit use module_mpas_config, only : TIMELEVEL_NOW use ufs_mpas_tools, only : stringify + use mpi_f08 implicit none ! @@ -29,10 +36,6 @@ module ufs_mpas_io type(domain_type), pointer :: domain_ptr => null() type(mpas_Clock_type), pointer :: clock => null() - ! - integer :: out_file_index - type (MPAS_Time_Type), allocatable :: mpas_output_times(:) - !> ######################################################################################### !> !> ######################################################################################### @@ -42,6 +45,14 @@ module ufs_mpas_io integer :: rank = 0 end type var_info_type + !> ######################################################################################### + !> These variable lists are set at runtime via the stream_list.atmosphere.STREAM files. + !> + !> ######################################################################################### + integer, allocatable :: stream_list_history_indices(:) + integer, allocatable :: stream_list_restart_indices(:) + integer, allocatable :: stream_list_diag_indices(:) + !> ######################################################################################### !> This list corresponds to the "lbc_in" stream in core_atmosphere/Registry.xml !> It consists of variables that are members of the "lbc" structure. @@ -231,19 +242,29 @@ module ufs_mpas_io !> Only variables that are specific to the "restart" stream are included. !> ######################################################################################### type(var_info_type), parameter :: restart_var_info_list(*) = [ & + var_info_type('scalars' , 'real' , 3), & + var_info_type('initial_time' , 'character' , 0), & + var_info_type('Time' , 'real' , 0), & + var_info_type('u' , 'real' , 2), & + var_info_type('w' , 'real' , 2), & + var_info_type('rho_zz' , 'real' , 2), & + var_info_type('theta_m' , 'real' , 2), & + var_info_type('pressure_p' , 'real' , 2), & + var_info_type('rho' , 'real' , 2), & + var_info_type('theta' , 'real' , 2), & + var_info_type('relhum' , 'real' , 2), & + var_info_type('circulation' , 'real' , 2), & var_info_type('exner' , 'real' , 2), & var_info_type('exner_base' , 'real' , 2), & - var_info_type('pressure_base' , 'real' , 2), & - var_info_type('pressure_p' , 'real' , 2), & - var_info_type('rho_p' , 'real' , 2), & - var_info_type('rho_zz' , 'real' , 2), & var_info_type('rtheta_base' , 'real' , 2), & + var_info_type('pressure_base' , 'real' , 2), & var_info_type('rtheta_p' , 'real' , 2), & var_info_type('ru' , 'real' , 2), & var_info_type('ru_p' , 'real' , 2), & var_info_type('rw' , 'real' , 2), & var_info_type('rw_p' , 'real' , 2), & - var_info_type('theta_m' , 'real' , 2) & + var_info_type('rho_p' , 'real' , 2), & + var_info_type('surface_pressure' , 'real' , 1) & ] !> ######################################################################################### @@ -251,22 +272,22 @@ module ufs_mpas_io !> It consists of variables that are members of the "diag" structure. !> Only variables that are specific to the "output" stream are included. !> ######################################################################################### - type(var_info_type), parameter :: output_var_info_list(*) = [ & + type(var_info_type), parameter :: history_var_info_list(*) = [ & var_info_type('Time' , 'real' , 0), & var_info_type('initial_time' , 'character' , 0), & - !var_info_type('divergence' , 'real' , 2), & - !var_info_type('pressure' , 'real' , 2), & - !var_info_type('relhum' , 'real' , 2), & - !var_info_type('rho' , 'real' , 2), & + var_info_type('divergence' , 'real' , 2), & + var_info_type('pressure' , 'real' , 2), & + var_info_type('relhum' , 'real' , 2), & + var_info_type('rho' , 'real' , 2), & var_info_type('scalars' , 'real' , 3), & var_info_type('surface_pressure' , 'real' , 1), & var_info_type('theta' , 'real' , 2), & - !var_info_type('u' , 'real' , 2), & + var_info_type('u' , 'real' , 2), & var_info_type('uReconstructMeridional' , 'real' , 2), & var_info_type('uReconstructZonal' , 'real' , 2), & var_info_type('vorticity' , 'real' , 2), & - var_info_type('w' , 'real' , 2) & - !var_info_type('zz' , 'real' , 2) & + var_info_type('w' , 'real' , 2), & + var_info_type('zz' , 'real' , 2) & ] contains @@ -275,74 +296,219 @@ module ufs_mpas_io !> Procedure to open MPAS IC file. !> !> ######################################################################################### - subroutine ufs_mpas_open_init() - ! PIO - use pio, only : pio_openfile, pio_nowrite - ! FMS - use fms2_io_mod, only : file_exists - use mpp_mod, only : FATAL, mpp_error - ! Arguments - ! Locals - integer :: ierr - character(len=*), parameter :: subname = 'ufs_mpas_subdriver::ufs_mpas_open_init' + subroutine ufs_mpas_open_init(ierr) + use pio, only : pio_openfile, pio_nowrite + integer, intent(out) :: ierr + logical :: file_exists ! Open MPAS Initial Condition file. - if (file_exists(ic_filename)) then + ierr = 0 + INQUIRE(FILE=ic_filename, EXIST=file_exists) + if (file_exists) then ierr = pio_openfile(pio_subsystem_ic, pioid_ic, pio_iotype, ic_filename, pio_nowrite) - if (ierr /= 0) then - call mpp_error(FATAL,subname//": Failed opening MPAS IC File, "//trim(ic_filename)) - end if else - call mpp_error(FATAL,subname//": Cannot find MPAS IC file: "//trim(ic_filename)) + ierr = -1 end if + end subroutine ufs_mpas_open_init !> ######################################################################################### !> Procedure to open MPAS Lateral Boundary Condition file. !> !> ######################################################################################### - subroutine ufs_mpas_open_lbc() - ! PIO - use pio, only : pio_openfile, pio_nowrite - ! FMS - use fms2_io_mod, only : file_exists - use mpp_mod, only : FATAL, mpp_error - ! Arguments - ! Locals - integer :: ierr - character(len=*), parameter :: subname = 'ufs_mpas_subdriver::ufs_mpas_open_lbc' + subroutine ufs_mpas_open_lbc(ierr) + use pio, only : pio_openfile, pio_nowrite + integer, intent(out) :: ierr + logical :: file_exists ! Open MPAS Initial Condition file. - if (file_exists(lbc_filename)) then + ierr = 0 + INQUIRE(FILE=lbc_filename, EXIST=file_exists) + if (file_exists) then ierr = pio_openfile(pio_subsystem_lbc, pioid_lbc, pio_iotype, lbc_filename, pio_nowrite) - if (ierr /= 0) then - call mpp_error(FATAL,subname//": Failed opening MPAS LBC File, "//trim(lbc_filename)) - end if else - call mpp_error(FATAL,subname//": Cannot find MPAS LBC file: "//trim(lbc_filename)) + ierr = -1 end if + end subroutine ufs_mpas_open_lbc + !> ######################################################################################### + !> Procedure to read in stream_list (a.k.a File with fields to include in output stream) + !> + !> ######################################################################################### + subroutine ufs_mpas_read_stream_lists(me, master, mpicomm) + ! Arguments + integer, intent(in) :: me, master + type(MPI_Comm), intent(in) :: mpicomm + ! Locals + character(len=*), parameter :: subname = 'ufs_mpas_io::ufs_mpas_read_stream_list' + + ! Output stream + call read_stream_list(me, master, mpicomm, stream_list_history, stream_list_history_funit, 'history') + + ! Diag stream + !call read_stream_list(me, master, mpicomm, stream_list_diag, stream_list_diag_funit, 'diag') + + ! Restart stream + !call read_stream_list(me, master, mpicomm, stream_list_restart, stream_list_restart_funit, 'restart') + + end subroutine ufs_mpas_read_stream_lists + + !> ######################################################################################### + !> The procedure reads in a MPAS stream_list and compares the requested variables in the + !> to the available varaibles in _var_info_list. + !> + !> If no MPAS stream_list is provided, all fields included in _var_info_list + !> will be included in the output file. + !> + !> ######################################################################################### + subroutine read_stream_list(me, master, mpicomm, stream_list_file, funit, stream_name) + integer, intent(in) :: me, master + type(MPI_Comm), intent(in) :: mpicomm + character(len=*), intent(in) :: stream_list_file + integer, intent(inout) :: funit + character(len=*), intent(in) :: stream_name + integer :: nvars, ivar, io, i, nvar_av, count, mpierr + logical :: file_exists, found + character(len=128) :: line_buffer + character(len=128), allocatable :: var_list(:) + integer, allocatable :: indices_temp(:), indices(:) + character(len=*), parameter :: subname = 'ufs_mpas_io::read_stream_list' + type(var_info_type), allocatable :: var_info_list(:) + + ! Check if file exists before trying to read. + file_exists = .false. + INQUIRE(FILE=stream_list_file, EXIST=file_exists) + if (.not. file_exists) then + call mpas_log_write(subname // " No stream_list file provided for "//trim(stream_name)// & + ". All available fields will be output", messageType=MPAS_LOG_WARN) + return + end if + + ! Set var_info_list for given . + select case (trim(adjustl(stream_name))) + case ('') + allocate(var_info_list(0)) + case ('restart') + allocate(var_info_list, source=restart_var_info_list) + case ('history') + allocate(var_info_list, source=history_var_info_list) + end select + + ! On master process... + if (me == master) then + ! Get number of lines (variables) in stream_list file. + open(newunit=funit,file=trim(stream_list_file)) + nvars = 0 + do + read(funit, *, iostat=io) + if (io /= 0) exit ! Exit loop on end-of-file or error + nvars = nvars + 1 + end do + close(funit) + + ! Read in stream_list from file. + allocate(indices_temp(nvars)) + indices_temp(:) = -999 + allocate(var_list(nvars)) + open(newunit=funit,file=trim(stream_list_file)) + do iVar = 1,nvars + read(funit, '(A)', iostat=io) line_buffer + var_list(ivar) = line_buffer + enddo + close(funit) + + ! Are requested stream_list variables available in ? + ! Loop over requested variables in , , and check + ! for existence in . + nvar_av = 0 + do iVar = 1,nvars + do i = 1, size(var_info_list) + found = .false. + if (trim(var_list(ivar)) == trim(var_info_list(i)%name)) then + found = .true. + nvar_av = nvar_av + 1 + indices_temp(nvar_av) = i + endif + enddo + ! If not found, requested variables is not supported. Print warning message. + if (.not. found) then + call mpas_log_write(subname // " Variable not supported, "//trim(var_list(ivar))// & + ", skipping", messageType=MPAS_LOG_WARN) + end if + end do + + ! Handle case when fields requested in stream_list are not available. + if (nvar_av .ne. nvars) then + allocate(indices(nvar_av)) + count = 0 + do iVar = 1,nvars + if (indices_temp(ivar) .ne. -999) then + count = count + 1 + indices(count) = indices_temp(ivar) + end if + end do + nvars = count + ! Otherwise, use full requested variable list. + else + allocate(indices(nvars)) + indices = indices_temp + end if + end if + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! Broadcast dimension + call mpi_bcast(nvars, 1, MPI_INTEGER, master, mpicomm, mpierr) + + ! Allocate + select case (trim(adjustl(stream_name))) + case ('restart') + allocate(stream_list_restart_indices(nvars)) + case ('history') + allocate(stream_list_history_indices(nvars)) + end select + + ! Set + if (me == master) then + select case (trim(adjustl(stream_name))) + case ('restart') + stream_list_restart_indices = indices + case ('history') + stream_list_history_indices = indices + end select + end if + + ! Broadcast data + select case (trim(adjustl(stream_name))) + case ('restart') + call mpi_bcast(stream_list_restart_indices, nvars, MPI_INTEGER, master, mpicomm, mpierr) + case ('history') + call mpi_bcast(stream_list_history_indices, nvars, MPI_INTEGER, master, mpicomm, mpierr) + end select + + end subroutine read_stream_list + !> ######################################################################################### !> Procedure to create and write to MPAS stream !> !> ######################################################################################### - subroutine ufs_mpas_write(stream_name, timestamp) + subroutine ufs_mpas_write(stream_name, timestamp, debug) ! PIO use pio, only : pio_openfile, pio_createfile, PIO_WRITE, PIO_CLOBBER - use mpas_log, only : mpas_log_write + ! MPAS use mpas_timekeeping, only : MPAS_NOW, MPAS_STREAM_EARLIEST_STRICTLY_AFTER - use mpp_mod, only : mpp_error, FATAL ! Arguments character(len=*), intent(in) :: stream_name character(len=*), intent(in) :: timestamp + logical, intent(in) :: debug ! Locals - character(len=*), parameter :: subname = 'ufs_mpas_subdriver::ufs_mpas_write' + character(len=*), parameter :: subname = 'ufs_mpas_io::ufs_mpas_write' character(len=:), allocatable :: filename integer :: ierr - type(var_info_type), allocatable :: output_var_info_list(:) + !type(var_info_type), allocatable :: history_var_info_list(:) integer :: timelevel, whence - logical, parameter :: debug = .true. if (trim(stream_name) == "output") then filename = 'history.'//trim(timestamp)//'.nc' @@ -351,26 +517,30 @@ subroutine ufs_mpas_write(stream_name, timestamp) else if (trim(stream_name) == "input") then filename = 'input.'//trim(timestamp)//'.nc' else - stop "Invalid stream_name to ufs_mpas_write: stream_name =" & - //trim(stream_name) + call mpas_log_write(subname // " Invalid stream_name to ufs_mpas_write: stream_name ="// & + trim(stream_name), messageType=MPAS_LOG_CRIT) end if - if (debug) call mpas_log_write("entering ufs_mpas_write") - if (debug) call mpas_log_write("creating "//trim(stream_name)//" stream file: "//trim(filename)) + if (debug) call mpas_log_write(subname // " entering ufs_mpas_write") + if (debug) call mpas_log_write(subname // " creating "//trim(stream_name)//" stream file: "//trim(filename)) ierr = pio_createfile(pio_subsystem_output, pioid_output, pio_iotype, trim(filename)) - if ( ierr /= 0 ) call mpp_error(FATAL, subname//": pio_createfile failed ") + if ( ierr /= 0 ) then + call mpas_log_write(subname // " pio_createfile failed", messageType=MPAS_LOG_CRIT) + endif - output_var_info_list = parse_stream_name_fragment('output') + !history_var_info_list = parse_stream_name_fragment('output') timelevel = TIMELEVEL_NOW whence = MPAS_NOW call dyn_mpas_read_write_stream(clock, "write", stream_name, pioid_output, & - timeLevel=timelevel, whence=whence, & - nRecord=1, ierr=ierr) - if ( ierr /= 0 ) call mpp_error(FATAL, & - subname//": dyn_mpas_read_write_stream failed ") - - if (debug) call mpas_log_write("exiting ufs_mpas_write") + timeLevel=timelevel, whence=whence, & + nRecord=1, ierr=ierr, debug=debug) + if ( ierr /= 0 ) then + call mpas_log_write(subname // " dyn_mpas_read_write_stream failed ", & + messageType=MPAS_LOG_CRIT) + endif + + if (debug) call mpas_log_write(subname // "exiting ufs_mpas_write") end subroutine ufs_mpas_write !> ######################################################################################## @@ -500,7 +670,6 @@ subroutine ufs_mpas_get_global_coords(latCellGlobal, lonCellGlobal, areaCellGlob use mpas_derived_types, only : mpas_pool_type use mpas_kind_types, only : RKIND use mpas_dmpar, only : mpas_dmpar_sum_int, mpas_dmpar_max_real_array - use mpp_mod, only : FATAL, mpp_error use module_mpas_config, only : nCellsSolve, latCell, lonCell real (kind=RKIND), dimension(:), intent(out) :: latCellGlobal real (kind=RKIND), dimension(:), intent(out) :: lonCellGlobal @@ -516,7 +685,7 @@ subroutine ufs_mpas_get_global_coords(latCellGlobal, lonCellGlobal, areaCellGlob real (kind=RKIND), dimension(:), pointer :: areaCell real (kind=RKIND), dimension(:), pointer :: temp - character(len=*), parameter :: subname = 'ufs_mpas_subdriver::ufs_mpas_get_global_coords' + character(len=*), parameter :: subname = 'ufs_mpas_io::ufs_mpas_get_global_coords' call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', meshPool) @@ -530,7 +699,9 @@ subroutine ufs_mpas_get_global_coords(latCellGlobal, lonCellGlobal, areaCellGlob ! check: size(latCellGlobal) ?= nCellsGlobal allocate(temp(nCellsGlobal), stat=ierr) - if( ierr /= 0 ) call mpp_error(FATAL,subname//':failed to allocate temp array') + if ( ierr /= 0 ) then + call mpas_log_write(subname // " failed to allocate temp array", messageType=MPAS_LOG_CRIT) + endif ! ! latCellGlobal @@ -581,7 +752,7 @@ end subroutine ufs_mpas_get_global_coords !> \update: Dustin Swales April 2025 - Modified for use in UWM !> !> ######################################################################################## - subroutine dyn_mpas_exchange_halo(field_name) + subroutine dyn_mpas_exchange_halo(field_name, debug) ! Module(s) from MPAS. use mpas_derived_types, only : field1dinteger, field2dinteger, field3dinteger, & field1dreal, field2dreal, field3dreal, field4dreal, & @@ -589,11 +760,10 @@ subroutine dyn_mpas_exchange_halo(field_name) mpas_pool_real use mpas_dmpar, only : mpas_dmpar_exch_halo_field use mpas_pool_routines, only : mpas_pool_get_field, mpas_pool_get_field_info - use mpp_mod, only : FATAL, mpp_error - use mpas_log, only : mpas_log_write character(*), intent(in) :: field_name + logical, intent(in) :: debug - character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_exchange_halo' + character(*), parameter :: subname = 'dyn_mpas_io::dyn_mpas_exchange_halo' type(field1dinteger), pointer :: field_1d_integer type(field2dinteger), pointer :: field_2d_integer type(field3dinteger), pointer :: field_3d_integer @@ -604,7 +774,7 @@ subroutine dyn_mpas_exchange_halo(field_name) type(field5dreal), pointer :: field_5d_real type(mpas_pool_field_info_type) :: mpas_pool_field_info - call mpas_log_write(subname // ' entered') + if (debug) call mpas_log_write(subname // ' entered') nullify(field_1d_integer) nullify(field_2d_integer) @@ -615,7 +785,7 @@ subroutine dyn_mpas_exchange_halo(field_name) nullify(field_4d_real) nullify(field_5d_real) - call mpas_log_write('Inquiring field information for "' // trim(adjustl(field_name)) // '"') + if (debug) call mpas_log_write(subname // 'Inquiring field information for "' // trim(adjustl(field_name)) // '"') call mpas_pool_get_field_info(domain_ptr % blocklist % allfields, & trim(adjustl(field_name)), mpas_pool_field_info) @@ -623,16 +793,16 @@ subroutine dyn_mpas_exchange_halo(field_name) if (mpas_pool_field_info % fieldtype == -1 .or. & mpas_pool_field_info % ndims == -1 .or. & mpas_pool_field_info % nhalolayers == -1) then - call mpp_error(FATAL,subname//'Invalid field information for "' // trim(adjustl(field_name)) // '"') + call mpas_log_write(subname // ' Invalid field information for "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end if ! No halo layers to exchange. This field is not decomposed. if (mpas_pool_field_info % nhalolayers == 0) then - call mpas_log_write('Skipping field "' // trim(adjustl(field_name)) // '" due to not decomposed') + call mpas_log_write(subname // ' Skipping field "' // trim(adjustl(field_name)) // '" due to not decomposed') return end if - call mpas_log_write('Exchanging halo layers for "' // trim(adjustl(field_name)) // '"') + if (debug) call mpas_log_write(subname // 'Exchanging halo layers for "' // trim(adjustl(field_name)) // '"') select case (mpas_pool_field_info % fieldtype) case (mpas_pool_integer) @@ -642,7 +812,7 @@ subroutine dyn_mpas_exchange_halo(field_name) trim(adjustl(field_name)), field_1d_integer, timelevel=1) if (.not. associated(field_1d_integer)) then - call mpp_error(FATAL,subname//'Failed to find field "' // trim(adjustl(field_name)) // '"') + call mpas_log_write(subname // ' Failed to find field "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end if call mpas_dmpar_exch_halo_field(field_1d_integer) @@ -653,7 +823,7 @@ subroutine dyn_mpas_exchange_halo(field_name) trim(adjustl(field_name)), field_2d_integer, timelevel=1) if (.not. associated(field_2d_integer)) then - call mpp_error(FATAL,subname//'Failed to find field "' // trim(adjustl(field_name)) // '"') + call mpas_log_write(subname // ' Failed to find field "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end if call mpas_dmpar_exch_halo_field(field_2d_integer) @@ -664,14 +834,14 @@ subroutine dyn_mpas_exchange_halo(field_name) trim(adjustl(field_name)), field_3d_integer, timelevel=1) if (.not. associated(field_3d_integer)) then - call mpp_error(FATAL,subname//'Failed to find field "' // trim(adjustl(field_name)) // '"') + call mpas_log_write(subname // ' Failed to find field "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end if call mpas_dmpar_exch_halo_field(field_3d_integer) nullify(field_3d_integer) case default - call mpp_error(FATAL,subname//'Unsupported field rank ' // stringify([mpas_pool_field_info % ndims])) + call mpas_log_write(subname // ' Unsupported field rank "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end select case (mpas_pool_real) select case (mpas_pool_field_info % ndims) @@ -680,7 +850,7 @@ subroutine dyn_mpas_exchange_halo(field_name) trim(adjustl(field_name)), field_1d_real, timelevel=1) if (.not. associated(field_1d_real)) then - call mpp_error(FATAL,subname//'Failed to find field "' // trim(adjustl(field_name)) // '"') + call mpas_log_write(subname // ' Failed to find field "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end if call mpas_dmpar_exch_halo_field(field_1d_real) @@ -691,7 +861,7 @@ subroutine dyn_mpas_exchange_halo(field_name) trim(adjustl(field_name)), field_2d_real, timelevel=1) if (.not. associated(field_2d_real)) then - call mpp_error(FATAL,subname//'Failed to find field "' // trim(adjustl(field_name)) // '"') + call mpas_log_write(subname // ' Failed to find field "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end if call mpas_dmpar_exch_halo_field(field_2d_real) nullify(field_2d_real) @@ -700,7 +870,7 @@ subroutine dyn_mpas_exchange_halo(field_name) trim(adjustl(field_name)), field_3d_real, timelevel=1) if (.not. associated(field_3d_real)) then - call mpp_error(FATAL,subname//'Failed to find field "' // trim(adjustl(field_name)) // '"') + call mpas_log_write(subname // ' Failed to find field "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end if call mpas_dmpar_exch_halo_field(field_3d_real) @@ -711,7 +881,7 @@ subroutine dyn_mpas_exchange_halo(field_name) trim(adjustl(field_name)), field_4d_real, timelevel=1) if (.not. associated(field_4d_real)) then - call mpp_error(FATAL,subname//'Failed to find field "' // trim(adjustl(field_name)) // '"') + call mpas_log_write(subname // ' Failed to find field "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end if call mpas_dmpar_exch_halo_field(field_4d_real) @@ -722,20 +892,20 @@ subroutine dyn_mpas_exchange_halo(field_name) trim(adjustl(field_name)), field_5d_real, timelevel=1) if (.not. associated(field_5d_real)) then - call mpp_error(FATAL,subname//'Failed to find field "' // trim(adjustl(field_name)) // '"') + call mpas_log_write(subname // ' Failed to find field "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end if call mpas_dmpar_exch_halo_field(field_5d_real) nullify(field_5d_real) case default - call mpp_error(FATAL,subname//'Unsupported field rank ' // stringify([mpas_pool_field_info % ndims])) + call mpas_log_write(subname // ' Unsupported field rank "' // trim(adjustl(field_name)) // '"', messageType=MPAS_LOG_CRIT) end select case default - call mpp_error(FATAL,subname//'Unsupported field type (Must be one of: integer, real)') + call mpas_log_write(subname // ' Unsupported field type (Must be one of: integer, real)', messageType=MPAS_LOG_CRIT) end select - call mpas_log_write(subname // ' completed') + if (debug) call mpas_log_write(subname // ' completed') end subroutine dyn_mpas_exchange_halo !> ######################################################################################## @@ -755,16 +925,14 @@ end subroutine dyn_mpas_exchange_halo !> !> ######################################################################################## subroutine dyn_mpas_read_write_stream(clock, stream_mode, stream_name, pio_file_desc, & - timeLevel, when, whence, actualWhen, nRecord, ierr) + timeLevel, when, whence, actualWhen, nRecord, ierr, debug) ! Module(s) from external libraries. use pio, only : file_desc_t - use mpp_mod, only : FATAL, mpp_error ! Module(s) from MPAS. use mpas_derived_types, only : mpas_pool_type, mpas_stream_noerr, mpas_stream_type use mpas_io_streams, only : mpas_closestream, mpas_writestream use mpas_pool_routines, only : mpas_pool_destroy_pool use mpas_stream_manager, only : postread_reindex, prewrite_reindex, postwrite_reindex - use mpas_log, only : mpas_log_write use mpas_io_streams, only : MPAS_STREAM_EXACT_TIME use mpas_timekeeping, only : mpas_get_clock_time, MPAS_NOW ! Arguments @@ -778,48 +946,47 @@ subroutine dyn_mpas_read_write_stream(clock, stream_mode, stream_name, pio_file_ character (len=*), intent(out), optional :: actualWhen integer, intent(in) :: nRecord integer, intent(out) :: ierr + logical, intent(in) :: debug ! Local variables - character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_read_write_stream' + character(*), parameter :: subname = 'dyn_mpas_io::dyn_mpas_read_write_stream' integer :: i type(mpas_pool_type), pointer :: mpas_pool type(mpas_stream_type), pointer :: mpas_stream type(var_info_type), allocatable :: var_info_list(:) ierr = 0 - call mpas_log_write('') nullify(mpas_pool) nullify(mpas_stream) - call mpas_log_write( '---------------------------------------------------------------------') - call mpas_log_write( 'Initializing stream "' // trim(adjustl(stream_name)) // '"') + if (debug) call mpas_log_write(subname // 'Initializing stream "' // trim(adjustl(stream_name)) // '"') - call dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file_desc, stream_mode, stream_name, timeLevel) + call dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file_desc, stream_mode, stream_name, timeLevel, debug) if (.not. associated(mpas_pool)) then - call mpp_error(FATAL,subname//'Failed to initialize stream "' // trim(adjustl(stream_name)) // '"') + call mpas_log_write(subname // ' Failed to initialize stream "' // trim(adjustl(stream_name)) // '"', messageType=MPAS_LOG_CRIT) end if if (.not. associated(mpas_stream)) then - call mpp_error(FATAL,subname//'Failed to initialize stream "' // trim(adjustl(stream_name)) // '"') + call mpas_log_write(subname // ' Failed to initialize stream "' // trim(adjustl(stream_name)) // '"', messageType=MPAS_LOG_CRIT) end if select case (trim(adjustl(stream_mode))) case ('r', 'read') - call mpas_log_write('Reading stream "' // trim(adjustl(stream_name)) // '"') + if (debug) call mpas_log_write(subname // 'Reading stream "' // trim(adjustl(stream_name)) // '"') call read_stream(mpas_stream, actualWhen, nRecord, ierr) if (ierr /= mpas_stream_noerr) then - call mpp_error(FATAL,subname//'Failed to read stream "' // trim(adjustl(stream_name)) // '"') + call mpas_log_write(subname // ' Failed to initialize stream "' // trim(adjustl(stream_name)) // '"', messageType=MPAS_LOG_CRIT) end if ! Exchange halo layers because new data have just been read. var_info_list = parse_stream_name(stream_name) do i = 1, size(var_info_list) - call dyn_mpas_exchange_halo(var_info_list(i) % name) + call dyn_mpas_exchange_halo(var_info_list(i) % name, debug) if ( ierr /= 0 ) then - call mpp_error(FATAL,subname//'Failed to exchange halo layers for group '//var_info_list(i) % name) + call mpas_log_write(subname // ' Failed to exchange halo layers for group '//var_info_list(i) % name, messageType=MPAS_LOG_CRIT) end if end do @@ -827,7 +994,7 @@ subroutine dyn_mpas_read_write_stream(clock, stream_mode, stream_name, pio_file_ call postread_reindex(domain_ptr % blocklist % allfields, domain_ptr % packages, & mpas_pool, mpas_pool) case ('w', 'write') - call mpas_log_write('Writing stream "' // trim(adjustl(stream_name)) // '"') + if (debug) call mpas_log_write(subname // 'Writing stream "' // trim(adjustl(stream_name)) // '"') ! WARNING: ! The `{pre,post}write_reindex` subroutines are STATEFUL because they store information inside their module @@ -839,22 +1006,22 @@ subroutine dyn_mpas_read_write_stream(clock, stream_mode, stream_name, pio_file_ call mpas_writestream(mpas_stream, 1, ierr=ierr) if (ierr /= mpas_stream_noerr) then - call mpp_error(FATAL,subname//'Failed to write stream "' // trim(adjustl(stream_name)) // '"') + call mpas_log_write(subname // ' Failed to write stream "' // trim(adjustl(stream_name)) // '"', messageType=MPAS_LOG_CRIT) end if ! For any connectivity arrays in this stream, reset global indexes back to local indexes. call postwrite_reindex(domain_ptr % blocklist % allfields, mpas_pool) case default - call mpp_error(FATAL,subname//'Unsupported stream mode "' // trim(adjustl(stream_mode)) // '"') + call mpas_log_write(subname // ' Unsupported stream mode "' // trim(adjustl(stream_mode)) // '"', messageType=MPAS_LOG_CRIT) end select - call mpas_log_write('Closing stream "' // trim(adjustl(stream_name)) // '"') + if (debug) call mpas_log_write('Closing stream "' // trim(adjustl(stream_name)) // '"') call mpas_log_write( '---------------------------------------------------------------------') call mpas_closestream(mpas_stream, ierr=ierr) if (ierr /= mpas_stream_noerr) then - call mpp_error(FATAL,subname//'Failed to close stream "' // trim(adjustl(stream_name)) // '"') + call mpas_log_write(subname // ' Failed to close stream "' // trim(adjustl(stream_name)) // '"', messageType=MPAS_LOG_CRIT) end if ! Deallocate temporary pointers to avoid memory leaks. @@ -863,7 +1030,7 @@ subroutine dyn_mpas_read_write_stream(clock, stream_mode, stream_name, pio_file_ deallocate(mpas_stream) nullify(mpas_stream) - call mpas_log_write(subname // ' completed') + if (debug) call mpas_log_write(subname // ' completed') end subroutine dyn_mpas_read_write_stream @@ -907,7 +1074,7 @@ end subroutine read_stream !> !> ######################################################################################## subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stream_mode, & - stream_name, timeLevel) + stream_name, timeLevel, debug) ! Module(s) from external libraries. use pio, only: file_desc_t, pio_file_is_open ! Module(s) from MPAS. @@ -920,8 +1087,6 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre use mpas_io_streams, only : mpas_createstream, mpas_streamaddfield use mpas_pool_routines, only : mpas_pool_add_config, mpas_pool_create_pool, mpas_pool_get_field use mpas_kind_types, only : StrKIND, RKIND - use mpp_mod, only : FATAL, mpp_error - use mpas_log, only : mpas_log_write type(mpas_pool_type), pointer, intent(out) :: mpas_pool type(mpas_stream_type), pointer, intent(out) :: mpas_stream @@ -929,13 +1094,14 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre character(*), intent(in) :: stream_mode character(*), intent(in) :: stream_name integer, intent(in) :: timeLevel + logical, intent(in) :: debug interface add_stream_attribute procedure :: add_stream_attribute_0d procedure :: add_stream_attribute_1d end interface add_stream_attribute - character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_init_stream_with_pool' + character(*), parameter :: subname = 'dyn_mpas_io::dyn_mpas_init_stream_with_pool' character(strkind) :: stream_filename integer :: i, ierr, stream_format !> Whether a variable is present on the file (i.e., `pio_file`). @@ -956,7 +1122,7 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre type(field5dreal), pointer :: field_5d_real type(var_info_type), allocatable :: var_info_list(:) - call mpas_log_write(subname // ' entered') + if (debug) call mpas_log_write(subname // ' entered') nullify(field_0d_char) nullify(field_1d_char) @@ -976,69 +1142,69 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre allocate(mpas_stream, stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate stream "' // trim(adjustl(stream_name)) // '"') + call mpas_log_write(subname // ' Failed to allocate stream "' // trim(adjustl(stream_name)) // '"', messageType=MPAS_LOG_CRIT) end if ! Not actually used because a PIO file descriptor is directly supplied. stream_filename = 'external stream' stream_format = mpas_io_pnetcdf - call mpas_log_write('Checking PIO file descriptor') + if (debug) call mpas_log_write('Checking PIO file descriptor') if (.not. associated(pio_file)) then - call mpp_error(FATAL,subname//'Invalid PIO file descriptor') + call mpas_log_write(subname // ' Invalid PIO file descriptor', messageType=MPAS_LOG_CRIT) end if if (.not. pio_file_is_open(pio_file)) then - call mpp_error(FATAL,subname//'Invalid PIO file descriptor') + call mpas_log_write(subname // ' Invalid PIO file descriptor', messageType=MPAS_LOG_CRIT) end if select case (trim(adjustl(stream_mode))) case ('r', 'read') - call mpas_log_write('Creating stream "' // trim(adjustl(stream_name)) // '" for reading') + if (debug) call mpas_log_write(' Creating stream "' // trim(adjustl(stream_name)) // '" for reading') call mpas_createstream( & mpas_stream, domain_ptr % iocontext, stream_filename, stream_format, mpas_io_read, & clobberrecords=.false., clobberfiles=.false., truncatefiles=.false., & precision=mpas_io_native_precision, pio_file_desc=pio_file, ierr=ierr) case ('w', 'write') - call mpas_log_write('Creating stream "' // trim(adjustl(stream_name)) // '" for writing') + if (debug) call mpas_log_write(' Creating stream "' // trim(adjustl(stream_name)) // '" for writing') call mpas_createstream( & mpas_stream, domain_ptr % iocontext, stream_filename, stream_format, mpas_io_write, & clobberrecords=.false., clobberfiles=.false., truncatefiles=.false., & precision=mpas_io_native_precision, pio_file_desc=pio_file, ierr=ierr) case default - call mpp_error(FATAL,subname//'Unsupported stream mode "' // trim(adjustl(stream_mode)) // '"') + call mpas_log_write(subname // ' Unsupported stream mode "' // trim(adjustl(stream_mode)) // '"', messageType=MPAS_LOG_CRIT) end select if (ierr /= mpas_stream_noerr) then - call mpp_error(FATAL,subname//'Failed to create stream "' // trim(adjustl(stream_name)) // '"') + call mpas_log_write(subname // ' Failed to create stream "' // trim(adjustl(stream_name)) // '"', messageType=MPAS_LOG_CRIT) end if var_info_list = parse_stream_name(stream_name) ! Add variables contained in `var_info_list` to stream. do i = 1, size(var_info_list) - call mpas_log_write('var_info_list(' // stringify([i]) // ') % name = ' // stringify([var_info_list(i) % name])) - call mpas_log_write('var_info_list(' // stringify([i]) // ') % type = ' // stringify([var_info_list(i) % type])) - call mpas_log_write('var_info_list(' // stringify([i]) // ') % rank = ' // stringify([var_info_list(i) % rank])) + if (debug) then + call mpas_log_write('var_info_list(' // stringify([i]) // ') % name = ' // stringify([var_info_list(i) % name])) + call mpas_log_write('var_info_list(' // stringify([i]) // ') % type = ' // stringify([var_info_list(i) % type])) + call mpas_log_write('var_info_list(' // stringify([i]) // ') % rank = ' // stringify([var_info_list(i) % rank])) + endif if (trim(adjustl(stream_mode)) == 'r' .or. trim(adjustl(stream_mode)) == 'read') then - call dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, pio_file, var_info_list(i)) + call dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, pio_file, var_info_list(i), debug) ! Do not hard crash the model if a variable is missing and cannot be read. ! This can happen if users attempt to initialize/restart the model with data generated by ! older versions of MPAS. Print a debug message to let users decide if this is acceptable. if (.not. any(var_is_present)) then - call mpas_log_write('Skipping variable "' // trim(adjustl(var_info_list(i) % name)) // '" due to not present') - + if (debug) call mpas_log_write('Skipping variable "' // trim(adjustl(var_info_list(i) % name)) // '" due to not present') cycle end if if (any(var_is_present .and. .not. var_is_tkr_compatible)) then - call mpas_log_write('Skipping variable "' // trim(adjustl(var_info_list(i) % name)) // '" due to not TKR compatible') - + if (debug) call mpas_log_write('Skipping variable "' // trim(adjustl(var_info_list(i) % name)) // '" due to not TKR compatible') !cycle end if end if @@ -1051,8 +1217,8 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre !call mpas_pool_add_config(mpas_pool, trim(adjustl(var_info_list(i) % name) // ':packages'), '') ! Add "" to stream. - call mpas_log_write('Adding variable "' // trim(adjustl(var_info_list(i) % name)) // & - '" to stream "' // trim(adjustl(stream_name)) // '"') + if (debug) call mpas_log_write('Adding variable "' // trim(adjustl(var_info_list(i) % name)) // & + '" to stream "' // trim(adjustl(stream_name)) // '"') select case (trim(adjustl(var_info_list(i) % type))) case ('character') @@ -1062,7 +1228,9 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_0d_char, timelevel=timeLevel) if (.not. associated(field_0d_char)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_0d_char, ierr=ierr) @@ -1073,15 +1241,19 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_1d_char, timelevel=timeLevel) if (.not. associated(field_1d_char)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_1d_char, ierr=ierr) nullify(field_1d_char) case default - call mpp_error(FATAL,subname//'Unsupported variable rank ' // stringify([var_info_list(i) % rank]) // & - ' for "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Unsupported variable rank ' // & + stringify([var_info_list(i) % rank]) // & + ' for "' // trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end select case ('integer') select case (var_info_list(i) % rank) @@ -1090,7 +1262,9 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_0d_integer, timelevel=timeLevel) if (.not. associated(field_0d_integer)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_0d_integer, ierr=ierr) @@ -1101,7 +1275,9 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_1d_integer, timelevel=timeLevel) if (.not. associated(field_1d_integer)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_1d_integer, ierr=ierr) @@ -1112,7 +1288,9 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_2d_integer, timelevel=timeLevel) if (.not. associated(field_2d_integer)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_2d_integer, ierr=ierr) @@ -1123,15 +1301,19 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_3d_integer, timelevel=timeLevel) if (.not. associated(field_3d_integer)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_3d_integer, ierr=ierr) nullify(field_3d_integer) case default - call mpp_error(FATAL,subname//'Unsupported variable rank ' // stringify([var_info_list(i) % rank]) // & - ' for "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Unsupported variable rank ' // & + stringify([var_info_list(i) % rank]) // & + ' for "' // trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end select case ('real') select case (var_info_list(i) % rank) @@ -1140,7 +1322,9 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_0d_real, timelevel=timeLevel) if (.not. associated(field_0d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_0d_real, ierr=ierr) @@ -1151,7 +1335,9 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_1d_real, timelevel=timeLevel) if (.not. associated(field_1d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_1d_real, ierr=ierr) @@ -1161,7 +1347,9 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre call mpas_pool_get_field(domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_2d_real, timelevel=timeLevel) if (.not. associated(field_2d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_2d_real, ierr=ierr) @@ -1171,7 +1359,9 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_3d_real, timelevel=timeLevel) if (.not. associated(field_3d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_3d_real, ierr=ierr) @@ -1181,7 +1371,9 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_4d_real, timelevel=timeLevel) if (.not. associated(field_4d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_4d_real, ierr=ierr) @@ -1192,24 +1384,32 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre trim(adjustl(var_info_list(i) % name)), field_5d_real, timelevel=timeLevel) if (.not. associated(field_5d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if call mpas_streamaddfield(mpas_stream, field_5d_real, ierr=ierr) nullify(field_5d_real) case default - call mpp_error(FATAL,subname//'Unsupported variable rank ' // stringify([var_info_list(i) % rank]) // & - ' for "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Unsupported variable rank ' // & + stringify([var_info_list(i) % rank]) // & + ' for "' // trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end select case default - call mpp_error(FATAL,subname//'Unsupported variable type "' // trim(adjustl(var_info_list(i) % type)) // & - '" for "' // trim(adjustl(var_info_list(i) % name)) // '"') + call mpas_log_write(subname // ' Unsupported variable type "' // & + trim(adjustl(var_info_list(i) % type)) // & + '" for "' // trim(adjustl(var_info_list(i) % name)) // '"', & + messageType=MPAS_LOG_CRIT) end select if (ierr /= mpas_stream_noerr) then - call mpp_error(FATAL,subname//'Failed to add variable "' // trim(adjustl(var_info_list(i) % name)) // & - '" to stream "' // trim(adjustl(stream_name)) // '"') + call mpas_log_write(subname // ' Failed to add variable "' // & + trim(adjustl(var_info_list(i) % name)) // & + '" to stream "' // trim(adjustl(stream_name)) // '"', & + messageType=MPAS_LOG_CRIT) end if end do @@ -1233,19 +1433,18 @@ subroutine dyn_mpas_init_stream_with_pool(mpas_pool, mpas_stream, pio_file, stre call add_stream_attribute('y_period', domain_ptr % y_period) end if - call mpas_log_write(subname // ' completed') + if (debug) call mpas_log_write(subname // ' completed') contains !> Helper subroutine for adding a 0-d stream attribute by calling `mpas_writestreamatt` with error checking. !> (KCW, 2024-03-14) subroutine add_stream_attribute_0d(attribute_name, attribute_value) ! Module(s) from MPAS. use mpas_io_streams, only : mpas_writestreamatt - use mpas_log, only : mpas_log_write character(*), intent(in) :: attribute_name class(*), intent(in) :: attribute_value - call mpas_log_write('Adding attribute "' // trim(adjustl(attribute_name)) // & - '" to stream "' // trim(adjustl(stream_name)) // '"') + if (debug) call mpas_log_write('Adding attribute "' // trim(adjustl(attribute_name)) // & + '" to stream "' // trim(adjustl(stream_name)) // '"') select type (attribute_value) type is (character(*)) @@ -1268,12 +1467,15 @@ subroutine add_stream_attribute_0d(attribute_name, attribute_value) call mpas_writestreamatt(mpas_stream, & trim(adjustl(attribute_name)), attribute_value, syncval=.false., ierr=ierr) class default - call mpp_error(FATAL,subname//'Unsupported attribute type (Must be one of: character, integer, logical, real)') + call mpas_log_write(subname // ' Unsupported attribute type (Must be one of: character, integer, logical, real)', & + messageType=MPAS_LOG_CRIT) end select if (ierr /= mpas_stream_noerr) then - call mpp_error(FATAL,subname//'Failed to add attribute "' // trim(adjustl(attribute_name)) // & - '" to stream "' // trim(adjustl(stream_name)) // '"') + call mpas_log_write(subname // ' Failed to add attribute "' // & + trim(adjustl(attribute_name)) // & + '" to stream "' // trim(adjustl(stream_name)) // '"', & + messageType=MPAS_LOG_CRIT) end if end subroutine add_stream_attribute_0d @@ -1282,12 +1484,11 @@ end subroutine add_stream_attribute_0d subroutine add_stream_attribute_1d(attribute_name, attribute_value) ! Module(s) from MPAS. use mpas_io_streams, only : mpas_writestreamatt - use mpas_log, only : mpas_log_write character(*), intent(in) :: attribute_name class(*), intent(in) :: attribute_value(:) - call mpas_log_write('Adding attribute "' // trim(adjustl(attribute_name)) // & - '" to stream "' // trim(adjustl(stream_name)) // '"') + if (debug) call mpas_log_write(subname // 'Adding attribute "' // trim(adjustl(attribute_name)) // & + '" to stream "' // trim(adjustl(stream_name)) // '"') select type (attribute_value) type is (integer) @@ -1297,12 +1498,15 @@ subroutine add_stream_attribute_1d(attribute_name, attribute_value) call mpas_writestreamatt(mpas_stream, & trim(adjustl(attribute_name)), attribute_value, syncval=.false., ierr=ierr) class default - call mpp_error(FATAL,subname//'Unsupported attribute type (Must be one of: integer, real)') + call mpas_log_write(subname // ' Unsupported attribute type (Must be one of: integer, real)',& + messageType=MPAS_LOG_CRIT) end select if (ierr /= mpas_stream_noerr) then - call mpp_error(FATAL,subname//'Failed to add attribute "' // trim(adjustl(attribute_name)) // & - '" to stream "' // trim(adjustl(stream_name)) // '"') + call mpas_log_write(subname // ' Failed to add attribute "' // & + trim(adjustl(attribute_name)) // & + '" to stream "' // trim(adjustl(stream_name)) // '"', & + messageType=MPAS_LOG_CRIT) end if end subroutine add_stream_attribute_1d end subroutine dyn_mpas_init_stream_with_pool @@ -1435,9 +1639,21 @@ pure function parse_stream_name_fragment(stream_name_fragment) result(var_info_l case ('input') allocate(var_info_list, source=input_var_info_list) case ('restart') - allocate(var_info_list, source=restart_var_info_list) + ! If stream_list provided at runtime, only include requested fields. + if (allocated(stream_list_restart_indices)) then + allocate(var_info_list, source=restart_var_info_list(stream_list_restart_indices)) + ! Otherwise, include all available fields from stream (default). + else + allocate(var_info_list, source=restart_var_info_list) + end if case ('output') - allocate(var_info_list, source=output_var_info_list) + ! If stream_list provided at runtime, only include requested fields. + if (allocated(stream_list_history_indices)) then + allocate(var_info_list, source=history_var_info_list(stream_list_history_indices)) + ! Otherwise, include all available fields from stream (default). + else + allocate(var_info_list, source=history_var_info_list) + end if case ('lbc_in') allocate(var_info_list, source=lbc_in_var_info_list) case ('sfc_input') @@ -1468,10 +1684,10 @@ pure function parse_stream_name_fragment(stream_name_fragment) result(var_info_l var_info_list = [var_info_list, var_info_list_buffer] end if - var_name_list = output_var_info_list % name + var_name_list = history_var_info_list % name if (any(var_name_list == trim(adjustl(stream_name_fragment)))) then - var_info_list_buffer = pack(output_var_info_list, var_name_list == trim(adjustl(stream_name_fragment))) + var_info_list_buffer = pack(history_var_info_list, var_name_list == trim(adjustl(stream_name_fragment))) var_info_list = [var_info_list, var_info_list_buffer] end if @@ -1589,7 +1805,7 @@ end function index_unique !> !> ######################################################################################## subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, pio_file,& - var_info) + var_info, debug) ! Module(s) from external libraries. use pio, only: file_desc_t, pio_file_is_open, pio_char, pio_int, pio_real, pio_double, & pio_inq_varid, pio_inq_varndims, pio_inq_vartype, pio_noerr @@ -1599,16 +1815,15 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, field2dreal, field3dreal, field4dreal, field5dreal use mpas_kind_types, only : r4kind, r8kind use mpas_pool_routines, only : mpas_pool_get_field - use mpas_log, only : mpas_log_write use mpas_kind_types, only : StrKIND, RKIND - use mpp_mod, only : FATAL, mpp_error logical, allocatable, intent(out) :: var_is_present(:) logical, allocatable, intent(out) :: var_is_tkr_compatible(:) type(file_desc_t), pointer, intent(in) :: pio_file type(var_info_type), intent(in) :: var_info + logical, intent(in) :: debug - character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_check_variable_status' + character(*), parameter :: subname = 'dyn_mpas_io::dyn_mpas_check_variable_status' character(strkind), allocatable :: var_name_list(:) integer :: i, ierr, varid, varndims, vartype type(field0dchar), pointer :: field_0d_char @@ -1624,7 +1839,7 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, type(field4dreal), pointer :: field_4d_real type(field5dreal), pointer :: field_5d_real - call mpas_log_write(subname // ' entered') + if (debug) call mpas_log_write(subname // ' entered') nullify(field_0d_char) nullify(field_1d_char) @@ -1650,14 +1865,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_0d_char, timelevel=1) if (.not. associated(field_0d_char)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name))) + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_0d_char % isvararray .and. associated(field_0d_char % constituentnames)) then allocate(var_name_list(size(field_0d_char % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_0d_char % constituentnames(:) @@ -1669,14 +1887,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_1d_char, timelevel=1) if (.not. associated(field_1d_char)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name))) + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_1d_char % isvararray .and. associated(field_1d_char % constituentnames)) then allocate(var_name_list(size(field_1d_char % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_1d_char % constituentnames(:) @@ -1684,8 +1905,10 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, nullify(field_1d_char) case default - call mpp_error(FATAL,subname//'Unsupported variable rank ' // stringify([var_info % rank]) // & - ' for "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Unsupported variable rank ' // & + stringify([var_info % rank]) // & + ' for "' // trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end select case ('integer') select case (var_info % rank) @@ -1694,14 +1917,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_0d_integer, timelevel=1) if (.not. associated(field_0d_integer)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_0d_integer % isvararray .and. associated(field_0d_integer % constituentnames)) then allocate(var_name_list(size(field_0d_integer % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_0d_integer % constituentnames(:) @@ -1713,14 +1939,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_1d_integer, timelevel=1) if (.not. associated(field_1d_integer)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_1d_integer % isvararray .and. associated(field_1d_integer % constituentnames)) then allocate(var_name_list(size(field_1d_integer % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_1d_integer % constituentnames(:) @@ -1732,14 +1961,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_2d_integer, timelevel=1) if (.not. associated(field_2d_integer)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_2d_integer % isvararray .and. associated(field_2d_integer % constituentnames)) then allocate(var_name_list(size(field_2d_integer % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_2d_integer % constituentnames(:) @@ -1751,14 +1983,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_3d_integer, timelevel=1) if (.not. associated(field_3d_integer)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_3d_integer % isvararray .and. associated(field_3d_integer % constituentnames)) then allocate(var_name_list(size(field_3d_integer % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_3d_integer % constituentnames(:) @@ -1766,8 +2001,10 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, nullify(field_3d_integer) case default - call mpp_error(FATAL,subname//'Unsupported variable rank ' // stringify([var_info % rank]) // & - ' for "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Unsupported variable rank ' // & + stringify([var_info % rank]) // & + ' for "' // trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end select case ('real') select case (var_info % rank) @@ -1777,14 +2014,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_0d_real, timelevel=1) if (.not. associated(field_0d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_0d_real % isvararray .and. associated(field_0d_real % constituentnames)) then allocate(var_name_list(size(field_0d_real % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_0d_real % constituentnames(:) @@ -1797,15 +2037,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_1d_real, timelevel=1) if (.not. associated(field_1d_real)) then - call mpas_log_write(subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_1d_real % isvararray .and. associated(field_1d_real % constituentnames)) then allocate(var_name_list(size(field_1d_real % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_1d_real % constituentnames(:) @@ -1817,14 +2059,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_2d_real, timelevel=1) if (.not. associated(field_2d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_2d_real % isvararray .and. associated(field_2d_real % constituentnames)) then allocate(var_name_list(size(field_2d_real % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_2d_real % constituentnames(:) @@ -1835,13 +2080,16 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, call mpas_pool_get_field(domain_ptr % blocklist % allfields, & trim(adjustl(var_info % name)), field_3d_real, timelevel=1) if (.not. associated(field_3d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_3d_real % isvararray .and. associated(field_3d_real % constituentnames)) then allocate(var_name_list(size(field_3d_real % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_3d_real % constituentnames(:) @@ -1852,14 +2100,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_4d_real, timelevel=1) if (.not. associated(field_4d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_4d_real % isvararray .and. associated(field_4d_real % constituentnames)) then allocate(var_name_list(size(field_4d_real % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_4d_real % constituentnames(:) @@ -1871,14 +2122,17 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, trim(adjustl(var_info % name)), field_5d_real, timelevel=1) if (.not. associated(field_5d_real)) then - call mpp_error(FATAL,subname//'Failed to find variable "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Failed to find variable "' // & + trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end if if (field_5d_real % isvararray .and. associated(field_5d_real % constituentnames)) then allocate(var_name_list(size(field_5d_real % constituentnames)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(:) = field_5d_real % constituentnames(:) @@ -1886,19 +2140,24 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, nullify(field_5d_real) case default - call mpp_error(FATAL,subname//'Unsupported variable rank ' // stringify([var_info % rank]) // & - ' for "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Unsupported variable rank ' // & + stringify([var_info % rank]) // & + ' for "' // trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end select case default - call mpp_error(FATAL,subname//'Unsupported variable type "' // trim(adjustl(var_info % type)) // & - '" for "' // trim(adjustl(var_info % name)) // '"') + call mpas_log_write(subname // ' Unsupported variable type ' // & + stringify([var_info % type]) // & + ' for "' // trim(adjustl(var_info % name)) // '"', & + messageType=MPAS_LOG_CRIT) end select if (.not. allocated(var_name_list)) then allocate(var_name_list(1), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_name_list') + call mpas_log_write(subname // ' Failed to allocate var_name_list', & + messageType=MPAS_LOG_CRIT) end if var_name_list(1) = var_info % name @@ -1907,13 +2166,15 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, allocate(var_is_present(size(var_name_list)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_is_present') + call mpas_log_write(subname // ' Failed to allocate var_is_present', & + messageType=MPAS_LOG_CRIT) end if var_is_present(:) = .false. allocate(var_is_tkr_compatible(size(var_name_list)), stat=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to allocate var_is_tkr_compatible') + call mpas_log_write(subname // ' Failed to allocate var_is_tkr_compatible', & + messageType=MPAS_LOG_CRIT) end if var_is_tkr_compatible(:) = .false. @@ -1925,8 +2186,8 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, return end if - call mpas_log_write('Checking variable "' // trim(adjustl(var_info % name)) // & - '" for presence and TKR compatibility') + if (debug) call mpas_log_write('Checking variable "' // trim(adjustl(var_info % name)) // & + '" for presence and TKR compatibility') do i = 1, size(var_name_list) ! Check if the variable is present on the file. ierr = pio_inq_varid(pio_file, trim(adjustl(var_name_list(i))), varid) @@ -1984,11 +2245,32 @@ subroutine dyn_mpas_check_variable_status(var_is_present, var_is_tkr_compatible, var_is_tkr_compatible(i) = .true. end do - call mpas_log_write('var_name_list = ' // stringify(var_name_list)) - call mpas_log_write('var_is_present = ' // stringify(var_is_present)) - call mpas_log_write('var_is_tkr_compatible = ' // stringify(var_is_tkr_compatible)) - - call mpas_log_write(subname // ' completed') + if (debug) then + call mpas_log_write('var_name_list = ' // stringify(var_name_list)) + call mpas_log_write('var_is_present = ' // stringify(var_is_present)) + call mpas_log_write('var_is_tkr_compatible = ' // stringify(var_is_tkr_compatible)) + call mpas_log_write(subname // ' completed') + end if + end subroutine dyn_mpas_check_variable_status + subroutine create_file_timeStamp(curr_time,timeStampOutFile) + use esmf + implicit none + type (MPAS_Time_type), intent(in ) :: curr_time + character(len=StrKIND), intent(out) :: timeStampOutFile + integer :: YY,MM,DD,H,M,S,S_n,S_d,ierr + character(len=4) :: yy_str + character(len=2) :: mm_str, dd_str, h_str, m_str, s_str + + call ESMF_TimeGet(curr_time % t, YY=YY, MM=MM, DD=DD, H=H, M=M, S=S, Sn=S_n, Sd=S_d, rc=ierr) + write(yy_str, '(I4)') YY + write(mm_str, '(I2.2)') MM + write(dd_str, '(I2.2)') DD + write(h_str, '(I2.2)') H + write(m_str, '(I2.2)') M + write(s_str, '(I2.2)') S + timeStampOutFile = yy_str//'-'//mm_str//'-'//dd_str//'_'//h_str//'.'//m_str//'.'//s_str + + end subroutine create_file_timeStamp end module ufs_mpas_io diff --git a/mpas/ufs_mpas_subdriver.F90 b/mpas/ufs_mpas_subdriver.F90 index 59b86dda8..534c0b19e 100644 --- a/mpas/ufs_mpas_subdriver.F90 +++ b/mpas/ufs_mpas_subdriver.F90 @@ -17,14 +17,19 @@ module ufs_mpas_subdriver use mpi_f08 use mpas_kind_types, only : StrKIND, rkind - use module_mpas_config, only : pioid_ic + use mpas_derived_types, only : MPAS_LOG_ERR, MPAS_LOG_CRIT + use mpas_log, only : mpas_log_write + use module_mpas_config, only : pioid_ic, pioid_restart use module_mpas_config, only : fcst_mpi_comm use module_mpas_config, only : zref, zref_edge, sphere_radius, pref, pref_edge use module_mpas_config, only : maxNCells, maxEdges, nVertLevels use module_mpas_config, only : nCellsGlobal, nEdgesGlobal, nVerticesGlobal use module_mpas_config, only : nEdgesSolve, nVerticesSolve, nVertLevelsSolve - use module_mpas_config, only : dt_atmos, n_atmos, output_fh + use module_mpas_config, only : dt_atmos, n_atmos use module_mpas_config, only : latCellGlobal, lonCellGlobal, areaCellGlobal + use module_mpas_config, only : nml_filename, nml_funit + use module_mpas_config, only : mpas_output_times, mpas_restart_times + use module_mpas_config, only : out_file_index, restart_file_index use ufs_mpas_tools use ufs_mpas_io use ufs_mpas_boundaries @@ -49,6 +54,7 @@ module ufs_mpas_subdriver character(len=64) :: fn_nml ! Full namelist for use with internal file reads + ! This is not needed, but maintains the same interface with GFS_typedefs.F90:control_initialize() character(len=:), pointer, dimension(:) :: input_nml_file => null() ! MPI Bookkeeping @@ -95,7 +101,7 @@ module ufs_mpas_subdriver !> !> ######################################################################################### subroutine ufs_mpas_init(Cfg, time_start, time_end, total_time, calendar, logUnits, & - mpas_from_ufs_cnst, ufs_from_mpas_cnst) + mpas_from_ufs_cnst, ufs_from_mpas_cnst, debug) ! MPAS use mpas_pool_routines, only : mpas_pool_add_config, mpas_pool_get_subpool use mpas_pool_routines, only : mpas_pool_add_dimension, mpas_pool_get_field @@ -106,19 +112,14 @@ subroutine ufs_mpas_init(Cfg, time_start, time_end, total_time, calendar, logUni use mpas_bootstrapping, only : mpas_bootstrap_framework_phase2 use mpas_stream_inquiry, only : mpas_stream_inquiry_new_streaminfo use mpas_derived_types, only : mpas_pool_type, mpas_IO_NETCDF, field3dReal - use mpas_derived_types, only : MPAS_STREAM_MGR_NOERR, MPAS_LOG_ERR + use mpas_derived_types, only : MPAS_STREAM_MGR_NOERR use mpas_kind_types, only : StrKIND, RKIND - use mpas_log, only : mpas_log_write use atm_core_interface, only : atm_setup_core, atm_setup_domain use mpas_constants, only : mpas_constants_compute_derived, pi => pii use mpas_attlist, only : mpas_add_att use mpas_rbf_interpolation, only : mpas_rbf_interp_initialize use mpas_vector_reconstruction, only : mpas_init_reconstruct use mpas_timekeeping, only : mpas_NOW - ! FMS - use field_manager_mod, only : MODEL_ATMOS - use fms2_io_mod, only : file_exists - use mpp_mod, only : FATAL, mpp_error ! PIO use pio, only : pio_global, pio_get_att ! Arguments @@ -127,6 +128,7 @@ subroutine ufs_mpas_init(Cfg, time_start, time_end, total_time, calendar, logUni integer, intent(in ) :: total_time character(17), intent(in ) :: calendar integer, pointer, intent(in ) :: mpas_from_ufs_cnst(:), ufs_from_mpas_cnst(:) + logical, intent(in ) :: debug ! Locals character(len=*), parameter :: subname = 'ufs_mpas_subdriver::ufs_mpas_init' integer :: i, ndate1, ndate2, tod, ierr, ik, kk @@ -135,14 +137,15 @@ subroutine ufs_mpas_init(Cfg, time_start, time_end, total_time, calendar, logUni character (len=StrKIND), pointer :: initial_time, config_start_time integer, pointer :: num_scalars, mpas_from_ufs_cnst2(:), ufs_from_mpas_cnst2(:) logical, pointer :: config_apply_lbcs + logical :: file_exists ! Setup MPAS infrastructure allocate(corelist, stat=ierr) - if ( ierr /= 0 ) call mpp_error(FATAL,subname//": failed to allocate corelist array") + !if ( ierr /= 0 ) call mpas_log_write(subname // " failed to allocate corelist array", messageType=MPAS_LOG_CRIT) nullify(corelist % next) allocate(corelist % domainlist, stat=ierr) - if ( ierr /= 0 ) call mpp_error(FATAL,subname//": failed to allocate corelist%domainlist%next") + !if ( ierr /= 0 ) call mpas_log_write(subname // " failed to allocate corelist%domainlist%next", messageType=MPAS_LOG_CRIT) nullify(corelist % domainlist % next) domain_ptr => corelist % domainlist @@ -168,16 +171,17 @@ subroutine ufs_mpas_init(Cfg, time_start, time_end, total_time, calendar, logUni domain_ptr % core % build_target = 'N/A' ierr = domain_ptr % core % setup_log(domain_ptr % logInfo, domain_ptr, unitNumbers=logUnits) if ( ierr /= 0 ) then - call mpp_error(FATAL,subname//": Log setup failed for MPAS-A dycore") + call mpas_log_write(subname // " Log setup failed for MPAS-A dycore", messageType=MPAS_LOG_CRIT) end if ! ! Read MPAS namelist. ! - if (file_exists('input.nml')) then + INQUIRE(FILE='input.nml', EXIST=file_exists) + if (file_exists) then call read_mpas_namelist('input.nml', domain_ptr % configs, Cfg % mpi_comm, Cfg % master, Cfg % me) else - call mpp_error(FATAL,subname//": Cannot find MPAS namelist file, input.nml") + call mpas_log_write(subname // " Cannot find MPAS namelist file, input.nml", messageType=MPAS_LOG_CRIT) end if ! Set forecast start time (config_start_time) @@ -213,28 +217,33 @@ subroutine ufs_mpas_init(Cfg, time_start, time_end, total_time, calendar, logUni ! domain_ptr % streamInfo => mpas_stream_inquiry_new_streaminfo() if (.not. associated(domain_ptr % streamInfo)) then - call mpp_error(FATAL,subname//": Failed to instantiate streamInfo object for "//trim(domain_ptr % core % coreName)) + call mpas_log_write(subname // " Failed to instantiate streamInfo object for "// & + trim(domain_ptr % core % coreName), messageType=MPAS_LOG_CRIT) end if ierr = domain_ptr % core % define_packages(domain_ptr % packages) if (ierr /= 0) then - call mpp_error(FATAL,subname//": Package definition failed for "//trim(domain_ptr % core % coreName)) + call mpas_log_write(subname // " Package definition failed for "// & + trim(domain_ptr % core % coreName), messageType=MPAS_LOG_CRIT) end if ierr = domain_ptr % core % setup_packages(domain_ptr % configs, domain_ptr % streamInfo, & domain_ptr % packages, domain_ptr % iocontext) if (ierr /= 0) then - call mpp_error(FATAL,subname//": Package setup failed for "//trim(domain_ptr % core % coreName)) + call mpas_log_write(subname // " Package setup failed for "// & + trim(domain_ptr % core % coreName), messageType=MPAS_LOG_CRIT) end if ierr = domain_ptr % core % setup_decompositions(domain_ptr % decompositions) if (ierr /= 0) then - call mpp_error(FATAL,subname//": Decomposition setup failed for "//trim(domain_ptr % core % coreName)) + call mpas_log_write(subname // " Decomposition setup failed for "// & + trim(domain_ptr % core % coreName), messageType=MPAS_LOG_CRIT) end if ierr = domain_ptr % core % setup_clock(domain_ptr % clock, domain_ptr % configs) if (ierr /= 0) then - call mpp_error(FATAL,subname//": Clock setup failed for "//trim(domain_ptr % core % coreName)) + call mpas_log_write(subname // " Clock setup failed for "// & + trim(domain_ptr % core % coreName), messageType=MPAS_LOG_CRIT) end if ! Adding a config named 'cam_pcnst' with the number of constituents will indicate to @@ -268,7 +277,7 @@ subroutine ufs_mpas_init(Cfg, time_start, time_end, total_time, calendar, logUni nullify (state) call ufs_mpas_define_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) if (ierr /= 0) then - call mpp_error(FATAL,'ERROR: Set-up of constituents for MPAS-A dycore failed.') + call mpas_log_write(subname // " Set-up of constituents for MPAS-A dycore failed.", messageType=MPAS_LOG_CRIT) end if ! @@ -285,17 +294,17 @@ subroutine ufs_mpas_init(Cfg, time_start, time_end, total_time, calendar, logUni nullify (lbc) call ufs_mpas_define_lbc_scalars(mpas_from_ufs_cnst, ufs_from_mpas_cnst, ierr) if (ierr /= 0) then - call mpp_error(FATAL,'ERROR: Set-up of LBC constituents for MPAS-A dycore failed.') + call mpas_log_write(subname // " Set-up of LBC constituents for MPAS-A dycore failed.", messageType=MPAS_LOG_CRIT) end if end if ! ! Read in static (invariant) data ! - call dyn_mpas_read_write_stream(domain_ptr % clock, 'r', 'invariant', pio_file_desc=pioid_ic, ierr=ierr, timeLevel=1, whence=mpas_NOW, nRecord=1) + call dyn_mpas_read_write_stream(domain_ptr % clock, 'r', 'invariant', pio_file_desc=pioid_ic, & + ierr=ierr, timeLevel=1, whence=mpas_NOW, nRecord=1, debug=debug) if (ierr /= MPAS_STREAM_MGR_NOERR) then - call mpas_log_write('Could not read from ''invariant'' stream ',messageType=MPAS_LOG_ERR) - call mpp_error(FATAL,'ERROR: Could not read from ''invariant'' stream ') + call mpas_log_write(subname // " Could not read from ''invariant'' stream ",messageType=MPAS_LOG_CRIT) end if ! FROM CAM/driver/cam_mpas_subdriver.F90 @@ -315,7 +324,7 @@ subroutine ufs_mpas_init(Cfg, time_start, time_end, total_time, calendar, logUni ! Read the global sphere_radius attribute. This is needed to normalize the cell areas. ierr = pio_get_att(pioid_ic, pio_global, 'sphere_radius', domain_ptr % sphere_radius) if( ierr /= 0 ) then - call mpp_error(FATAL,subname//": Could not find sphere_radius PIO attribute") + call mpas_log_write(subname // " Could not find sphere_radius PIO attribute",messageType=MPAS_LOG_CRIT) endif ! FROM CAM/dyn_grid.F90:dyn_grid_init() @@ -332,7 +341,7 @@ subroutine ufs_mpas_init(Cfg, time_start, time_end, total_time, calendar, logUni ! ! Initialize core ! - call ufs_mpas_atm_core_init(Cfg) + call ufs_mpas_atm_core_init(Cfg, debug) end subroutine ufs_mpas_init @@ -342,29 +351,28 @@ end subroutine ufs_mpas_init !> Follows atm_core_init() in MPAS-Model/src/core_atmosphere/mpas_atm_core.F. !> !> ######################################################################################## - subroutine ufs_mpas_atm_core_init(Cfg) + subroutine ufs_mpas_atm_core_init(Cfg, debug) use mpas_kind_types, only : StrKIND, RKIND use mpas_derived_types, only : mpas_pool_type, mpas_Time_Type, field0DReal, field2dreal - use mpas_derived_types, only : block_type, field3dreal, MPAS_STREAM_MGR_NOERR, MPAS_LOG_ERR + use mpas_derived_types, only : block_type, field3dreal, MPAS_STREAM_MGR_NOERR use mpas_domain_routines, only : mpas_pool_get_dimension use mpas_pool_routines, only : mpas_pool_get_subpool use mpas_pool_routines, only : mpas_pool_initialize_time_levels, mpas_pool_get_config use mpas_pool_routines, only : mpas_pool_get_array, mpas_pool_get_field use mpas_atm_dimensions, only : mpas_atm_set_dims use mpas_atm_threading, only : mpas_atm_threading_init - use mpp_mod, only : FATAL, mpp_error use mpas_atm_halos, only : atm_build_halo_groups, exchange_halo_group use atm_core, only : atm_mpas_init_block use atm_time_integration, only : mpas_atm_dynamics_checks use atm_time_integration, only : mpas_atm_dynamics_init use mpas_timekeeping, only : mpas_get_clock_time, mpas_get_time, mpas_START_TIME use mpas_timekeeping, only : mpas_NOW, mpas_set_timeInterval, operator(+) - use mpas_log, only : mpas_log_write use mpas_attlist, only : mpas_modify_att use mpas_string_utils, only : mpas_string_replace use mpas_field_routines, only : mpas_allocate_scratch_field ! Arguments type(mpas_control_type), intent(inout) :: Cfg + logical, intent(in ) :: debug type(mpas_pool_type), pointer :: tend_physics_pool ! Locals character(len=*), parameter :: subname = 'ufs_mpas_subdriver::ufs_mpas_atm_core_init' @@ -388,7 +396,7 @@ subroutine ufs_mpas_atm_core_init(Cfg) call mpas_log_write('Setting up OpenMP threading') call mpas_atm_threading_init(domain_ptr%blocklist, ierr) if ( ierr /= 0 ) then - call mpp_error(FATAL,subname//": Threading setup failed for core "//trim(domain_ptr % core % coreName)) + call mpas_log_write(subname // " Threading setup failed for core "//trim(domain_ptr % core % coreName)) end if ! @@ -416,10 +424,10 @@ subroutine ufs_mpas_atm_core_init(Cfg) nullify(exchange_halo_group) call atm_build_halo_groups(domain_ptr, ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//": failed to build MPAS-A halo exchange groups.") + call mpas_log_write(subname // " failed to build MPAS-A halo exchange groups.",messageType=MPAS_LOG_CRIT) end if if (.not. associated(exchange_halo_group)) then - call mpp_error(FATAL,subname//": failed to build MPAS-A halo exchange groups.") + call mpas_log_write(subname // " failed to build MPAS-A halo exchange groups.",messageType=MPAS_LOG_CRIT) endif ! @@ -430,23 +438,25 @@ subroutine ufs_mpas_atm_core_init(Cfg) ! Read in initial-conditions ! call mpas_log_write('Reading in MPAS initial condition stream.') - call dyn_mpas_read_write_stream(clock, 'r', 'input', pio_file_desc=pioid_ic, ierr=ierr, timeLevel=1, whence=mpas_NOW, nRecord=1) + call dyn_mpas_read_write_stream(clock, 'r', 'input', pio_file_desc=pioid_ic, ierr=ierr, & + timeLevel=1, whence=mpas_NOW, nRecord=1, debug=debug) if (ierr /= MPAS_STREAM_MGR_NOERR) then - call mpas_log_write('Could not read from ''input'' stream ',messageType=MPAS_LOG_ERR) - call mpp_error(FATAL,'ERROR: Could not read from ''input'' stream ') + call mpas_log_write(subname // " Could not read from ''input'' stream ",messageType=MPAS_LOG_CRIT) end if - call dyn_mpas_read_write_stream(clock, 'r', 'sfc_input', pio_file_desc=pioid_ic, ierr=ierr, timeLevel=1, whence=mpas_NOW, nRecord=1) + call dyn_mpas_read_write_stream(clock, 'r', 'sfc_input', pio_file_desc=pioid_ic, ierr=ierr, & + timeLevel=1, whence=mpas_NOW, nRecord=1, debug=debug) if (ierr /= MPAS_STREAM_MGR_NOERR) then - call mpas_log_write('Could not read from ''sfc_input'' stream ',messageType=MPAS_LOG_ERR) - call mpp_error(FATAL,'ERROR: Could not read from ''input'' stream ') + call mpas_log_write(subname // " Could not read from ''sfc_input'' stream ",messageType=MPAS_LOG_CRIT) end if ! ! Read in restart data. ! - !call mpas_log_write('Reading in MPAS restart stream.') - !call dyn_mpas_read_write_stream(clock, 'r', 'restart', ierr=ierr, timeLevel=1, whence=mpas_NOW) - + if (config_do_restart) then + call mpas_log_write('Reading in MPAS restart stream.') + call dyn_mpas_read_write_stream(clock, 'r', 'restart', pio_file_desc=pioid_restart, ierr=ierr, & + timeLevel=1, whence=mpas_NOW, nRecord=1, debug=debug) + end if if (.not. config_do_restart) then call mpas_log_write('Initializing time levels') @@ -466,18 +476,18 @@ subroutine ufs_mpas_atm_core_init(Cfg) ! startTime = mpas_get_clock_time(clock, mpas_START_TIME, ierr) if ( ierr /= 0 ) then - call mpp_error(FATAL,subname//': Failed to get clock_time "mpas_START_TIME"') + call mpas_log_write(subname // " Failed to get clock_time mpas_START_TIME",messageType=MPAS_LOG_CRIT) end if call mpas_get_time(startTime, dateTimeString=startTimeStamp, ierr=ierr) if ( ierr /= 0 ) then - call mpp_error(FATAL,subname//': Failed to get time mpas_START_TIME"') + call mpas_log_write(subname // " Failed to get time mpas_START_TIME",messageType=MPAS_LOG_CRIT) end if call mpas_log_write('Setting simulation start time :'//startTimeStamp) ! call exchange_halo_group(domain_ptr, 'initialization:u',ierr=ierr) if ( ierr /= 0 ) then - call mpp_error(FATAL,subname//'Failed to exchange halo layers for group "initialization:u"') + call mpas_log_write(subname // ' Failed to exchange halo layers for group "initialization:u"',messageType=MPAS_LOG_CRIT) end if ! @@ -485,15 +495,13 @@ subroutine ufs_mpas_atm_core_init(Cfg) ! call mpas_atm_dynamics_checks(domain_ptr % dminfo, domain_ptr % blocklist, domain_ptr % streamManager, ierr) if (ierr /= 0) then - call mpas_log_write('Failed dynamics compatibility test.') - return + call mpas_log_write(subname // " Failed dynamics compatibility test.",messageType=MPAS_LOG_CRIT) end if call mpas_pool_get_config( domain_ptr % blocklist % configs, 'config_apply_lbcs', config_apply_lbcs) if (config_apply_lbcs) then call ufs_mpas_atm_bdy_checks(domain_ptr % dminfo, domain_ptr % blocklist, ierr) if (ierr /= 0) then - call mpas_log_write('Failed regional compatibility test.') - return + call mpas_log_write(subname // " Failed regional compatibility test.",messageType=MPAS_LOG_CRIT) end if end if @@ -516,7 +524,7 @@ subroutine ufs_mpas_atm_core_init(Cfg) call exchange_halo_group(domain_ptr, 'initialization:pv_edge,ru,rw',ierr=ierr) if ( ierr /= 0 ) then - call mpp_error(FATAL,subname//'Failed to exchange halo layers for group "initialization:ru,rw"') + call mpas_log_write(subname // ' Failed to exchange halo layers for group "initialization:ru,rw"',messageType=MPAS_LOG_CRIT) end if ! @@ -534,86 +542,65 @@ end subroutine ufs_mpas_atm_core_init !> Loop over dynamical time-step(s) and increment MPAS state (timelevel 1->2) !> !> ######################################################################################### - subroutine ufs_mpas_run(mpasClock, outClock) + subroutine ufs_mpas_run(mpasClock, outClock, debug) ! MPAS use atm_core, only : atm_do_timestep, atm_compute_output_diagnostics use mpas_domain_routines, only : mpas_pool_get_dimension use mpas_derived_types, only : mpas_Time_type, mpas_pool_type, MPAS_TimeInterval_type, field2DReal - use mpas_derived_types, only : MPAS_LOG_ERR use mpas_kind_types, only : StrKIND, RKIND, R8KIND use mpas_constants, only : rvord use mpas_pool_routines, only : mpas_pool_get_config, mpas_pool_get_subpool use mpas_pool_routines, only : mpas_pool_shift_time_levels, mpas_pool_get_array - use mpas_log, only : mpas_log_write use mpas_timer, only : mpas_timer_start, mpas_timer_stop use mpas_timekeeping, only : mpas_advance_clock, mpas_get_clock_time, mpas_get_time use mpas_timekeeping, only : mpas_NOW, mpas_is_clock_stop_time, mpas_dmpar_get_time use mpas_timekeeping, only : mpas_set_timeInterval, operator(+), operator(.LT.), operator(.GT.), operator(.LE.), operator(.EQ.) - ! FMS - use mpp_mod, only : FATAL, mpp_error - use mpp_mod, only : mpp_clock_begin, mpp_clock_end ! Arguments - integer, intent(inout) :: mpasClock, outClock + real(kind=R8KIND), intent(inout) :: mpasClock,outClock + logical, intent(in ) :: debug ! Locals character(len=*), parameter :: subname = 'ufs_mpas_run::ufs_mpas_run' real (kind=RKIND), pointer :: config_dt type (mpas_pool_type), pointer :: state, diag, mesh type (mpas_Time_type) :: timeNow, timeStop,timeLBCnew - character(len=StrKIND) :: timeStamp + character(len=StrKIND) :: timeStamp, timeStampOutFile integer :: ierr, itime, itimestep, iout real (kind=R8KIND) :: integ_start_time, integ_stop_time logical, pointer :: config_apply_lbcs - type(mpas_timeinterval_type) :: mpas_time_interval, mpas_output_interval + type(mpas_timeinterval_type) :: mpas_time_interval, mpas_output_interval, mpas_restart_interval real (kind=RKIND), dimension(:,:,:), pointer :: scalars - + real (kind=RKIND) :: start_time, stop_time + ! Start dynamics timer - call mpp_clock_begin(mpasClock) + start_time = MPI_Wtime() call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'state', state) call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'diag', diag) call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', mesh) call atm_compute_output_diagnostics(state, 1, diag, mesh) - ! Eventually, dt should be domain specific - call mpas_pool_get_config( domain_ptr % blocklist % configs, 'config_dt', config_dt) + ! Grab runtime configuration + call mpas_pool_get_config( domain_ptr % blocklist % configs, 'config_dt', config_dt) call mpas_pool_get_config( domain_ptr % blocklist % configs, 'config_apply_lbcs', config_apply_lbcs) - + ! Set up clock timeNow = mpas_get_clock_time(clock, mpas_NOW, ierr=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//': Failed to get clock_time for "mpas_NOW"') + call mpas_log_write(subname // ' Failed to get clock_time for "mpas_NOW"',messageType=MPAS_LOG_CRIT) + endif call mpas_get_time(curr_time=timeNow, dateTimeString=timeStamp, ierr=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//': Failed to get clock_time for "mpas_NOW"') + call mpas_log_write(subname // ' Failed to get clock_time for "mpas_NOW"',messageType=MPAS_LOG_CRIT) endif ! Set dycore interval call MPAS_set_timeInterval(mpas_time_interval, S=dt_atmos, ierr=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//'Failed to set dynamics time step') + call mpas_log_write(subname // ' Failed to set dynamics time step',messageType=MPAS_LOG_CRIT) endif - - ! - ! Set MPAS output file times - ! - if (.not. allocated(mpas_output_times)) then - allocate(mpas_output_times(size(output_fh))) - mpas_output_times(1) = timeNow - do iout=2,size(output_fh) - call mpas_set_timeInterval(mpas_output_interval, S=int(3600.*output_fh(iout)), ierr=ierr) - mpas_output_times(iout) = timeNow + mpas_output_interval - if ( ierr /= 0 ) then - call mpp_error(FATAL,subname//': Failed to set output file names"') - end if - enddo - ! Also, write IC state to history file while we're here. - call ufs_mpas_write("output", timeStamp) - ! Start output file counter - out_file_index = 2 - endif - + ! ! Read initial boundary state ! During integration, time level 1 stores the boundary tendencies (next-current) file records, @@ -621,14 +608,12 @@ subroutine ufs_mpas_run(mpasClock, outClock) if (config_apply_lbcs .and. init_lbc) then call mpas_log_write('--------------------------------------------------') call mpas_log_write('Compute initial lateral boundary conditions for timestep '//trim(timeStamp)) - call ufs_mpas_atm_update_bdy_tend(clock, domain_ptr % blocklist, .true., nRecord_lbc, ierr) + call ufs_mpas_atm_update_bdy_tend(clock, domain_ptr % blocklist, .true., nRecord_lbc, ierr, debug) if (ierr /= 0) then call mpas_log_write('Failed to process LBC data at next time after '//trim(timeStamp), messageType=MPAS_LOG_ERR) return end if init_lbc = .false. - ! Also, write IC state to history file while we're here. - call ufs_mpas_write("output", timeStamp) end if ! During integration, time level 1 stores the model state at the beginning of the @@ -642,7 +627,7 @@ subroutine ufs_mpas_run(mpasClock, outClock) call mpas_get_time(curr_time=timeNow, dateTimeString=timeStamp, ierr=ierr) if ( ierr /= 0 ) then - call mpp_error(FATAL,subname//': Failed to get time mpas_NOW"') + call mpas_log_write(subname // ' Failed to get time "mpas_NOW"',messageType=MPAS_LOG_CRIT) end if call mpas_log_write(' Start timestep at '//trim(timeStamp)) @@ -654,7 +639,7 @@ subroutine ufs_mpas_run(mpasClock, outClock) nRecord_lbc = nRecord_lbc + 1 call mpas_log_write('--------------------------------------------------') call mpas_log_write('Update lateral boundary conditions for timestep '//trim(timeStamp)) - call ufs_mpas_atm_update_bdy_tend(clock, domain_ptr % blocklist, .false., nRecord_lbc, ierr) + call ufs_mpas_atm_update_bdy_tend(clock, domain_ptr % blocklist, .false., nRecord_lbc, ierr, debug) if (ierr /= 0) then call mpas_log_write('Failed to process LBC data at next time after '//trim(timeStamp), messageType=MPAS_LOG_ERR) return @@ -677,15 +662,16 @@ subroutine ufs_mpas_run(mpasClock, outClock) ! Advance clock. call mpas_advance_clock(clock, ierr=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//': Failed to advance clock') + call mpas_log_write(subname // ' Failed to advance clock',messageType=MPAS_LOG_CRIT) endif timeNow = mpas_get_clock_time(clock, mpas_NOW, ierr=ierr) if (ierr /= 0) then - call mpp_error(FATAL,subname//': Failed to get clock_time for "mpas_NOW"') + call mpas_log_write(subname // ' Failed to get clock_time for "mpas_NOW"',messageType=MPAS_LOG_CRIT) endif end do call mpas_log_write('MPAS dynamics stop timestep') - call mpp_clock_end(mpasClock) + stop_time = MPI_Wtime() + mpasClock = mpasCLock + + (stop_time - start_time) ! ! Compute diagnostic fields (theta, rho, pres) from @@ -699,17 +685,30 @@ subroutine ufs_mpas_run(mpasClock, outClock) ! ! Write any output streams ! - call mpp_clock_begin(outClock) + start_time = MPI_Wtime() call mpas_get_time(curr_time=timeStop, dateTimeString=timeStamp, ierr=ierr) if ( ierr /= 0 ) then - call mpp_error(FATAL,subname//': Failed to get time timeStop"') + call mpas_log_write(subname // ' Failed to get time timeStop"',messageType=MPAS_LOG_CRIT) end if + call create_file_timeStamp(timeStop,timeStampOutFile) + ! Output stream if (timeStop .EQ. mpas_output_times(out_file_index)) then - call ufs_mpas_write("output", timeStamp) + call ufs_mpas_write("output", timeStampOutFile, debug) out_file_index = out_file_index + 1 end if - call mpp_clock_end(outClock) + + ! Restart stream + if (allocated(mpas_restart_times)) then + if (timeStop .EQ. mpas_restart_times(restart_file_index)) then + call ufs_mpas_write("restart", timeStampOutFile, debug) + restart_file_index = restart_file_index + 1 + end if + end if + + ! Stop timer outClock + stop_time = MPI_Wtime() + outClock = outClock + (stop_time - start_time) end subroutine ufs_mpas_run @@ -720,16 +719,14 @@ end subroutine ufs_mpas_run !> is also where the default values defined below originate. !> !> ######################################################################################### - subroutine read_mpas_namelist(nml_file, configPool, mpicomm, master, me) + subroutine read_mpas_namelist(nml_file,configPool, mpicomm, master, me) use mpi_f08, only: MPI_Comm, MPI_CHARACTER, MPI_INTEGER, MPI_REAL8, MPI_LOGICAL use mpi_f08, only: mpi_bcast, mpi_barrier use mpas_derived_types, only: mpas_pool_type use mpas_kind_types, only: StrKIND, RKIND use mpas_pool_routines, only: mpas_pool_add_config - use mpas_log, only : mpas_log_write use mpas_typedefs, only: r8 => kind_dbl_prec - use fms_mod, only: check_nml_error - use mpp_mod, only: input_nml_file + ! Inputs type(MPI_Comm), intent(in ) :: mpicomm integer, intent(in ) :: master, me @@ -835,34 +832,40 @@ subroutine read_mpas_namelist(nml_file, configPool, mpicomm, master, me) ! Locals integer :: ierr, io, mpierr + character(len=*), parameter :: subname = 'ufs_mpas_subdriver::read_mpas_namelist' + logical :: file_exists ! Read in namelists... if (me == master) then - call mpas_log_write('Reading MPAS-A dynamical core namelist') - ! nhyd_model - read(input_nml_file, nml=mpas_nhyd_model, iostat=io) - ierr = check_nml_error(io, 'mpas_nhyd_model') - ! damping - read(input_nml_file, nml=mpas_damping, iostat=io) - ierr = check_nml_error(io, 'mpas_damping') - ! limited_area - read(input_nml_file, nml=mpas_limited_area, iostat=io) - ierr = check_nml_error(io, 'mpas_limited_area') - ! PIO - read(input_nml_file, nml=mpas_io, iostat=io) - ierr = check_nml_error(io, 'mpas_io') - ! assimilation - read(input_nml_file, nml=mpas_assimilation, iostat=io) - ierr = check_nml_error(io, 'mpas_assimilation') - ! decomposition - read(input_nml_file, nml=mpas_decomposition, iostat=io) - ierr = check_nml_error(io, 'mpas_decomposition') - ! restart - read(input_nml_file, nml=mpas_restart, iostat=io) - ierr = check_nml_error(io, 'mpas_restart') - ! printout - read(input_nml_file, nml=mpas_printout, iostat=io) - ierr = check_nml_error(io, 'mpas_printout') + inquire(file = trim(nml_filename), exist=file_exists) + if (file_exists) then + call mpas_log_write('Reading MPAS-A dynamical core namelist') + open(newunit=nml_funit,file=trim(nml_filename),status='unknown') + ! nhyd_model + read(nml_funit, nml=mpas_nhyd_model, iostat=io) + if (io .ne. 0) call mpas_log_write(subname // ' Reading in MPAS namelist mpas_nhyd_model',messageType=MPAS_LOG_CRIT) + ! damping + read(nml_funit, nml=mpas_damping, iostat=io) + if (io .ne. 0) call mpas_log_write(subname // ' Reading in MPAS namelist mpas_damping',messageType=MPAS_LOG_CRIT) + ! limited_area + read(nml_funit, nml=mpas_limited_area, iostat=io) + if (io .ne. 0) call mpas_log_write(subname // ' Reading in MPAS namelist mpas_limited_area',messageType=MPAS_LOG_CRIT) + ! PIO + read(nml_funit, nml=mpas_io, iostat=io) + if (io .ne. 0) call mpas_log_write(subname // ' Reading in MPAS namelist mpas_io',messageType=MPAS_LOG_CRIT) + ! assimilation + read(nml_funit, nml=mpas_assimilation, iostat=io) + if (io .ne. 0) call mpas_log_write(subname // ' Reading in MPAS namelist mpas_assimilation',messageType=MPAS_LOG_CRIT) + ! decomposition + read(nml_funit, nml=mpas_decomposition, iostat=io) + if (io .ne. 0) call mpas_log_write(subname // ' Reading in MPAS namelist mpas_decomposition',messageType=MPAS_LOG_CRIT) + ! restart + read(nml_funit, nml=mpas_restart, iostat=io) + if (io .ne. 0) call mpas_log_write(subname // ' Reading in MPAS namelist mpas_restart',messageType=MPAS_LOG_CRIT) + ! printout + read(nml_funit, nml=mpas_printout, iostat=io) + if (io .ne. 0) call mpas_log_write(subname // ' Reading in MPAS namelist mpas_printout',messageType=MPAS_LOG_CRIT) + endif endif ! Other processors waiting... diff --git a/ufsatm_cap.F90 b/ufsatm_cap.F90 index ff342c4f6..e494ae61d 100644 --- a/ufsatm_cap.F90 +++ b/ufsatm_cap.F90 @@ -43,6 +43,7 @@ module ufsatm_cap_mod pio_numiotasks, pio_iodesc, cpl_grid_id, & cplprint_flag, first_kdt, quilting, & quilting_restart + use module_mpas_config, only: mpas_output_times, mpas_restart_times #endif use module_fv3_io_def, only: num_pes_fcst,write_groups, & num_files, filename_base, & @@ -67,6 +68,7 @@ module ufsatm_cap_mod #ifdef UFS_TRACING use ufs_trace_mod #endif + use shr_is_restart_fh_mod, only : init_is_restart_fh, is_restart_fh_type implicit none private @@ -101,6 +103,10 @@ module ufsatm_cap_mod integer, allocatable :: frestart(:) real(kind=8) :: timere, timep2re + type(is_restart_fh_type) :: restartfh_info + type(is_restart_fh_type) :: outputfh_info + type(is_restart_fh_type) :: diagfh_info + type(is_restart_fh_type) :: dafh_info !----------------------------------------------------------------------- contains @@ -237,6 +243,7 @@ subroutine InitializeAdvertise(gcomp, rc) real :: nfhmax real :: output_startfh, outputfh, outputfh2(2) logical :: loutput_fh, lfreq + logical :: lrestart_fh character(ESMF_MAXSTR) :: gc_name, fb_name integer,dimension(:), allocatable :: petList, originPetList, targetPetList character(len=esmf_maxstr),allocatable :: fcstItemNameList(:) @@ -1333,7 +1340,7 @@ subroutine OutputHours_ArrayInput(noutput_fh,output_startfh) integer :: ist, i integer, intent(inout) :: noutput_fh real, intent(inout) :: output_startfh - + if( output_startfh == 0) then ! If the output time in output_fh array contains first time stamp output, ! check the rest of output time, otherwise, check all the output time. @@ -1687,6 +1694,7 @@ subroutine ModelSetRunClock(gcomp, rc) type(ESMF_Clock) :: dclock, mclock type(ESMF_TimeInterval) :: dtimestep, mtimestep type(ESMF_Time) :: mcurrtime, mstoptime + integer :: dtime, ifout !----------------------------------------------------------------------------- @@ -1708,6 +1716,32 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_ClockSet(mclock, timeStep=mtimestep, stopTime=mstoptime, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +#ifdef MPAS + ! Setup MPAS output stream times. + call ESMF_TimeIntervalGet( dtimestep, s=dtime, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call init_is_restart_fh(mcurrTime, dtime, .false., outputfh_info, key='output_fh') + allocate(mpas_output_times(size(outputfh_info%restartFhTimes))) + do ifout =1,size(outputfh_info%restartFhTimes) + mpas_output_times(ifout)%t = outputfh_info%restartFhTimes(ifout) + end do + + ! Setup MPAS history stream times. + call ESMF_TimeIntervalGet( dtimestep, s=dtime, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call init_is_restart_fh(mcurrTime, dtime, .false., restartfh_info) + allocate(mpas_restart_times(size(restartfh_info%restartFhTimes))) + do ifout =1,size(restartfh_info%restartFhTimes) + mpas_restart_times(ifout)%t = restartfh_info%restartFhTimes(ifout) + end do + + ! Setup MPAS diagnostic stream times. + ! NOT YET IMPLEMENTED + ! This will default to being the same as the output stream. + + ! Setup MPAS da stream times. + ! NOT YET IMPLEMENTED +#endif end subroutine ModelSetRunClock !-----------------------------------------------------------------------------