Merge pull request mom-ocean#34 from Hallberg-NOAA/coupler_type_refor…

…m_rwh

Coupler type reform rwh

coupler/ensemble_manager.F90

@@ -72,6 +72,9 @@ subroutine ensemble_manager_init()
 
     pe = mpp_pe()
     npes = mpp_npes()
+    if (npes < ensemble_size) then
+      call mpp_error(FATAL,'npes must be >= ensemble_size')
+    endif
     total_npes_pm = npes/ensemble_size
     if (mod(npes, total_npes_pm) /= 0) call mpp_error(FATAL,'ensemble_size must be divis by npes')
 

diag_manager/diag_data.F90

@@ -638,7 +638,7 @@ MODULE diag_data_mod
   ! <DATA NAME="max_output_fields" TYPE="INTEGER" DEFAULT="300">
   !   Maximum number of output fields.  Increase via the diag_manager_nml namelist.
   ! </DATA>
-  ! <DATA NAME="max_input_fields" TYPE="INTEGER" DEFAULT="300">
+  ! <DATA NAME="max_input_fields" TYPE="INTEGER" DEFAULT="600">
   !   Maximum number of input fields.  Increase via the diag_manager_nml namelist.
   ! </DATA>
   ! <DATA NAME="max_out_per_in_field" TYPE="INTEGER" DEFAULT="150">
@@ -668,7 +668,7 @@ MODULE diag_data_mod
   !   Cause a fatal error if the output field has a value outside the
   !   given range for a variable.
   ! </DATA>
-  ! <DATA NAME="max_field_attributes" TYPE="INTEGER" DEFAULT="2">
+  ! <DATA NAME="max_field_attributes" TYPE="INTEGER" DEFAULT="4">
   !   Maximum number of user definable attributes per field.
   ! </DATA>
   ! <DATA NAME="max_file_attributes" TYPE="INTEGER" DEFAULT="2">
@@ -690,7 +690,7 @@ MODULE diag_data_mod
   LOGICAL :: mix_snapshot_average_fields =.FALSE.
   INTEGER :: max_files = 31 !< Maximum number of output files allowed.  Increase via diag_manager_nml.
   INTEGER :: max_output_fields = 300 !< Maximum number of output fields.  Increase via diag_manager_nml.
-  INTEGER :: max_input_fields = 300 !< Maximum number of input fields.  Increase via diag_manager_nml.
+  INTEGER :: max_input_fields = 600 !< Maximum number of input fields.  Increase via diag_manager_nml.
   INTEGER :: max_out_per_in_field = 150 !< Maximum number of output_fields per input_field.  Increase via diag_manager_nml.
   INTEGER :: max_axes = 60 !< Maximum number of independent axes.
   LOGICAL :: do_diag_field_log = .FALSE.
@@ -708,7 +708,7 @@ MODULE diag_data_mod
   LOGICAL :: oor_warnings_fatal = .FALSE.
   LOGICAL :: region_out_use_alt_value = .TRUE.
 
-  INTEGER :: max_field_attributes = 2 !< Maximum number of user definable attributes per field.
+  INTEGER :: max_field_attributes = 4 !< Maximum number of user definable attributes per field. Liptak: Changed from 2 to 4 20170718
   INTEGER :: max_file_attributes = 2 !< Maximum number of user definable global attributes per file.
   INTEGER :: max_axis_attributes = 4 !< Maximum number of user definable attributes per axis.
   LOGICAL :: prepend_date = .TRUE. !< Should the history file have the start date prepended to the file name

diag_manager/diag_manager.F90

@@ -162,7 +162,7 @@ MODULE diag_manager_mod
   !     If <TT>.TRUE.</TT> then <TT>diag_manager_mod</TT> will issue a <TT>FATAL</TT> error if any values for the output field are
   !     outside the given range.
   !   </DATA>
