Merge branch 'czender/elm_mali/interpinic_netcdf_boz_fixes' (PR #6614)

This new feature allows `interpinic` to interpolate an ELM initial conditions file
that require storage in `NC_FORMAT_64BIT_DATA` and other netCDF4 formats.

[BFB] [Bugfix]

Author: bishtgautam

components/elm/tools/interpinic/src/fmain.F90

@@ -14,7 +14,7 @@ program fmain
   character(len= 256) :: arg
   integer :: n                   !index 
   integer :: nargs               !number of arguments  
-  integer, external :: iargc     !number of arguments function
+  integer :: iargc     !number of arguments function
   character(len=256) :: finidati !input initial dataset to read
   character(len=256) :: finidato !output initial dataset to create
   character(len=256) :: cmdline  !input command line

components/elm/tools/interpinic/src/interpinic.F90

@@ -146,9 +146,19 @@ subroutine interp_filei (fin, fout, cmdline)
     call check_ret (nf90_open(fin,  NF90_NOWRITE, ncidi ))
     call check_ret (nf90_open(fout, NF90_NOWRITE, ncido ))
     call check_ret (nf_inq_format( ncido, ncformat ))
-    if ( ncformat /= NF_FORMAT_64BIT )then
-       write (6,*) 'error: output file is NOT in NetCDF large-file format!'
-       stop
+
+    ! Allow any format for output dataset
+
+    if ( ncformat == NF_FORMAT_CLASSIC )then
+       write (6,*) 'info: output file is NF_FORMAT_CLASSIC'
+    else if ( ncformat == NF_FORMAT_64BIT_OFFSET )then
+       write (6,*) 'info: output file is NF_FORMAT_64BIT_OFFSET'
+    else if ( ncformat == NF_FORMAT_64BIT_DATA )then
+       write (6,*) 'info: output file is NF_FORMAT_64BIT_DATA'
+    else if ( ncformat == NF_FORMAT_NETCDF4 )then
+       write (6,*) 'info: output file is NF_FORMAT_NETCDF4'
+    else if ( ncformat == NF_FORMAT_NETCDF4_CLASSIC )then
+       write (6,*) 'info: output file is NF_FORMAT_NETCDF4_CLASSIC'
     end if
 
     call check_ret (nf90_inq_dimid(ncidi, "column", dimidcols ))
@@ -214,12 +224,25 @@ subroutine interp_filei (fin, fout, cmdline)
     ret = nf90_inq_dimid(ncidi, "month", dimidmon)
     if (ret == NF90_NOERR) then
        call check_ret (nf90_inquire_dimension(ncidi, dimidmon, len=nlevmon))
-       call check_ret (nf90_inq_dimid(ncido, "month", dimid ))
-       call check_ret (nf90_inquire_dimension(ncido, dimid, len=dimlen))
-       if (dimlen/=nlevmon) then
-          write (6,*) 'error: input and output nlevmon values disagree'
-          write (6,*) 'input nlevmon = ',nlevmon,' output nlevmon = ',dimlen
-          stop
+
+       ! Many restart files have "month" dimension in input dataset
+       ! It is only necessary that the output dataset contains "month" dimension
+       ! when a variable in the input dataset contains the "month" dimension
+       ! Otherwise, the "month" dimension will never be used
+       ! Warn rather than die when input has "month" and output does not
+
+       ret = nf90_inq_dimid(ncido, "month", dimid )
+       if ( ret == nf_ebaddim ) then
+          write (6,*) 'warning: input has "month" dimension and output does not'
+          write (6,*) 'warning: interpolation will fail if any input variable uses "month" dimension'
+          write (6,*) 'chill:   many times the "month" dimension is superfluous so this might work...'
+       else
+          call check_ret (nf90_inquire_dimension(ncido, dimid, len=dimlen))
+          if (dimlen/=nlevmon) then
+             write (6,*) 'error: input and output nlevmon values disagree'
+             write (6,*) 'input nlevmon = ',nlevmon,' output nlevmon = ',dimlen
+             stop
+          end if
        end if
     else
        write (6,*) 'month dimension does NOT exist on the input dataset'
@@ -321,7 +344,9 @@ subroutine interp_filei (fin, fout, cmdline)
     ! OK now, open the output file for writing
     !
     call check_ret(nf90_close( ncido))
-    call check_ret (nf90_open(fout, ior(NF90_WRITE,  NF_64BIT_OFFSET), ncido ))
+
+    ! Allow any format for output dataset
+    call check_ret (nf90_open(fout, NF90_WRITE, ncido ))
 
     call addglobal (ncido, cmdline)
 
@@ -1503,8 +1528,7 @@ subroutine addglobal (ncid, cmdline)
     character(len=10) :: time
     character(len= 5) :: zone
     character(len=18) :: datetime
-    character(len=256):: version = &
-         "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r085/models/lnd/clm/tools/clm4_5/interpinic/src/interpinic.F90 $"
+    character(len=256):: version = ""
     character(len=256)  :: revision_id = "$Id: interpinic.F90 54953 2013-11-06 16:29:45Z sacks $"
     character(len=16)   :: logname
     character(len=16)   :: hostname

components/elm/tools/interpinic/src/shr_infnan_mod.F90

@@ -2,11 +2,11 @@
 
 module shr_infnan_mod
 
-!!     Inf_NaN_Detection module 
+!!     Inf_NaN_Detection module
 !!     Copyright(c) 2003, Lahey Computer Systems, Inc.
-!!     Copies of this source code, or standalone compiled files 
+!!     Copies of this source code, or standalone compiled files
 !!     derived from this source may not be sold without permission
-!!     from Lahey Computers Systems. All or part of this module may be 
+!!     from Lahey Computers Systems. All or part of this module may be
 !!     freely incorporated into executable programs which are offered
 !!     for sale. Otherwise, distribution of all or part of this file is
 !!     permitted, provided this copyright notice and header are included.
@@ -22,12 +22,12 @@ module shr_infnan_mod
 !!     isneginf(x) - test for a negative "infinite" value
 !!
 !!     Each function accepts a single or double precision real argument, and
-!!     returns a true or false value to indicate the presence of the value 
+!!     returns a true or false value to indicate the presence of the value
 !!     being tested for. If the argument is array valued, the function returns
 !!     a conformable logical array, suitable for use with the ANY function, or
 !!     as a logical mask.
 !!
-!!     Each function operates by transferring the bit pattern from a real 
+!!     Each function operates by transferring the bit pattern from a real
 !!     variable to an integer container. Unless testing for + or - infinity,
 !!     the sign bit is cleared to zero. The value is exclusive ORed with
 !!     the value being tested for. The integer result of the IEOR function is
@@ -48,14 +48,14 @@ module shr_infnan_mod
     integer, parameter :: Double = selected_int_kind(precision(1.0_r8))
 
     ! Single precision IEEE values
-    integer(Single), parameter :: sNaN    = Z"7FC00000"
-    integer(Single), parameter :: sPosInf = Z"7F800000"
-    integer(Single), parameter :: sNegInf = Z"FF800000"
+    integer(Single), parameter :: sNaN    = int(Z"7FC00000")
+    integer(Single), parameter :: sPosInf = int(Z"7F800000")
+    integer(Single), parameter :: sNegInf = int(Z"FF800000")
 
     ! Double precision IEEE values
-    integer(Double), parameter :: dNaN    = Z"7FF8000000000000"
-    integer(Double), parameter :: dPosInf = Z"7FF0000000000000"
-    integer(Double), parameter :: dNegInf = Z"FFF0000000000000"
+    integer(Double), parameter :: dNaN    = int(Z"7FF8000000000000")
+    integer(Double), parameter :: dPosInf = int(Z"7FF0000000000000")
+    integer(Double), parameter :: dNegInf = int(Z"FFF0000000000000")
 
     ! Locatation of single and double precision sign bit (Intel)
     ! Subtract one because bit numbering starts at zero
@@ -84,30 +84,30 @@ module shr_infnan_mod
       module procedure sisnan
       module procedure disnan
 #endif
-   end interface   
+   end interface
 
    interface shr_infnan_isinf
       module procedure sisinf
       module procedure disinf
-   end interface   
-   
+   end interface
+
    interface shr_infnan_isposinf
       module procedure sisposinf
       module procedure disposinf
-   end interface   
-   
+   end interface
+
    interface shr_infnan_isneginf
       module procedure sisneginf
       module procedure disneginf
-   end interface   
+   end interface
 
 
    integer :: shr_sisnan
    external :: shr_sisnan
    integer :: shr_disnan
    external :: shr_disnan
 
-contains    
+contains
 
 !
 ! If FORTRAN intrinsic's exist use them
@@ -134,7 +134,7 @@ elemental function sisnan(x) result(res)
     res = isnan(x)
 #endif
 
-  end function  
+  end function
 
   ! Double precision test for NaN
   elemental function disnan(d) result(res)
@@ -156,7 +156,7 @@ elemental function disnan(d) result(res)
     res = isnan(d)
 #endif
 
-  end function  
+  end function
 
 !
 ! Otherwise link to a C function call that either uses the C90 isnan function or a x != x check
@@ -176,13 +176,13 @@ function c_sisnan_1D(x) result(res)
     real(r4), intent(in) :: x(:)
     logical :: res(size(x))
 
-    integer :: i 
+    integer :: i
 
     do i = 1, size(x)
        res(i) = (shr_sisnan(x(i)) /= 0)
     end do
   end function c_sisnan_1D
-  
+
   function c_sisnan_2D(x) result(res)
     real(r4), intent(in) :: x(:,:)
     logical :: res(size(x,1),size(x,2))
@@ -195,7 +195,7 @@ function c_sisnan_2D(x) result(res)
     end do
     end do
   end function c_sisnan_2D
-  
+
   function c_sisnan_3D(x) result(res)
     real(r4), intent(in) :: x(:,:,:)
     logical :: res(size(x,1),size(x,2),size(x,3))
@@ -210,7 +210,7 @@ function c_sisnan_3D(x) result(res)
     end do
     end do
   end function c_sisnan_3D
-  
+
   function c_sisnan_4D(x) result(res)
     real(r4), intent(in) :: x(:,:,:,:)
     logical :: res(size(x,1),size(x,2),size(x,3),size(x,4))
@@ -227,7 +227,7 @@ function c_sisnan_4D(x) result(res)
     end do
     end do
   end function c_sisnan_4D
-  
+
   function c_sisnan_5D(x) result(res)
     real(r4), intent(in) :: x(:,:,:,:,:)
     logical :: res(size(x,1),size(x,2),size(x,3),size(x,4),size(x,5))
@@ -246,7 +246,7 @@ function c_sisnan_5D(x) result(res)
     end do
     end do
   end function c_sisnan_5D
-  
+
   function c_sisnan_6D(x) result(res)
     real(r4), intent(in) :: x(:,:,:,:,:,:)
     logical :: res(size(x,1),size(x,2),size(x,3),size(x,4),size(x,5),size(x,6))
@@ -267,7 +267,7 @@ function c_sisnan_6D(x) result(res)
     end do
     end do
   end function c_sisnan_6D
-  
+
   function c_sisnan_7D(x) result(res)
     real(r4), intent(in) :: x(:,:,:,:,:,:,:)
     logical :: res(size(x,1),size(x,2),size(x,3),size(x,4),size(x,5),size(x,6),size(x,7))
@@ -290,7 +290,7 @@ function c_sisnan_7D(x) result(res)
     end do
     end do
   end function c_sisnan_7D
-  
+
   function c_disnan_scalar(x) result(res)
     real(r8), intent(in) :: x
     logical :: res
@@ -302,13 +302,13 @@ function c_disnan_1D(x) result(res)
     real(r8), intent(in) :: x(:)
     logical :: res(size(x))
 
-    integer :: i 
+    integer :: i
 
     do i = 1, size(x)
        res(i) = (shr_disnan(x(i)) /= 0)
     end do
   end function c_disnan_1D
-  
+
   function c_disnan_2D(x) result(res)
     real(r8), intent(in) :: x(:,:)
     logical :: res(size(x,1),size(x,2))
@@ -321,7 +321,7 @@ function c_disnan_2D(x) result(res)
     end do
     end do
   end function c_disnan_2D
-  
+
   function c_disnan_3D(x) result(res)
     real(r8), intent(in) :: x(:,:,:)
     logical :: res(size(x,1),size(x,2),size(x,3))
@@ -336,7 +336,7 @@ function c_disnan_3D(x) result(res)
     end do
     end do
   end function c_disnan_3D
-  
+
   function c_disnan_4D(x) result(res)
     real(r8), intent(in) :: x(:,:,:,:)
     logical :: res(size(x,1),size(x,2),size(x,3),size(x,4))
@@ -353,7 +353,7 @@ function c_disnan_4D(x) result(res)
     end do
     end do
   end function c_disnan_4D
-  
+
   function c_disnan_5D(x) result(res)
     real(r8), intent(in) :: x(:,:,:,:,:)
     logical :: res(size(x,1),size(x,2),size(x,3),size(x,4),size(x,5))
@@ -372,7 +372,7 @@ function c_disnan_5D(x) result(res)
     end do
     end do
   end function c_disnan_5D
-  
+
   function c_disnan_6D(x) result(res)
     real(r8), intent(in) :: x(:,:,:,:,:,:)
     logical :: res(size(x,1),size(x,2),size(x,3),size(x,4),size(x,5),size(x,6))
@@ -393,7 +393,7 @@ function c_disnan_6D(x) result(res)
     end do
     end do
   end function c_disnan_6D
-  
+
   function c_disnan_7D(x) result(res)
     real(r8), intent(in) :: x(:,:,:,:,:,:,:)
     logical :: res(size(x,1),size(x,2),size(x,3),size(x,4),size(x,5),size(x,6),size(x,7))
@@ -418,48 +418,48 @@ function c_disnan_7D(x) result(res)
   end function c_disnan_7D
 
 #endif
-  
+
   ! Single precision test for Inf
   elemental function sisinf(x) result(res)
     real(r4), intent(in) :: x
     logical :: res
     res = ieor(ibclr(transfer(x,sPosInf),SPSB), sPosInf) == 0
-  end function  
+  end function
 
   ! Double precision test for Inf
   elemental function disinf(d) result(res)
     real(r8), intent(in) :: d
     logical :: res
     res = ieor(ibclr(transfer(d,dPosInf),DPSB), dPosInf) == 0
-  end function  
-  
+  end function
+
   ! Single precision test for +Inf
   elemental function sisposinf(x) result(res)
     real(r4), intent(in) :: x
     logical :: res
     res = ieor(transfer(x,sPosInf), sPosInf) == 0
-  end function  
+  end function
 
   ! Double precision test for +Inf
   elemental function disposinf(d) result(res)
     real(r8), intent(in) :: d
     logical :: res
     res = ieor(transfer(d,dPosInf), dPosInf) == 0
-  end function  
-  
+  end function
+
   ! Single precision test for -Inf
   elemental function sisneginf(x) result(res)
     real(r4), intent(in) :: x
     logical :: res
     res = ieor(transfer(x,sNegInf), sNegInf) == 0
-  end function  
+  end function
 
   ! Double precision test for -Inf
   elemental function disneginf(d) result(res)
     real(r8), intent(in) :: d
     logical :: res
     res = ieor(transfer(d,dNegInf), dNegInf) == 0
-  end function  
+  end function
 
 end module shr_infnan_mod