Merge for Ulm release (21.0.0)

block_control/block_control.F90

@@ -0,0 +1,90 @@
+module block_control_mod
+#include <fms_platform.h>
+
+use mpp_mod,         only: mpp_error, NOTE, FATAL
+use mpp_domains_mod, only: mpp_compute_extent
+
+ public block_control_type
+ type block_control_type
+   integer :: nx_block, ny_block
+   integer :: nblks
+   integer :: isc, iec, jsc, jec
+   integer :: npz
+   integer, dimension(:), _ALLOCATABLE :: ibs _NULL, &
+                                          ibe _NULL, &
+                                          jbs _NULL, &
+                                          jbe _NULL
+ end type block_control_type
+
+public :: define_blocks
+
+contains
+
+!----------------------------------------------------------------------
+! set up "blocks" used for OpenMP threading of column-based
+! calculations using rad_n[x/y]xblock from coupler_nml
+!---------------------------------------------------------------------
+  subroutine define_blocks (component, Block, isc, iec, jsc, jec, kpts, &
+                            nx_block, ny_block, message)
+    character(len=*),         intent(in)    :: component
+    type(block_control_type), intent(inout) :: Block
+    integer,                  intent(in)    :: isc, iec, jsc, jec, kpts
+    integer,                  intent(in)    :: nx_block, ny_block
+    logical,                  intent(inout) :: message
+!--- local variables
+    integer :: blocks
+    integer, dimension(nx_block) :: i1, i2
+    integer, dimension(ny_block) :: j1, j2
+    character(len=132) :: text
+    integer :: i, j, nblks
+
+    if (message) then
+      if ((mod(iec-isc+1,nx_block) .ne. 0) .or. (mod(jec-jsc+1,ny_block) .ne. 0)) then
+        write( text,'(a,a,2i4,a,2i4,a)' ) trim(component),'define_blocks: domain (',&
+             (iec-isc+1), (jec-jsc+1),') is not an even divisor with definition (',&
+             nx_block, ny_block,') - blocks will not be uniform'
+        call mpp_error( NOTE, trim(text) )
+      endif
+      message = .false.
+    endif
+
+!--- set up blocks
+    if (iec-isc+1 .lt. nx_block) &
+        call mpp_error(FATAL, 'block_control: number of '//trim(component)//' nxblocks .gt. &
+                             &number of elements in MPI-domain size')
+    if (jec-jsc+1 .lt. ny_block) &
+        call mpp_error(FATAL, 'block_control: number of '//trim(component)//' nyblocks .gt. &
+                             &number of elements in MPI-domain size')
+    call mpp_compute_extent(isc,iec,nx_block,i1,i2)
+    call mpp_compute_extent(jsc,jec,ny_block,j1,j2)
+
+    nblks = nx_block*ny_block
+    Block%isc = isc
+    Block%iec = iec
+    Block%jsc = jsc
+    Block%jec = jec
+    Block%npz = kpts
+    Block%nx_block = nx_block
+    Block%ny_block = ny_block
+    Block%nblks = nblks
+
+    if (.not._ALLOCATED(Block%ibs)) &
+         allocate (Block%ibs(nblks), &
+                   Block%ibe(nblks), &
+                   Block%jbs(nblks), &
+                   Block%jbe(nblks))
+
+    blocks=0
+    do j = 1, ny_block
+      do i = 1, nx_block
+        blocks = blocks + 1
+        Block%ibs(blocks) = i1(i)
+        Block%jbs(blocks) = j1(j)
+        Block%ibe(blocks) = i2(i)
+        Block%jbe(blocks) = j2(j)
+      enddo
+    enddo
+
+  end subroutine define_blocks
+
+end module block_control_mod

data_override/data_override.F90

@@ -371,27 +371,27 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan
  if(file_open) call mpp_error(FATAL, trim(grid_file)//' already opened')
 
  if(field_exist(grid_file, "x_T" ) .OR. field_exist(grid_file, "geolon_t" ) ) then
-    if (atm_on) then
+    if (atm_on .and. .not. allocated(lon_local_atm) ) then
        call mpp_get_compute_domain( atm_domain,is,ie,js,je) 
        allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je))
        call get_grid_version_1(grid_file, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, &
             min_glo_lon_atm, max_glo_lon_atm )
     endif
-    if (ocn_on) then
+    if (ocn_on .and. .not. allocated(lon_local_ocn) ) then
        call mpp_get_compute_domain( ocn_domain,is,ie,js,je) 
        allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je))
        call get_grid_version_1(grid_file, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, &
             min_glo_lon_ocn, max_glo_lon_ocn )
     endif
 