-  !   <DATA NAME="max_field_attributes" TYPE="INTEGER" DEFAULT="2">
+  !   <DATA NAME="max_field_attributes" TYPE="INTEGER" DEFAULT="4">   
   !     Maximum number of user definable attributes per field.
   !   </DATA>
   !   <DATA NAME="max_file_attributes" TYPE="INTEGER" DEFAULT="2">

diag_manager/diag_output.F90

@@ -131,7 +131,7 @@ SUBROUTINE diag_output_init(file_name, FORMAT, file_title, file_unit,&
     IF ( domain .NE. NULL_DOMAIN2D ) THEN
        CALL mpp_open(file_unit, file_name, action=MPP_OVERWR, form=form,&
             & threading=threading, fileset=fileset, domain=domain)
-    ELSEif (domainU .NE. NULL_DOMAINUG) THEN
+    ELSE IF (domainU .NE. NULL_DOMAINUG) THEN
        CALL mpp_open(file_unit, file_name, action=MPP_OVERWR, form=form,&
             & threading=threading, fileset=fileset, domain_UG=domainU)
     ELSE

diag_manager/diag_table.F90

@@ -457,8 +457,8 @@ SUBROUTINE parse_diag_table(diag_subset, istat, err_msg)
                         & CALL error_mesg("diag_table_mod::parse_diag_table",&
                         & TRIM(local_err_msg)//" (line: "//TRIM(line_number)//").", WARNING)
                    CYCLE parser
-                ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. VERIFY('ocean', lowercase(temp_file%file_name)) == 0).OR.&
-                     &    (diag_subset_output == DIAG_OCEAN .AND. VERIFY('ocean', lowercase(temp_file%file_name)) /= 0) ) THEN
+                ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. INDEX(lowercase(temp_file%file_name), "ocean") .NE. 0).OR.&
+                     &    (diag_subset_output == DIAG_OCEAN .AND. INDEX(lowercase(temp_file%file_name), "ocean") .EQ. 0) ) THEN
                    CYCLE parser
                 ELSE IF ( temp_file%new_file_freq > 0 ) THEN ! Call the init_file subroutine.  The '1' is for the tile_count
                    CALL init_file(temp_file%file_name, temp_file%output_freq, temp_file%iOutput_freq_units, temp_file%file_format,&
@@ -485,8 +485,8 @@ SUBROUTINE parse_diag_table(diag_subset, istat, err_msg)
                         & CALL error_mesg("diag_table_mod::Parse_diag_table",&
                         & TRIM(local_err_msg)//" (line: "//TRIM(line_number)//").",WARNING)
                    CYCLE parser
-                ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. VERIFY('ocean', lowercase(temp_field%file_name)) == 0).OR.&
-                     &    (diag_subset_output == DIAG_OCEAN .AND. VERIFY('ocean', lowercase(temp_field%file_name)) /= 0) ) THEN
+                ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. INDEX(lowercase(temp_field%file_name), "ocean") .NE. 0).OR.&
+                     &    (diag_subset_output == DIAG_OCEAN .AND. INDEX(lowercase(temp_field%file_name), "ocean") .EQ. 0) ) THEN
                    CYCLE parser
                 ELSE IF ( lowercase(TRIM(temp_field%spatial_ops)) == 'none' ) THEN
                    CALL init_input_field(temp_field%module_name, temp_field%field_name, 1)

mpp/include/mpp_util_mpi.inc

@@ -73,14 +73,13 @@ function get_peset(pelist)
   if( .NOT.PRESENT(pelist) )then !set it to current_peset_num
      get_peset = current_peset_num; return
   end if
-  if( size(pelist(:)).EQ.1 .AND. npes.GT.1 )then    !collective ops on single PEs should return
-     get_peset = 0; return
-  end if
 
   !--- first make sure pelist is monotonically increasing.
-  do n = 2, size(pelist(:))
-     if(pelist(n) <= pelist(n-1)) call mpp_error(FATAL, "GET_PESET: pelist is not monotonically increasing")
-  enddo
+  if (size(pelist(:)) .GT. 1) then
+    do n = 2, size(pelist(:))
+       if(pelist(n) <= pelist(n-1)) call mpp_error(FATAL, "GET_PESET: pelist is not monotonically increasing")
+    enddo
+  endif
 
   allocate( sorted(size(pelist(:))) )
   sorted = pelist 

