Skip to content

Commit

Permalink
Merge branch 'main' into PE_layout_changes
Browse files Browse the repository at this point in the history
  • Loading branch information
@rem1776
rem1776 authored Jul 14, 2023
2 parents d69489d + eeadda8 commit 831f043
Show file tree
Hide file tree
Showing 13 changed files with 1,881 additions and 1,867 deletions.
127 changes: 65 additions & 62 deletions SHiELD/coupler_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,8 +32,9 @@ program coupler_main
update_atmos_model_state, &
atmos_data_type, atmos_model_restart
!--- FMS old io
#ifdef use_deprecated_io
use fms_io_mod, only: fms_io_exit!< This can't be removed until fms_io is not used at all

#endif
implicit none

!-----------------------------------------------------------------------
Expand All @@ -48,7 +49,7 @@ program coupler_main
!-----------------------------------------------------------------------
! ----- coupled model time -----

type (time_type) :: Time_atmos, Time_init, Time_end, &
type (FmsTime_type) :: Time_atmos, Time_init, Time_end, &
Time_step_atmos, Time_step_ocean, &
Time_restart, Time_step_restart, &
Time_start_restart, Time_restart_aux, &
Expand Down Expand Up @@ -119,20 +120,20 @@ program coupler_main

call fms_init()

initClock = mpp_clock_id( '-Initialization' )
call mpp_clock_begin (initClock) !nesting problem
initClock = fms_mpp_clock_id( '-Initialization' )
call fms_mpp_clock_begin (initClock) !nesting problem

call sat_vapor_pres_init()
call fms_sat_vapor_pres_init()
call fmsconstants_init()

call coupler_init
call print_memuse_stats('after coupler init')
call fms_memutils_print_memuse_stats('after coupler init')

call mpp_set_current_pelist()
call mpp_clock_end (initClock) !end initialization
call fms_mpp_set_current_pelist()
call fms_mpp_clock_end (initClock) !end initialization

mainClock = mpp_clock_id( '-Main Loop' )
call mpp_clock_begin(mainClock) !begin main loop
mainClock = fms_mpp_clock_id( '-Main Loop' )
call fms_mpp_clock_begin(mainClock) !begin main loop

do nc = 1, num_cpld_calls

Expand All @@ -148,15 +149,15 @@ program coupler_main
if (intrm_rst) then
if (nc /= num_cpld_calls) then
if (intrm_rst_1step .and. nc == 1) then
timestamp = date_to_string (Time_atmos)
timestamp = fms_time_manager_date_to_string (Time_atmos)
call atmos_model_restart(Atm, timestamp)
call coupler_restart(timestamp)
endif
if (Time_atmos == Time_restart .or. Time_atmos == Time_restart_aux) then
if (Time_atmos == Time_restart) then
timestamp = date_to_string (Time_restart)
timestamp = fms_time_manager_date_to_string (Time_restart)
else
timestamp = date_to_string (Time_restart_aux)
timestamp = fms_time_manager_date_to_string (Time_restart_aux)
endif
call atmos_model_restart(Atm, timestamp)
call coupler_restart(timestamp)
Expand All @@ -171,22 +172,22 @@ program coupler_main
endif
endif

call print_memuse_stats('after full step')
call fms_memutils_print_memuse_stats('after full step')

enddo

!-----------------------------------------------------------------------

call mpp_set_current_pelist()
call mpp_clock_end(mainClock)
call fms_mpp_set_current_pelist()
call fms_mpp_clock_end(mainClock)

termClock = mpp_clock_id( '-Termination' )
call mpp_clock_begin(termClock)
termClock = fms_mpp_clock_id( '-Termination' )
call fms_mpp_clock_begin(termClock)

call coupler_end

call mpp_set_current_pelist()
call mpp_clock_end(termClock)
call fms_mpp_set_current_pelist()
call fms_mpp_clock_end(termClock)

call fms_end

Expand All @@ -203,7 +204,7 @@ subroutine coupler_init
integer :: total_days, total_seconds, unit, ierr, io
integer :: n
integer :: date(6), flags
type (time_type) :: Run_length
type (FmsTime_type) :: Run_length
character(len=9) :: month

character(len=:), dimension(:), allocatable :: restart_file !< Restart file saved as a string
Expand All @@ -215,20 +216,20 @@ subroutine coupler_init

!----- read namelist -------
!----- for backwards compatibilty read from file coupler.nml -----
read(input_nml_file, nml=coupler_nml, iostat=io)
read(fms_mpp_input_nml_file, nml=coupler_nml, iostat=io)
ierr = check_nml_error(io, 'coupler_nml')

