Merge remote-tracking branch 'ESCOMP/development' into history-bugfix…

…-real32

src/control/cam_comp.F90

@@ -603,9 +603,9 @@ subroutine cam_register_constituents(cam_runtime_opts)
       if (.not. is_constituent) then
 
          ! Allocate host_constituents object:
-         allocate(host_constituents(1), stat=errflg)
+         allocate(host_constituents(1), stat=errflg, errmsg=errmsg)
          call check_allocate(errflg, subname, 'host_constituents(1)',                   &
-                             file=__FILE__, line=__LINE__)
+                             file=__FILE__, line=__LINE__, errmsg=errmsg)
 
          ! Register the constituents so they can be advected:
          call host_constituents(1)%instantiate( &
@@ -623,9 +623,9 @@ subroutine cam_register_constituents(cam_runtime_opts)
       else
          ! Allocate zero-size object so nothing is added
          ! to main constituents object:
-         allocate(host_constituents(0), stat=errflg)
+         allocate(host_constituents(0), stat=errflg, errmsg=errmsg)
          call check_allocate(errflg, subname, 'host_constituents(0)',                   &
-                             file=__FILE__, line=__LINE__)
+                             file=__FILE__, line=__LINE__, errmsg=errmsg)
       end if
       !-------------------------------------------
 

src/data/air_composition.F90

@@ -128,6 +128,7 @@ module air_composition
    !===========================================================================
 
    subroutine air_composition_init()
+      use shr_kind_mod,         only: shr_kind_cl
       use string_utils,         only: to_str
       use spmd_utils,           only: masterproc
       use cam_logfile,          only: iulog
@@ -150,6 +151,7 @@ subroutine air_composition_init()
       character(len=std_name_len) :: cnst_stdname
 
       character(len=*), parameter :: subname = 'air_composition_init'
+      character(len=shr_kind_cl)  :: errmsg
 
       !
       ! define cp and R for species in species_name
@@ -173,6 +175,8 @@ subroutine air_composition_init()
       real(kind_phys), parameter :: cv3 = 0.5_kind_phys * r_universal * dof3
       real(kind_phys), parameter :: cp3 = 0.5_kind_phys * r_universal * (2._kind_phys + dof3)
 
+      errmsg = ''
+
       liq_num = 0
       ice_num = 0
       has_liq = .false.
@@ -187,33 +191,33 @@ subroutine air_composition_init()
 
       ! init for variable composition dry air
 
-      allocate(thermodynamic_active_species_idx(0:num_advected), stat=ierr)
+      allocate(thermodynamic_active_species_idx(0:num_advected), stat=ierr, errmsg=errmsg)
       call check_allocate(ierr, subname,'thermodynamic_active_species_idx(num_advected)', &
-                          file=__FILE__, line=__LINE__)
-      allocate(thermodynamic_active_species_idx_dycore(num_advected), stat=ierr)
+                          file=__FILE__, line=__LINE__, errmsg=errmsg)
+      allocate(thermodynamic_active_species_idx_dycore(num_advected), stat=ierr, errmsg=errmsg)
       call check_allocate(ierr, subname,'thermodynamic_active_species_idx_dycore(num_advected)', &
-                          file=__FILE__, line=__LINE__)
-      allocate(thermodynamic_active_species_cp(0:num_advected), stat=ierr)
+                          file=__FILE__, line=__LINE__, errmsg=errmsg)
+      allocate(thermodynamic_active_species_cp(0:num_advected), stat=ierr, errmsg=errmsg)
       call check_allocate(ierr, subname,'thermodynamic_active_species_cp(0:num_advected)', &
-                          file=__FILE__, line=__LINE__)
-      allocate(thermodynamic_active_species_cv(0:num_advected), stat=ierr)
+                          file=__FILE__, line=__LINE__, errmsg=errmsg)
+      allocate(thermodynamic_active_species_cv(0:num_advected), stat=ierr, errmsg=errmsg)
       call check_allocate(ierr, subname,'thermodynamic_active_species_cv(0:num_advected)', &
-                          file=__FILE__, line=__LINE__)
-      allocate(thermodynamic_active_species_R(0:num_advected), stat=ierr)
+                          file=__FILE__, line=__LINE__, errmsg=errmsg)
+      allocate(thermodynamic_active_species_R(0:num_advected), stat=ierr, errmsg=errmsg)
       call check_allocate(ierr, subname,'thermodynamic_active_species_R(0:num_advected)', &
-                          file=__FILE__, line=__LINE__)
+                          file=__FILE__, line=__LINE__, errmsg=errmsg)
 