-    if (lnd_on) then
+    if (lnd_on .and. .not. allocated(lon_local_lnd) ) then
        call mpp_get_compute_domain( lnd_domain,is,ie,js,je) 
        allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je))
        call get_grid_version_1(grid_file, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, &
             min_glo_lon_lnd, max_glo_lon_lnd )
     endif
 
-    if (ice_on) then
+    if (ice_on .and. .not. allocated(lon_local_ice) ) then
        call mpp_get_compute_domain( ice_domain,is,ie,js,je) 
        allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je))
        call get_grid_version_1(grid_file, 'ice', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, &
@@ -406,28 +406,28 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan
        if(count .NE. 1) call mpp_error(FATAL, 'data_override_mod: the grid file is a solo mosaic, ' // &
             'one and only one of atm_on, lnd_on or ice_on/ocn_on should be true')
     endif
-   if (atm_on) then
+   if (atm_on .and. .not. allocated(lon_local_atm) ) then
        call mpp_get_compute_domain(atm_domain,is,ie,js,je) 
        allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je))
        call get_grid_version_2(grid_file, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, &
             min_glo_lon_atm, max_glo_lon_atm )
     endif
 
-    if (ocn_on) then
+    if (ocn_on .and. .not. allocated(lon_local_ocn) ) then
        call mpp_get_compute_domain( ocn_domain,is,ie,js,je) 
        allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je))
        call get_grid_version_2(grid_file, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, &
             min_glo_lon_ocn, max_glo_lon_ocn )
     endif
 
-    if (lnd_on) then
+    if (lnd_on .and. .not. allocated(lon_local_lnd) ) then
        call mpp_get_compute_domain( lnd_domain,is,ie,js,je) 
        allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je))
        call get_grid_version_2(grid_file, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, &
             min_glo_lon_lnd, max_glo_lon_lnd )
     endif
 
-    if (ice_on) then
+    if (ice_on .and. .not. allocated(lon_local_ice) ) then
        call mpp_get_compute_domain( ice_domain,is,ie,js,je) 
        allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je))
        call get_grid_version_2(grid_file, 'ocn', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, &
@@ -1387,6 +1387,7 @@ program test
 
  call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, name='test_data_override')
  call data_override_init(Ice_domain_in=Domain, Ocean_domain_in=Domain)
+ call data_override_init(Ice_domain_in=Domain, Ocean_domain_in=Domain)
  call mpp_get_compute_domain(Domain, is, ie, js, je)
  call get_grid
 

diag_manager/diag_data.F90

@@ -46,7 +46,6 @@ MODULE diag_data_mod
 
   PUBLIC
 
-
   ! <!-- PARAMETERS for diag_data.F90 -->
   ! <DATA NAME="MAX_FIELDS_PER_FILE" TYPE="INTEGER, PARAMETER" DEFAULT="300">
   !   Maximum number of fields per file.
@@ -72,6 +71,9 @@ MODULE diag_data_mod
   ! <DATA NAME="GLO_REG_VAL_ALT" TYPE="INTEGER, PARAMETER" DEFAULT="-1">
   !   Alternate value used in the region specification of the diag_table to indicate to use the full axis instead of a sub-axis
   ! </DATA>
+  ! <DATA NAME="DIAG_FIELD_NOT_FOUND" TYPE="INTEGER, PARAMETER" DEFAULT="-1">
+  !   Return value for a diag_field that isn't found in the diag_table
+  ! </DATA>
   ! Specify storage limits for fixed size tables used for pointers, etc.
   INTEGER, PARAMETER :: MAX_FIELDS_PER_FILE = 300 !< Maximum number of fields per file.
   INTEGER, PARAMETER :: DIAG_OTHER = 0
@@ -87,6 +89,7 @@ MODULE diag_data_mod
   INTEGER, PARAMETER :: GLO_REG_VAL = -999
   INTEGER, PARAMETER :: GLO_REG_VAL_ALT = -1
   REAL, PARAMETER :: CMOR_MISSING_VALUE = 1.0e20 !< CMOR standard missing value
+  INTEGER, PARAMETER :: DIAG_FIELD_NOT_FOUND = -1
 
   ! <TYPE NAME="diag_grid">
   !   <DESCRIPTION>
@@ -488,13 +491,13 @@ MODULE diag_data_mod
      INTEGER  :: pack
      INTEGER :: pow_value !< Power value to use for mean_pow(n) calculations
      CHARACTER(len=50) :: time_method ! time method field from the input file