time_interp/time_interp.F90

@@ -32,7 +32,8 @@ module time_interp_mod
                             operator(+), operator(-), operator(>),   &
                             operator(<), operator( // ), operator( / ),  &
                             operator(>=), operator(<=), operator( * ), &
-                            operator(==), print_date, print_time
+                            operator(==), print_date, print_time,&
+                            time_list_error, date_to_string
 
 use          fms_mod, only: write_version_number, &
                             error_mesg, FATAL, stdout, stdlog, &
@@ -662,6 +663,7 @@ subroutine time_interp_list ( Time, Timelist, weight, index1, index2, modtime, e
 
 integer :: n, hr, mn, se, mtime
 type(time_type) :: T, Ts, Te, Td, Period, Time_mod
+character(len=:),allocatable :: terr, tserr, teerr
 
   if ( .not. module_is_initialized ) call time_interp_init
 
@@ -727,7 +729,14 @@ subroutine time_interp_list ( Time, Timelist, weight, index1, index2, modtime, e
 ! time falls before starting list value
   else if ( T < Ts ) then
      if (mtime == NONE) then
-        if(fms_error_handler ('time_interp_list','time before range of list',err_msg)) return
+        call time_list_error(T,terr)
+        call time_list_error(Ts,tserr)
+        call time_list_error(Te,teerr)
+        if(fms_error_handler ('time_interp_list',&
+           'time '//trim(terr)//' ('//date_to_string(T)//' is before range of list '//trim(tserr)//'-'//trim(teerr)//&
+           '('//date_to_string(Ts)//' - '//date_to_string(Te)//')',&
+           err_msg)) return
+        deallocate(terr,tserr,teerr)
      endif
      Td = Te-Ts
      weight = 1. - ((Ts-T) // (Period-Td))
@@ -753,7 +762,14 @@ subroutine time_interp_list ( Time, Timelist, weight, index1, index2, modtime, e
 ! time falls after ending list value
   else if ( T > Te ) then
      if (mtime == NONE) then
-        if(fms_error_handler ('time_interp_list','time after range of list',err_msg)) return
+        call time_list_error(T,terr)
+        call time_list_error(Ts,tserr)
+        call time_list_error(Te,teerr)
+        if(fms_error_handler ('time_interp_list',&
+           'time '//trim(terr)//' ('//date_to_string(T)//' is after range of list '//trim(tserr)//'-'//trim(teerr)//&
+           '('//date_to_string(Ts)//' - '//date_to_string(Te)//')',&
+           err_msg)) return
+        deallocate(terr,tserr,teerr)
      endif
      Td = Te-Ts
      weight = (T-Te) // (Period-Td)

time_manager/time_manager.F90

@@ -90,6 +90,7 @@ module time_manager_mod
 ! Subroutines and functions operating on time_type
 public set_time, increment_time, decrement_time, get_time, interval_alarm
 public repeat_alarm, time_type_to_real, real_to_time_type
+public time_list_error
 
 ! List of available calendar types
 public    THIRTY_DAY_MONTHS,    JULIAN,    GREGORIAN,  NOLEAP,   NO_CALENDAR, INVALID_CALENDAR
@@ -3265,6 +3266,19 @@ function date_to_string(time, err_msg)
 
 end function date_to_string
 
+!> \author Tom Robinson
+!! \email thomas.robinson@noaa.gov
+!! \brief This routine converts the integer t%days to a string
+subroutine time_list_error (T,Terr)
+  type(time_type),  intent(in)            :: t     !< time_type input
+  character(len=:),   allocatable         :: terr  !< String holding the t%days
+!> Allocate the string
+  allocate (character(len=10) :: terr)
+!> Write the integer to the string
+  write (terr,'(I0)') t%days
+end subroutine time_list_error
+
+
 end module time_manager_mod
 
 ! <INFO>