!----- write namelist to logfile -----
call write_version_number (version, tag)
if (mpp_pe() == mpp_root_pe()) write(stdlog(),nml=coupler_nml)
call fms_write_version_number (version, tag)
if (fms_mpp_pe() == fms_mpp_root_pe()) write(fms_mpp_stdlog(),nml=coupler_nml)

!----- allocate and set the pelist (to the global pelist) -----
allocate( Atm%pelist (mpp_npes()) )
call mpp_get_current_pelist(Atm%pelist)
allocate( Atm%pelist (fms_mpp_npes()) )
call fms_mpp_get_current_pelist(Atm%pelist)

!----- read restart file -----
if (file_exists('INPUT/coupler.res')) then
call ascii_read('INPUT/coupler.res', restart_file)
if (fms2_io_file_exists('INPUT/coupler.res')) then
call fms2_io_ascii_read('INPUT/coupler.res', restart_file)
read(restart_file(1), *) calendar_type
read(restart_file(2), *) date_init
read(restart_file(3), *) date
Expand All @@ -247,7 +248,7 @@ subroutine coupler_init
endif

!----- override calendar type with namelist value -----
select case( uppercase(trim(calendar)) )
select case( fms_mpp_uppercase(trim(calendar)) )
case( 'JULIAN' )
calendar_type = JULIAN
case( 'NOLEAP' )
Expand All @@ -257,17 +258,17 @@ subroutine coupler_init
case( 'NO_CALENDAR' )
calendar_type = NO_CALENDAR
case default
call mpp_error ( FATAL, 'COUPLER_MAIN: coupler_nml entry calendar must '// &
call fms_mpp_error ( FATAL, 'COUPLER_MAIN: coupler_nml entry calendar must '// &
'be one of JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' )
end select

endif

call set_calendar_type (calendar_type)
call fms_time_manager_set_calendar_type (calendar_type)

!----- write current/initial date actually used to logfile file -----
if ( mpp_pe() == mpp_root_pe() ) then
write (stdlog(),16) date(1),trim(month_name(date(2))),date(3:6)
if ( fms_mpp_pe() == fms_mpp_root_pe() ) then
write (fms_mpp_stdlog(),16) date(1),trim(fms_time_manager_month_name(date(2))),date(3:6)
endif
16 format (' current date used = ',i4,1x,a,2i3,2(':',i2.2),' gmt')

Expand All @@ -277,20 +278,20 @@ subroutine coupler_init

!-----------------------------------------------------------------------
!------ initialize diagnostics manager ------
call diag_manager_init (TIME_INIT=date)
call fms_diag_init (TIME_INIT=date)

!----- always override initial/base date with diag_manager value -----
call get_base_date ( date_init(1), date_init(2), date_init(3), &
call fms_diag_get_base_date ( date_init(1), date_init(2), date_init(3), &
date_init(4), date_init(5), date_init(6) )

!----- use current date if no base date ------
if ( date_init(1) == 0 ) date_init = date

!----- set initial and current time types ------
Time_init = set_date (date_init(1), date_init(2), date_init(3), &
Time_init = fms_time_manager_set_date (date_init(1), date_init(2), date_init(3), &
date_init(4), date_init(5), date_init(6))

Time_atmos = set_date (date(1), date(2), date(3), &
Time_atmos = fms_time_manager_set_date (date(1), date(2), date(3), &
date(4), date(5), date(6))

!-----------------------------------------------------------------------
Expand All @@ -304,52 +305,52 @@ subroutine coupler_init
Time_end = Time_atmos
total_days = 0
do n = 1, months
total_days = total_days + days_in_month(Time_end)
Time_end = Time_atmos + set_time (0,total_days)
total_days = total_days + fms_time_manager_days_in_month(Time_end)
Time_end = Time_atmos + fms_time_manager_set_time (0,total_days)
enddo

total_days = total_days + days
total_seconds = hours*3600 + minutes*60 + seconds
Run_length = set_time (total_seconds,total_days)
Run_length = fms_time_manager_set_time (total_seconds,total_days)
Time_end = Time_atmos + Run_length

!Need to pass Time_end into diag_manager for multiple thread case.
call diag_manager_set_time_end(Time_end)
call fms_diag_set_time_end(Time_end)


!-----------------------------------------------------------------------
!----- write time stamps (for start time and end time) ------
if ( mpp_pe().EQ.mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted')
if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted')

month = month_name(date(2))
if ( mpp_pe() == mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3)
month = fms_time_manager_month_name(date(2))
if ( fms_mpp_pe() == fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3)

call get_date (Time_end, date(1), date(2), date(3), &
call fms_time_manager_get_date (Time_end, date(1), date(2), date(3), &
date(4), date(5), date(6))
month = month_name(date(2))
if ( mpp_pe() == mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3)
month = fms_time_manager_month_name(date(2))
if ( fms_mpp_pe() == fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3)

if ( mpp_pe().EQ.mpp_root_pe() ) close (time_stamp_unit)
if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) close (time_stamp_unit)

20 format (6i4,2x,a3)

!-----------------------------------------------------------------------
!----- compute the time steps ------
Time_step_atmos = set_time (dt_atmos,0)
Time_step_ocean = set_time (dt_ocean,0)
Time_step_atmos = fms_time_manager_set_time (dt_atmos,0)
Time_step_ocean = fms_time_manager_set_time (dt_ocean,0)
num_cpld_calls = Run_length / Time_step_ocean
num_atmos_calls = Time_step_ocean / Time_step_atmos

Time_step_restart = set_time (restart_secs, restart_days)
Time_step_restart = fms_time_manager_set_time (restart_secs, restart_days)
if (restart_start_secs > 0 .or. restart_start_days > 0) then
Time_start_restart = set_time (restart_start_secs, restart_start_days)
Time_start_restart = fms_time_manager_set_time (restart_start_secs, restart_start_days)
Time_restart = Time_atmos + Time_start_restart
else
Time_restart = Time_atmos + Time_step_restart
end if
Time_step_restart_aux = set_time (restart_secs_aux, restart_days_aux)
Time_duration_restart_aux = set_time (restart_duration_secs_aux, restart_duration_days_aux)
Time_start_restart_aux = set_time (restart_start_secs_aux, restart_start_days_aux)
Time_step_restart_aux = fms_time_manager_set_time (restart_secs_aux, restart_days_aux)
Time_duration_restart_aux = fms_time_manager_set_time (restart_duration_secs_aux, restart_duration_days_aux)
Time_start_restart_aux = fms_time_manager_set_time (restart_start_secs_aux, restart_start_days_aux)
Time_restart_aux = Time_atmos + Time_start_restart_aux
Time_restart_end_aux = Time_restart_aux + Time_duration_restart_aux

Expand Down Expand Up @@ -383,14 +384,14 @@ subroutine coupler_init
call atmos_model_init (Atm, Time_init, Time_atmos, Time_step_atmos, &
iau_offset)

call print_memuse_stats('after atmos model init')
call fms_memutils_print_memuse_stats('after atmos model init')

!------ initialize data_override -----
if (.NOT.Atm%bounded_domain) call data_override_init (Atm_domain_in = Atm%domain)
if (.NOT.Atm%bounded_domain) call fms_data_override_init (Atm_domain_in = Atm%domain)

!-----------------------------------------------------------------------
!---- open and close dummy file in restart dir to check if dir exists --
if ( mpp_pe() == 0) then
if ( fms_mpp_pe() == 0) then
open(newunit = ascii_unit, file='RESTART/file', status='replace', form='formatted')
close(ascii_unit,status="delete")
endif
Expand All @@ -408,7 +409,7 @@ subroutine coupler_restart(time_stamp)

!----- compute current date ------

call get_date (Time_atmos, date(1), date(2), date(3), &
call fms_time_manager_get_date (Time_atmos, date(1), date(2), date(3), &
date(4), date(5), date(6))

!----- write restart file ------
Expand All @@ -419,7 +420,7 @@ subroutine coupler_restart(time_stamp)
file_res = 'RESTART/'//trim(time_stamp)//'.coupler.res'
endif

if ( mpp_pe().EQ.mpp_root_pe()) then
if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then
open(newunit = restart_unit, file=file_res, status='replace', form='formatted')
write(restart_unit, '(i6,8x,a)' )calendar_type, &
'(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)'
Expand All @@ -443,7 +444,7 @@ subroutine coupler_end
call atmos_model_end (Atm)


call get_date (Time_atmos, date(1), date(2), date(3), &
call fms_time_manager_get_date (Time_atmos, date(1), date(2), date(3), &
date(4), date(5), date(6))

!----- check time versus expected ending time ----
Expand All @@ -455,10 +456,12 @@ subroutine coupler_end
call coupler_restart()

!----- final output of diagnostic fields ----0
call diag_manager_end (Time_atmos)
call fms_diag_end (Time_atmos)

!----- to be removed once fms_io is fully deprecated -----
#ifdef use_deprecated_io
call fms_io_exit()
#endif

!-----------------------------------------------------------------------

Expand Down
Loading

0 comments on commit 831f043

Please sign in to comment.