-     ! coordianes of the buffer and counter are (x, y, z, time-of-day)
+     ! coordinates of the buffer and counter are (x, y, z, time-of-day)
      REAL, _ALLOCATABLE, DIMENSION(:,:,:,:) :: buffer _NULL
      REAL, _ALLOCATABLE, DIMENSION(:,:,:,:) :: counter _NULL
      ! the following two counters are used in time-averaging for some
      ! combination of the field options. Their size is the length of the
      ! diurnal axis; the counters must be tracked separately for each of
-     ! the diurnal interval, becaus the number of time slices accumulated
+     ! the diurnal interval, because the number of time slices accumulated
      ! in each can be different, depending on time step and the number of
      ! diurnal samples.
      REAL, _ALLOCATABLE, DIMENSION(:)  :: count_0d
@@ -646,8 +649,10 @@ MODULE diag_data_mod
   ! <DATA NAME="max_file_attributes" TYPE="INTEGER" DEFAULT="2">
   !   Maximum number of user definable global attributes per file.
   ! </DATA>
-  ! <DATA NAME="prepend_date" TYPE="LOGICAL" DEFAULT=".FALSE.">
-  !   Indicates if the file start date will be prepended to the file name.  This was usually done by FRE after the model run.
+  ! <DATA NAME="prepend_date" TYPE="LOGICAL" DEFAULT=".TRUE.">
+  !   Indicates if the file start date will be prepended to the file name.  <TT>.TRUE.</TT> is
+  !   only supported if the diag_manager_init routine is called with the optional time_init parameter.
+  !   This was usually done by FRE after the model run.
   ! </DATA>
   ! <DATA NAME="region_out_use_alt_value" TYPE="LOGICAL" DEFAULT=".TRUE.">
   !   Will determine which value to use when checking a regional output if the region is the full axis or a sub-axis.
@@ -672,7 +677,7 @@ MODULE diag_data_mod
 
   INTEGER :: max_field_attributes = 2
   INTEGER :: max_file_attributes = 2
-  LOGICAL :: prepend_date = .FALSE.
+  LOGICAL :: prepend_date = .TRUE.
   ! <!-- netCDF variable -->
   ! <DATA NAME="FILL_VALUE" TYPE="REAL" DEFAULT="NF90_FILL_REAL">
   !   Fill value used.  Value will be <TT>NF90_FILL_REAL</TT> if using the
@@ -694,6 +699,10 @@ MODULE diag_data_mod
   REAL :: MAX_VALUE, MIN_VALUE
 
   ! <!-- Global data for all files -->
+  ! <DATA NAME="diag_init_time" TYPE="TYPE(time_type)">
+  !   Time diag_manager_init called.  If init_time not included in
+  !   diag_manager_init call, then same as base_time
+  ! </DATA>
   ! <DATA NAME="base_time" TYPE="TYPE(time_type)" />
   ! <DATA NAME="base_year" TYPE="INTEGER" />
   ! <DATA NAME="base_month" TYPE="INTEGER" />
@@ -702,6 +711,7 @@ MODULE diag_data_mod
   ! <DATA NAME="base_minute" TYPE="INTEGER" />
   ! <DATA NAME="base_second" TYPE="INTEGER" />
   ! <DATA NAME="global_descriptor" TYPE="CHARACTER(len=256)" />
+  TYPE(time_type) :: diag_init_time
   TYPE(time_type) :: base_time
   INTEGER :: base_year, base_month, base_day, base_hour, base_minute, base_second
   CHARACTER(len = 256):: global_descriptor

diag_manager/diag_data.html

@@ -162,6 +162,11 @@ <h4>PUBLIC DATA</h4>
    </td>
 </tr>
 <tr>
+<td> DIAG_FIELD_NOT_FOUND  </td><td> INTEGER, PARAMETER  </td><td> -1  </td><td> ---  </td><td> 
+   Return value for a diag_field that isn't found in the diag_table
+   </td>
+</tr>
+<tr>
 <td> num_files  </td><td> INTEGER  </td><td> 0  </td><td> ---  </td><td> 
    Number of output files currenly in use by the diag_manager.
    </td>

diag_manager/diag_grid.F90

@@ -547,7 +547,7 @@ SUBROUTINE get_local_indexes(latStart, latEnd, lonStart, lonEnd,&
                 dists_lat(1) = ABS(diag_global_grid%glo_lat(i+1,j) - diag_global_grid%glo_lat(i,j))
                 count = count+1
              END IF
-             IF ( j < dimI ) THEN
+             IF ( j < dimJ ) THEN
                 dists_lon(2) = ABS(diag_global_grid%glo_lon(i,j+1) - diag_global_grid%glo_lon(i,j))
                 dists_lat(2) = ABS(diag_global_grid%glo_lat(i,j+1) - diag_global_grid%glo_lat(i,j))
                 count = count+1