-      allocate(thermodynamic_active_species_mwi(0:num_advected), stat=ierr)
+      allocate(thermodynamic_active_species_mwi(0:num_advected), stat=ierr, errmsg=errmsg)
       call check_allocate(ierr, subname,'thermodynamic_active_species_mwi(0:num_advected)', &
-                          file=__FILE__, line=__LINE__)
-      allocate(thermodynamic_active_species_kv(0:num_advected), stat=ierr)
+                          file=__FILE__, line=__LINE__, errmsg=errmsg)
+      allocate(thermodynamic_active_species_kv(0:num_advected), stat=ierr, errmsg=errmsg)
       call check_allocate(ierr, subname,'thermodynamic_active_species_kv(0:num_advected)', &
-                          file=__FILE__, line=__LINE__)
-      allocate(thermodynamic_active_species_kc(0:num_advected), stat=ierr)
+                          file=__FILE__, line=__LINE__, errmsg=errmsg)
+      allocate(thermodynamic_active_species_kc(0:num_advected), stat=ierr, errmsg=errmsg)
       call check_allocate(ierr, subname,'thermodynamic_active_species_kc(0:num_advected)', &
-                          file=__FILE__, line=__LINE__)
-      allocate(const_is_water_species(num_advected), stat=ierr)
-      call check_allocate(ierr, subname, 'const_is_water_species', file=__FILE__, line=__LINE__)
+                          file=__FILE__, line=__LINE__, errmsg=errmsg)
+      allocate(const_is_water_species(num_advected), stat=ierr, errmsg=errmsg)
+      call check_allocate(ierr, subname, 'const_is_water_species', file=__FILE__, line=__LINE__, errmsg=errmsg)
 
       thermodynamic_active_species_idx        = -HUGE(1)
       thermodynamic_active_species_idx_dycore = -HUGE(1)

src/data/cam_thermo.F90

@@ -182,6 +182,7 @@ module cam_thermo
 
    subroutine cam_thermo_init(pcols, pver, pverp)
       use shr_infnan_mod,  only: assignment(=), shr_infnan_qnan
+      use shr_kind_mod,    only: shr_kind_cl
       use physconst,       only: cpair, rair, mwdry
 
       integer, intent(in) :: pcols
@@ -190,16 +191,19 @@ subroutine cam_thermo_init(pcols, pver, pverp)
 
       integer                     :: ierr
       character(len=*), parameter :: subname = "cam_thermo_init"
+      character(len=shr_kind_cl)  :: errmsg
+
+      errmsg = ''
 
       !------------------------------------------------------------------------
       !  Allocate constituent dependent properties
       !------------------------------------------------------------------------
-      allocate(kmvis(pcols,pverp), stat=ierr)
+      allocate(kmvis(pcols,pverp), stat=ierr, errmsg=errmsg)
       call check_allocate(ierr, subname, 'kmvis(pcols,pverp)', &
-                                file=__FILE__, line=__LINE__)
-      allocate(kmcnd(pcols,pverp), stat=ierr)
+                                file=__FILE__, line=__LINE__, errmsg=errmsg)
+      allocate(kmcnd(pcols,pverp), stat=ierr, errmsg=errmsg)
       call check_allocate(ierr, subname, 'kmcnd(pcols,pverp)', &
-                                file=__FILE__, line=__LINE__)
+                                file=__FILE__, line=__LINE__, errmsg=errmsg)
 
       !------------------------------------------------------------------------
       !  Initialize constituent dependent properties

src/history/cam_hist_file.F90

@@ -1015,6 +1015,7 @@ subroutine config_define_file(this, restart, logname, host, model_doi_url)
          end do
       end do
       ! Determine the maximum number of dimensions
+      max_mdims = 0
       do field_index = 1, size(this%field_list)
          max_mdims = max(max_mdims, size(this%field_list(field_index)%dimensions()))
       end do

