From 2c103c0e757ab099d82746e734dead767aa6742e Mon Sep 17 00:00:00 2001 From: Charlie Zender Date: Fri, 13 Sep 2024 09:26:28 -0700 Subject: [PATCH 1/4] Allow interpinic to accept any netCDF filetype for output. Print warning and continue (instead of failing) when input has month dimension and output does not. --- .../elm/tools/interpinic/src/interpinic.F90 | 54 ++++++++++++++----- 1 file changed, 42 insertions(+), 12 deletions(-) diff --git a/components/elm/tools/interpinic/src/interpinic.F90 b/components/elm/tools/interpinic/src/interpinic.F90 index b75afd3a411d..0b8af6155775 100644 --- a/components/elm/tools/interpinic/src/interpinic.F90 +++ b/components/elm/tools/interpinic/src/interpinic.F90 @@ -146,9 +146,22 @@ 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 + ! 20240822 csz++ + ! Allow any format for output dataset + ! if ( ncformat /= NF_FORMAT_64BIT )then + ! write (6,*) 'error: output file is NOT in NetCDF large-file format!' + ! stop + ! 20240822 csz-- + 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,13 +227,27 @@ 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 + ! 20240912 csz++ + ! 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 + !call check_ret (nf90_inq_dimid(ncido, "month", dimid )) + 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 + ! 20240912 csz-- else write (6,*) 'month dimension does NOT exist on the input dataset' dimidmon = -9999 @@ -321,7 +348,11 @@ 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 )) + ! 20240822 csz++ + ! Allow any format for output dataset + ! call check_ret (nf90_open(fout, ior(NF90_WRITE, NF_64BIT_OFFSET), ncido )) + call check_ret (nf90_open(fout, NF90_WRITE, ncido )) + ! csz-- call addglobal (ncido, cmdline) @@ -1503,8 +1534,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 From 4d1c5ea1a6af9249eb616ba408f6c4a0e36e293c Mon Sep 17 00:00:00 2001 From: Charlie Zender Date: Fri, 13 Sep 2024 09:42:06 -0700 Subject: [PATCH 2/4] Place hexadecimal parameters within int() intrinsic in NaN module for modern compilers (per Xylar) --- .../tools/interpinic/src/shr_infnan_mod.F90 | 88 +++++++++---------- 1 file changed, 44 insertions(+), 44 deletions(-) diff --git a/components/elm/tools/interpinic/src/shr_infnan_mod.F90 b/components/elm/tools/interpinic/src/shr_infnan_mod.F90 index 638cad84d20e..31ffb1dff329 100644 --- a/components/elm/tools/interpinic/src/shr_infnan_mod.F90 +++ b/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,22 +84,22 @@ 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 @@ -107,7 +107,7 @@ module shr_infnan_mod 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 From ef7aeca234bdd44b9bce518671e69489e13df6b6 Mon Sep 17 00:00:00 2001 From: Charlie Zender Date: Fri, 13 Sep 2024 16:38:59 -0700 Subject: [PATCH 3/4] remove external qualifier from iargc definition --- components/elm/tools/interpinic/src/fmain.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/elm/tools/interpinic/src/fmain.F90 b/components/elm/tools/interpinic/src/fmain.F90 index 0f55c12c67c9..a67e6e2627fb 100644 --- a/components/elm/tools/interpinic/src/fmain.F90 +++ b/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 From ece56d136c5861288291243cae2f49e73414c250 Mon Sep 17 00:00:00 2001 From: Charlie Zender Date: Fri, 13 Sep 2024 16:59:21 -0700 Subject: [PATCH 4/4] Remove commented-out code, CSZ markers, and dates last changed --- .../elm/tools/interpinic/src/interpinic.F90 | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/components/elm/tools/interpinic/src/interpinic.F90 b/components/elm/tools/interpinic/src/interpinic.F90 index 0b8af6155775..3d890a14b895 100644 --- a/components/elm/tools/interpinic/src/interpinic.F90 +++ b/components/elm/tools/interpinic/src/interpinic.F90 @@ -146,12 +146,9 @@ 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 )) - ! 20240822 csz++ + ! Allow any format for output dataset - ! if ( ncformat /= NF_FORMAT_64BIT )then - ! write (6,*) 'error: output file is NOT in NetCDF large-file format!' - ! stop - ! 20240822 csz-- + if ( ncformat == NF_FORMAT_CLASSIC )then write (6,*) 'info: output file is NF_FORMAT_CLASSIC' else if ( ncformat == NF_FORMAT_64BIT_OFFSET )then @@ -227,13 +224,13 @@ 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)) - ! 20240912 csz++ + ! 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 - !call check_ret (nf90_inq_dimid(ncido, "month", dimid )) + ret = nf90_inq_dimid(ncido, "month", dimid ) if ( ret == nf_ebaddim ) then write (6,*) 'warning: input has "month" dimension and output does not' @@ -247,7 +244,6 @@ subroutine interp_filei (fin, fout, cmdline) stop end if end if - ! 20240912 csz-- else write (6,*) 'month dimension does NOT exist on the input dataset' dimidmon = -9999 @@ -348,11 +344,9 @@ subroutine interp_filei (fin, fout, cmdline) ! OK now, open the output file for writing ! call check_ret(nf90_close( ncido)) - ! 20240822 csz++ + ! Allow any format for output dataset - ! call check_ret (nf90_open(fout, ior(NF90_WRITE, NF_64BIT_OFFSET), ncido )) call check_ret (nf90_open(fout, NF90_WRITE, ncido )) - ! csz-- call addglobal (ncido, cmdline)