120 use mpp_mod,
only:
mpp_error, note, warning, fatal, &
121 mpp_set_warn_level, &
125 mpp_clock_begin, mpp_clock_end, &
127 mpp_clock_sync, mpp_clock_detailed, &
128 clock_component, clock_subcomponent,&
129 clock_module_driver, clock_module, &
130 clock_routine, clock_loop, &
134 mpp_error_state, lowercase, &
149 use platform_mod,
only: r4_kind, r8_kind
151 use,
intrinsic :: iso_c_binding
165 public :: lowercase, uppercase, &
169 public ::
mpp_error, note, warning, fatal, &
174 public :: input_nml_file
176 public :: mpp_clock_sync, mpp_clock_detailed
177 public :: clock_component, clock_subcomponent, &
178 clock_module_driver, clock_module, &
179 clock_routine, clock_loop, clock_infra
185 module procedure :: monotonic_array_r4, monotonic_array_r8
191 integer,
public :: clock_flag_default
196 INTEGER :: multipleNMLSinFile
199 INTEGER :: missingVar
202 TYPE(nml_errors_type),
SAVE :: nml_errors
249 integer,
private :: num_nml_error_codes, nml_error_codes(20)
250 logical,
private :: do_nml_error_init = .true.
257 #include<file_version.h>
259 logical :: module_is_initialized = .false.
285 subroutine fms_init (localcomm, alt_input_nml_path)
288 use constants_mod,
only: constants_version=>version
290 subroutine maximize_system_stacksize_limit()
bind(C)
294 integer,
intent(in),
optional :: localcomm
295 character(len=*),
intent(in),
optional :: alt_input_nml_path
297 integer :: logunitnum
298 integer :: stdout_unit
300 if (module_is_initialized)
return
301 module_is_initialized = .true.
304 call maximize_system_stacksize_limit
307 if(
present(localcomm))
then
308 if(
present(alt_input_nml_path))
then
309 call mpp_init(localcomm=localcomm, alt_input_nml_path=alt_input_nml_path)
314 if(
present(alt_input_nml_path))
then
315 call mpp_init(alt_input_nml_path=alt_input_nml_path)
322 #ifdef use_deprecated_io
323 call mpp_error(note,
"fms_io_init: fms_io HAS BEEN DEPRECATED! "//&
324 "PLEASE REMOVE -Duse_deprecated_io FROM YOUR COMPILE FLAGS "// &
325 "AND MOVE TO FMS2_IO. CONTACT YOUR MODEL LIASISON IF YOU NEED "// &
333 read (input_nml_file, fms_nml, iostat=io)
345 call mpp_set_warn_level ( fatal )
347 call mpp_set_warn_level ( warning )
350 'invalid entry for namelist variable warning_level', fatal )
360 case(
'SUBCOMPONENT' )
362 case(
'MODULE_DRIVER' )
374 'invalid entry for namelist variable clock_grain', fatal )
379 clock_flag_default = 0
381 clock_flag_default = mpp_clock_sync
383 clock_flag_default = mpp_clock_detailed
386 'invalid entry for namelist variable clock_flags', fatal )
392 if (
mpp_pe() == mpp_root_pe())
then
394 write (stdout_unit, nml=fms_nml)
395 write (stdout_unit,*)
'nml_error_codes=', nml_error_codes(1:num_nml_error_codes)
416 if (.not.module_is_initialized)
return
421 module_is_initialized =.false.
441 character(len=*),
intent(in) :: routine
442 character(len=*),
intent(in) :: message
443 integer,
intent(in) :: level
451 if (.not.module_is_initialized)
call fms_init ( )
452 call mpp_error ( routine, message, level )
470 character(len=*),
intent(in) :: routine
471 character(len=*),
intent(in) :: message
472 character(len=*),
intent(out),
optional :: err_msg
475 if(
present(err_msg))
then
479 call mpp_error(trim(routine),trim(message),fatal)
523 INTEGER,
INTENT(in) :: iostat
524 CHARACTER(len=*),
INTENT(in) :: nml_name
527 CHARACTER(len=256) :: err_str
529 IF ( .NOT.module_is_initialized)
CALL fms_init()
534 IF ( iostat <= 0 .OR.&
535 & iostat == nml_errors%multipleNMLSinFile .OR.&
536 & iostat == nml_errors%NotInFile)
RETURN
539 IF ( (iostat == nml_errors%badType1 .OR. iostat == nml_errors%badType2) .OR. iostat == nml_errors%missingVar )
THEN
540 WRITE (err_str,*)
'Unknown namelist, or mistyped namelist variable in namelist ',trim(nml_name),
', &
541 & (IOSTAT = ',iostat,
')'
542 CALL error_mesg (
'check_nml_error in fms_mod', err_str, fatal)
545 WRITE (err_str,*)
'Unknown error while reading namelist ',trim(nml_name),
', (IOSTAT = ',iostat,
')'
546 CALL error_mesg (
'check_nml_error in fms_mod', err_str, fatal)
561 INTEGER,
PARAMETER :: unit_begin = 20, unit_end = 1024
562 INTEGER :: fileunit, io_stat
563 INTEGER,
DIMENSION(5) :: nml_iostats
571 namelist /a_nml/ i1, r1
572 namelist /b_nml/ i2, r2, l1
573 namelist /badtype1_nml/ i1, r1
574 namelist /badtype2_nml/ i1, r1
575 namelist /missingvar_nml/ i2, r2
576 namelist /not_in_file_nml/ i2, r2
586 IF (
mpp_pe() == mpp_root_pe() )
THEN
588 file_opened:
DO fileunit = unit_begin, unit_end
589 INQUIRE(unit=fileunit, opened=opened)
590 IF ( .NOT.opened )
EXIT file_opened
593 #if defined(__PGI) || defined(_CRAYFTN)
594 OPEN (unit=fileunit, file=
'_read_error.nml', iostat=io_stat)
596 OPEN (unit=fileunit, status=
'SCRATCH', iostat=io_stat)
600 WRITE (unit=fileunit, nml=a_nml, iostat=io_stat)
601 WRITE (unit=fileunit, nml=b_nml, iostat=io_stat)
602 WRITE (unit=fileunit, iostat=io_stat, fmt=
'(/,"&badType1_nml i1=1, r1=''bad'' /",/)')
603 WRITE (unit=fileunit, iostat=io_stat, fmt=
'(/,"&badType2_nml i1=1, r1=.true. /",/)')
604 WRITE (unit=fileunit, iostat=io_stat, fmt=
'(/,"&missingVar_nml i2=1, r2=1.0e0, l1=.true. /",/)')
607 rewind(unit=fileunit)
610 READ (unit=fileunit, nml=b_nml, iostat=nml_iostats(1))
611 rewind(unit=fileunit)
614 READ (unit=fileunit, nml=badtype1_nml, iostat=nml_iostats(2))
615 rewind(unit=fileunit)
618 READ (unit=fileunit, nml=badtype2_nml, iostat=nml_iostats(3))
619 rewind(unit=fileunit)
622 READ (unit=fileunit, nml=missingvar_nml, iostat=nml_iostats(4))
623 rewind(unit=fileunit)
626 READ (unit=fileunit, nml=not_in_file_nml, iostat=nml_iostats(5))
629 CLOSE (unit=fileunit)
632 IF ( nml_iostats(2) * nml_iostats(3) .EQ. 0 )
THEN
633 IF ( nml_iostats(2) .NE. 0 .AND. nml_iostats(3) .EQ. 0 )
THEN
634 nml_iostats(3) = nml_iostats(2)
635 ELSE IF ( nml_iostats(2) .EQ. 0 .AND. nml_iostats(3) .NE.0 )
THEN
636 nml_iostats(2) = nml_iostats(3)
638 nml_iostats(2) = nml_iostats(4)
639 nml_iostats(2) = nml_iostats(4)
646 nml_errors%multipleNMLSinFile = nml_iostats(1)
647 nml_errors%badType1 = nml_iostats(2)
648 nml_errors%badType2 = nml_iostats(3)
649 nml_errors%missingVar = nml_iostats(4)
650 nml_errors%NotInFile = nml_iostats(5)
652 do_nml_error_init = .false.
673 character(len=*),
intent(in) ::
string
674 character(len=*),
intent(in) :: string_array(:)
675 integer,
optional,
intent(out) :: index
684 if (
present(index)) index = 0
686 do i = 1,
size(string_array(:))
688 if ( trim(
string) == trim(string_array(i)) )
then
690 if (
present(index)) index = i
701 character(len=*),
intent(in) :: version
702 character(len=*),
intent(in),
optional :: tag
703 integer,
intent(in),
optional :: unit
707 if (.not.module_is_initialized)
call fms_init ( )
711 if (
present(unit))
then
715 if (
mpp_pe() /= mpp_root_pe() )
return
718 if (
present(tag))
then
719 write (logunit,
'(/,80("="),/(a))') trim(version), trim(tag)
721 write (logunit,
'(/,80("="),/(a))') trim(version)
subroutine, public fms2_io_init()
Reads the fms2_io_nml.
integer function, public check_nml_error(IOSTAT, NML_NAME)
Checks the iostat argument that is returned after reading a namelist and determines if the error code...
subroutine, public write_version_number(version, tag, unit)
Prints to the log file (or a specified unit) the version id string and tag name.
subroutine, private nml_error_init
Determines the IOSTAT error value for some common Namelist errors. Also checks if the compiler return...
character(len=8) warning_level
Sets the termination condition for the WARNING flag to interfaces error_mesg/mpp_error....
logical function, public string_array_index(string, string_array, index)
match the input character string to a string in an array/list of character strings
logical read_all_pe
Read global data on all processors extracting local part needed (TRUE) or read global data on PE0 and...
subroutine, public fms_end()
Calls the termination routines for all modules in the MPP package.
character(len=16) clock_grain
The level of clock granularity used for performance timing sections of code. Possible values in order...
logical function, public fms_error_handler(routine, message, err_msg)
Facilitates the control of fatal error conditions.
integer domains_stack_size
The size in words of the MPP_DOMAINS user stack. If domains_stack_size > 0, the following MPP_DOMAINS...
subroutine, public fms_init(localcomm, alt_input_nml_path)
Initializes the FMS module and also calls the initialization routines for all modules in the MPP pack...
logical, public print_memory_usage
If set to .TRUE., memory usage statistics will be printed at various points in the code....
character(len=16) clock_flags
Possible values are 'NONE', 'SYNC', or 'DETAILED'. SYNC will give accurate information on load balanc...
subroutine, public error_mesg(routine, message, level)
Print notes, warnings and error messages; terminates program for warning and error messages....
integer stack_size
The size in words of the MPP user stack. If stack_size > 0, the following MPP routine is called: call...
Converts a C string to a Fortran string.
Namelist read error values.
character(:) function, allocatable, public string(v, fmt)
Converts a number or a Boolean value to a string.
subroutine, public grid_end
Shutdown the grid2 module.
subroutine, public grid_init
Initialize the grid2 module.
subroutine, public memutils_init(print_flag)
Initialize the memutils module.
subroutine, public print_memuse_stats(text, unit, always)
Print memory usage stats to stdout, or a particular file.
subroutine mpp_domains_init(flags)
Initialize domain decomp package.
subroutine mpp_domains_exit()
Exit mpp_domains_mod. Serves no particular purpose, but is provided should you require to re-initiali...
subroutine mpp_domains_set_stack_size(n)
Set user stack size.
Set up a domain decomposition.
These routines retrieve the axis specifications associated with the compute domains....
These routines retrieve the axis specifications associated with the data domains. The domain is a der...
These routines retrieve the axis specifications associated with the global domains....
Fill in a global array from domain-decomposed arrays.
Performs halo updates for a given domain.
The domain2D type contains all the necessary information to define the global, compute and data domai...
integer function stdout()
This function returns the current standard fortran unit numbers for output.
subroutine mpp_init(flags, localcomm, test_level, alt_input_nml_path)
Initialize the mpp_mod module. Must be called before any usage.
integer function stderr()
This function returns the current standard fortran unit numbers for error messages.
subroutine read_input_nml(pelist_name_in, alt_input_nml_path)
Reads an existing input nml file into a character array and broadcasts it to the non-root mpi-tasks....
subroutine mpp_clock_set_grain(grain)
Set the level of granularity of timing measurements.
subroutine mpp_exit()
Finalizes process termination. To be called at the end of a run. Certain mpi implementations(openmpi)...
integer function stdlog()
This function returns the current standard fortran unit numbers for log messages. Log messages,...
integer function mpp_npes()
Returns processor count for current pelist.
subroutine mpp_set_stack_size(n)
Set the mpp_stack variable to be at least n LONG words long.
integer function mpp_pe()
Returns processor ID.
subroutine mpp_sync(pelist, do_self)
Synchronize PEs in list.
integer function mpp_clock_id(name, flags, grain)
Return an ID for a new or existing clock.
integer function stdin()
This function returns the current standard fortran unit numbers for input.
Perform parallel broadcasts.
Calculate parallel checksums.
Basic message-passing call.
converts a kind=c_char to type c_ptr