src/physics/utils/tropopause_climo_read.F90

@@ -85,7 +85,7 @@ subroutine tropopause_climo_read_file()
     !------------------------------------------------------------------
     use shr_kind_mod,         only: shr_kind_cm
     use cam_logfile,          only: iulog
-    use cam_abortutils,       only: endrun
+    use cam_abortutils,       only: endrun, check_allocate
     use spmd_utils,           only: masterproc
     use interpolate_data,     only: lininterp_init, lininterp, interp_type, lininterp_finish
     use physics_grid,         only: get_rlat_all_p, get_rlon_all_p
@@ -121,7 +121,8 @@ subroutine tropopause_climo_read_file()
     real(kind_phys) :: to_lats(pcols), to_lons(pcols)
     real(kind_phys), parameter :: d2r=pi/180._kind_phys, zero=0._kind_phys, twopi=pi*2._kind_phys
     character(len=shr_kind_cl) :: locfn
-    character(len=shr_kind_cm) :: errmsg
+    character(len=shr_kind_cl) :: errmsg
+    character(len=*), parameter :: subname = "tropopause_climo_read_file"
 
     errmsg = ''
 
@@ -146,10 +147,9 @@ subroutine tropopause_climo_read_file()
     ierr = pio_inq_dimid( pio_id, 'lat', dimid )
     ierr = pio_inq_dimlen( pio_id, dimid, nlat )
     allocate( lat(nlat), stat=ierr, errmsg=errmsg )
