Merge branch 'dmUpdate' of github.com:NOAA-GFDL/FMS into dm_openmp

axis_utils/include/axis_utils2.inc

@@ -213,7 +213,7 @@
        endif
 
        lon_strt = lon(1)
-       do i=2,len+1
+       do i=2,len
           lon(i)   = lon_in_range(lon(i),lon_strt)
           lon_strt = lon(i)
        enddo

fms/Makefile.am

@@ -32,6 +32,7 @@ noinst_LTLIBRARIES = libfms.la
 # Each convenience library depends on its source.
 libfms_la_SOURCES = \
   fms.F90 \
+  fms_stacksize.c \
   include/fms.inc \
   include/fms_r4.fh \
   include/fms_r8.fh \

fms/fms.F90

@@ -336,6 +336,11 @@ subroutine fms_init (localcomm, alt_input_nml_path)
  use fms_io_mod,    only: fms_io_version
 #endif
 
+ interface
+    subroutine maximize_system_stacksize_limit() bind(C)
+    end subroutine
+ end interface
+
  integer, intent(in), optional :: localcomm
  character(len=*), intent(in), optional :: alt_input_nml_path
  integer :: ierr, io
@@ -344,6 +349,10 @@ subroutine fms_init (localcomm, alt_input_nml_path)
 
     if (module_is_initialized) return    ! return silently if already called
     module_is_initialized = .true.
+
+!---- Raise the system stack size limit to its maximum permissible value ----
+    call maximize_system_stacksize_limit
+
 !---- initialize mpp routines ----
     if(present(localcomm)) then
        if(present(alt_input_nml_path)) then

fms/fms_stacksize.c

@@ -0,0 +1,33 @@
+/***********************************************************************
+ *                   GNU Lesser General Public License
+ *
+ * This file is part of the GFDL Flexible Modeling System (FMS).
+ *
+ * FMS is free software: you can redistribute it and/or modify it under
+ * the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * FMS is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
+ **********************************************************************/
+
+#include <sys/resource.h>
+
+/*
+ * Set the stack size limit to its maximum permissible value
+ */
+
+void maximize_system_stacksize_limit()
+{
+  struct rlimit stacksize;
+
+  getrlimit(RLIMIT_STACK, &stacksize);
+  stacksize.rlim_cur = stacksize.rlim_max;
+  setrlimit(RLIMIT_STACK, &stacksize);
+}

monin_obukhov/monin_obukhov.F90

@@ -274,16 +274,18 @@ subroutine stable_mix_3d(rich, mix)
 
 real, intent(in) , dimension(:,:,:)  :: rich
 real, intent(out), dimension(:,:,:)  :: mix
+integer :: n2 !< Size of dimension 2 of mix and rich
+integer :: n3 !< Size of dimension 3 of mix and rich
+integer :: i, j !< Loop indices
 
-integer :: n, ier
-
-if(.not.module_is_initialized) call error_mesg('stable_mix_3d in monin_obukhov_mod', &
-     'monin_obukhov_init has not been called', FATAL)
-
-n = size(rich,1)*size(rich,2)*size(rich,3)
-call monin_obukhov_stable_mix(stable_option, rich_crit, zeta_trans, &
-     & n, rich, mix, ier)
+n2 = size(mix, 2)
+n3 = size(mix, 3)
 
+do j=1, n3
+  do i=1, n2
+    call stable_mix(rich(:, i, j), mix(:, i, j))
+  enddo
+enddo
 
 end subroutine stable_mix_3d
 
@@ -943,16 +945,15 @@ subroutine stable_mix_2d(rich, mix)
 
 real, intent(in) , dimension(:,:)  :: rich
 real, intent(out), dimension(:,:)  :: mix
+integer :: n2 !< Size of dimension 2 of mix and rich
+integer :: i !< Loop index
 
-real, dimension(size(rich,1),size(rich,2),1) :: rich_3d, mix_3d
-
-rich_3d(:,:,1) = rich
+n2 = size(mix, 2)
 
-call stable_mix_3d(rich_3d, mix_3d)
-
-mix = mix_3d(:,:,1)
+do i=1, n2
+  call stable_mix(rich(:, i), mix(:, i))
+enddo
 
-return
 end subroutine stable_mix_2d
 
 
@@ -962,16 +963,17 @@ subroutine stable_mix_1d(rich, mix)
 
 real, intent(in) , dimension(:)  :: rich
 real, intent(out), dimension(:)  :: mix
+integer :: n !< Size of mix and rich
+integer :: ierr !< Error code set by monin_obukhov_stable_mix
 
-real, dimension(size(rich),1,1) :: rich_3d, mix_3d
-
-rich_3d(:,1,1) = rich
+if (.not.module_is_initialized) call error_mesg('stable_mix in monin_obukhov_mod', &
+     'monin_obukhov_init has not been called', FATAL)
 
-call stable_mix_3d(rich_3d, mix_3d)
+n = size(mix)
 
-mix = mix_3d(:,1,1)
+call monin_obukhov_stable_mix(stable_option, rich_crit, zeta_trans, &
+     & n, rich, mix, ierr)
 
-return
 end subroutine stable_mix_1d
 
 !=======================================================================
@@ -981,15 +983,12 @@ subroutine stable_mix_0d(rich, mix)
 real, intent(in) :: rich
 real, intent(out) :: mix
 
-real, dimension(1,1,1) :: rich_3d, mix_3d
-
-rich_3d(1,1,1) = rich
+real, dimension(1) :: mix_1d !< Representation of mix as a dimension(1) array
 
-call stable_mix_3d(rich_3d, mix_3d)
+call stable_mix([rich], mix_1d)
 
-mix = mix_3d(1,1,1)
+mix = mix_1d(1)
 
-return
 end subroutine stable_mix_0d
 !=======================================================================
 

mpp/include/mpp_do_global_field_ad.fh

@@ -22,8 +22,8 @@
 !> @addtogroup mpp_domains_mod
 !> @{
 
-    !> Gets a global field from a local field
-    !! local field may be on compute OR data domain
+    !> Gets a local ad field from a global field
+    !! global field may be on compute OR data domain
     subroutine MPP_DO_GLOBAL_FIELD_3D_AD_( domain, local, global, tile, ishift, jshift, flags, default_data)
       type(domain2D), intent(in)    :: domain
       MPP_TYPE_, intent(inout)         ::  local(:,:,:)

mpp/include/mpp_do_updateV_ad.fh

@@ -21,7 +21,7 @@
 !***********************************************************************
 !> @addtogroup mpp_domains_mod
 !> @{
-    !> Updates data domain of 3D field whose computational domains have been computed
+    !> Updates data domain of 3D ad field whose computational domains have been computed
     subroutine MPP_DO_UPDATE_AD_3D_V_(f_addrsx,f_addrsy, domain, update_x, update_y, &
                                    d_type, ke, gridtype, flags)
       integer(i8_kind),  intent(in)        :: f_addrsx(:,:), f_addrsy(:,:)