-    if( ierr /= 0 ) then
-       write(iulog,*) 'tropopause_climo_read_file: lat allocation error = ',ierr
-       call endrun('tropopause_climo_read_file: failed to allocate lat, error = ' // errmsg)
-    end if
+    call check_allocate(ierr, subname, 'lat(nlat)', &
+                        file=__FILE__, line=__LINE__, errmsg=errmsg)
+
     ierr = pio_inq_varid( pio_id, 'lat', vid )
     ierr = pio_get_var( pio_id, vid, lat )
     lat(:nlat) = lat(:nlat) * d2r
@@ -159,10 +159,9 @@ subroutine tropopause_climo_read_file()
     ierr = pio_inq_dimid( pio_id, 'lon', dimid )
     ierr = pio_inq_dimlen( pio_id, dimid, nlon )
     allocate( lon(nlon), stat=ierr, errmsg=errmsg )
-    if( ierr /= 0 ) then
-       write(iulog,*) 'tropopause_climo_read_file: lon allocation error = ',ierr
-       call endrun('tropopause_climo_read_file: failed to allocate lon, error = ' // errmsg)
-    end if
+    call check_allocate(ierr, subname, 'lon(nlon)', &
+                        file=__FILE__, line=__LINE__, errmsg=errmsg)
+
     ierr = pio_inq_varid( pio_id, 'lon', vid )
     ierr = pio_get_var( pio_id, vid, lon )
     lon(:nlon) = lon(:nlon) * d2r
@@ -171,10 +170,9 @@ subroutine tropopause_climo_read_file()
     !  ... allocate arrays
     !------------------------------------------------------------------
     allocate( tropp_p_in(nlon,nlat,ntimes), stat=ierr, errmsg=errmsg )
-    if( ierr /= 0 ) then
-       write(iulog,*) 'tropopause_climo_read_file: tropp_p_in allocation error = ',ierr
-       call endrun('tropopause_climo_read_file: failed to allocate tropp_p_in, error = ' // errmsg)
-    end if
+    call check_allocate(ierr, subname, 'tropp_p_in(nlon,nlat,ntimes)', &
+                        file=__FILE__, line=__LINE__, errmsg=errmsg)
+
     !------------------------------------------------------------------
     !  ... read in the tropopause pressure
     !------------------------------------------------------------------
@@ -191,13 +189,9 @@ subroutine tropopause_climo_read_file()
     !--------------------------------------------------------------------
     !  ... regrid
     !--------------------------------------------------------------------
-
     allocate( tropp_p_loc(pcols,ntimes), stat=ierr, errmsg=errmsg )
-
-    if( ierr /= 0 ) then
-      write(iulog,*) 'tropopause_climo_read_file: tropp_p_loc allocation error = ',ierr
-      call endrun('tropopause_climo_read_file: failed to allocate tropp_p_loc, error = ' // errmsg)
-    end if
+    call check_allocate(ierr, subname, 'tropp_p_loc(pcols,ntimes)', &
+                        file=__FILE__, line=__LINE__, errmsg=errmsg)
 
     call get_rlat_all_p(pcols, to_lats)
     call get_rlon_all_p(pcols, to_lons)
@@ -217,10 +211,8 @@ subroutine tropopause_climo_read_file()
     !--------------------------------------------------------
 
     allocate( tropp_days(tropp_slices), stat=ierr, errmsg=errmsg )
-    if( ierr /= 0 ) then
-      write(iulog,*) 'tropopause_climo_read_file: tropp_days allocation error = ',ierr
-      call endrun('tropopause_climo_read_file: failed to allocate tropp_days, error = ' // errmsg)
-    end if
+    call check_allocate(ierr, subname, 'tropp_days(tropp_slices)', &
+                        file=__FILE__, line=__LINE__, errmsg=errmsg)
 
     do n = 1,tropp_slices
        tropp_days(n) = get_calday( dates(n), 0 )

src/utils/cam_abortutils.F90

@@ -29,7 +29,7 @@ module cam_abortutils
 
 CONTAINS
 
-   subroutine check_allocate(errcode, subname, fieldname, file, line)
+   subroutine check_allocate(errcode, subname, fieldname, file, line, errmsg)
       ! If <errcode> is not zero, call endrun with an error message
 
       ! Dummy arguments
@@ -38,6 +38,8 @@ subroutine check_allocate(errcode, subname, fieldname, file, line)
       character(len=*),           intent(in) :: fieldname
       character(len=*), optional, intent(in) :: file
       integer,          optional, intent(in) :: line
+      character(len=*), optional, intent(in) :: errmsg
+
       ! Local variables
       character(len=max_chars) :: abort_msg
       real(r8)                 :: mem_val, mem_hw_val
@@ -48,11 +50,16 @@ subroutine check_allocate(errcode, subname, fieldname, file, line)
 
          ! Write error message with memory stats
          write(abort_msg, '(4a,i0,a,f10.2,a,f10.2,a)') &
-              trim(subname), ": Allocate of '",  &
+              trim(subname), ": Allocation of '",  &
               trim(fieldname), "' failed with code ", errcode, &
               ". Memory highwater is ", mem_hw_val, &
               " mb, current memory usage is ", mem_val, " mb"
 
+         ! If the optional fortran allocate error message is passed in, include it in the abort message
+         if(present(errmsg)) then
+            write(abort_msg, '(a)') trim(abort_msg) // new_line('a') // "Allocation failed with: " // trim(errmsg)
+         endif
+
          ! End the simulation
          call endrun(abort_msg, file=file, line=line)
       end if
@@ -80,25 +87,31 @@ subroutine cam_register_open_file(file, file_name)
       end do
       ! If we get here, go ahead and register the file
       if (associated(open_files_pool)) then
+         ! Reuse pooled structure and point to the next pool entry
          of_new => open_files_pool
+         open_files_pool => open_files_pool%next
          allocate(of_new%file_desc, stat=ierr)
          call check_allocate(ierr, subname, 'of_file%file_desc', file=__FILE__, &
              line=__LINE__)
          of_new%file_desc = file
          of_new%file_name = file_name
-         allocate(open_files_pool%next)
-         open_files_pool%next => open_files_pool
+         nullify(of_new%next)
       else
          allocate(of_new)
          allocate(of_new%file_desc)
          of_new%file_desc = file
          of_new%file_name = file_name
-         open_files_pool => of_new
-      end if
-      open_files_tail => of_new
-      if (.not. associated(open_files_head)) then
-         open_files_head => of_new
+         nullify(of_new%next)
       end if
+
+      ! Add the registered file to the tail of the open files list
+      if(associated(open_files_tail)) then
+         open_files_tail%next => of_new
+         open_files_tail      => of_new
+      else
+         open_files_head      => of_new
+         open_files_tail      => of_new
+      endif
    end subroutine cam_register_open_file
 
    subroutine cam_register_close_file(file, log_shutdown_in)