more F90 conversion

src/CMakeLists.txt

@@ -4,18 +4,19 @@
 # Mark Potts, Kyle Gerheiser, Ed Hartnett
 
 # These are the fortran source files.
-set(fortran_src addfield.F90 addgrid.F90 addlocal.F90 cmplxpack.F90 compack.F90
-comunpack.F90 drstemplates.F90 g2_gbytesc.F90 g2grids.F90 gb_info.F90
-getdim.F90 getfield.F90 getg2i.F90 getg2ir.F90 getgb2.F90 getgb2l.F90 getgb2p.F90
-getgb2r.F90 getgb2rp.F90 getgb2s.F90 getidx.F90 getlocal.F90 getpoly.F90
-gettemplates.F90 gf_free.F90 gf_getfld.F90 gf_unpack1.F90 gf_unpack2.F90
-gf_unpack3.F90 gf_unpack4.F90 gf_unpack5.F90 gf_unpack6.F90 gf_unpack7.F90
+set(fortran_src addfield.F90 addgrid.F90 addlocal.F90 cmplxpack.F90
+compack.F90 comunpack.F90 drstemplates.F90 g2_gbytesc.F90 g2grids.F90
+gb_info.F90 getdim.F90 getfield.F90 getg2i.F90 getg2ir.F90 getgb2.F90
+getgb2l.F90 getgb2p.F90 getgb2r.F90 getgb2rp.F90 getgb2s.F90
+getidx.F90 getlocal.F90 getpoly.F90 gettemplates.F90 gf_free.F90
+gf_getfld.F90 gf_unpack1.F90 gf_unpack2.F90 gf_unpack3.F90
+gf_unpack4.F90 gf_unpack5.F90 gf_unpack6.F90 gf_unpack7.F90
 gribcreate.F90 gribend.F90 gribinfo.F90
-${CMAKE_CURRENT_BINARY_DIR}/gribmod.F90 gridtemplates.F90 intmath.f
+${CMAKE_CURRENT_BINARY_DIR}/gribmod.F90 gridtemplates.F90 intmath.F90
 ixgb2.F90 jpcpack.F90 jpcunpack.F90 misspack.f mkieee.F90 pack_gp.f
 params_ecmwf.F90 params.F90 pdstemplates.F90 pngpack.F90 pngunpack.F90
-putgb2.F90 rdieee.F90 realloc.F90 reduce.f simpack.F90 simunpack.F90 skgb.F90
-specpack.F90 specunpack.F90)
+putgb2.F90 rdieee.F90 realloc.F90 reduce.f simpack.F90 simunpack.F90
+skgb.F90 specpack.F90 specunpack.F90)
 
 # This function calls NCEPLIBS-w3emc.
 if (BUILD_WITH_W3EMC)

src/intmath.F90

@@ -0,0 +1,268 @@
+!> @file
+!> @brief Define math functions used by compack(),
+!> simpack(), and misspack().
+!> @author Stephen Gilbert @date 2000-06-21
+
+!> @brief Define math functions used by compack(),
+!> simpack(), and misspack().
+!>
+!> This module includes the following functions:
+!> - ilog2 Calculate log(x)/log(2).
+!>   - ilog2_8 for 8 bit integer numbers.
+!>   - ilog2_4 for 4 bit integer numbers.
+!>   - ilog2_2 for 2 bit integer numbers.
+!>   - ilog2_1 for 1 bit integer numbers.
+!> - i1log2 Calculate log(x+1)/log(2) unless x=maxint, in which case log(x)/log(2).
+!>   - i1log2_8 for 8 bit integer numbers.
+!>   - i1log2_4 for 4 bit integer numbers.
+!>   - i1log2_2 for 2 bit integer numbers.
+!>   - i1log2_1 for 1 bit integer numbers.
+!>
+!> @author Stephen Gilbert @date 2000-06-21
+module intmath
+  implicit none
+
+  interface ilog2 
+     ! log(x)/log(2)
+     module procedure ilog2_8 
+     module procedure ilog2_4
+     module procedure ilog2_2
+     module procedure ilog2_1
+  end interface ilog2
+
+  interface i1log2
+     ! log(x+1)/log(2) unless x=maxint, in which case log(x)/log(2)
+     module procedure i1log2_8
+     module procedure i1log2_4
+     module procedure i1log2_2
+     module procedure i1log2_1
+  end interface i1log2
+
+contains
+
+  !> This function returns log(x+1)/log(2) unless x=maxint, in
+  !> which case log(x)/log(2) for 8 bit integer numbers.
+  !> @param[in] ival 8 bit integer numbers.
+  !> @return value for log(x+1)/log(2)
+  !> @author Stephen Gilbert @date 2000-06-21
+  function i1log2_8(ival)
+    implicit none
+    integer(kind=8), value :: ival
+    integer(kind=8)::i1log2_8
+    integer(kind=8), parameter :: one=1
+    if(ival+one<ival) then
+       i1log2_8=ilog2_8(ival)
+    else
+       i1log2_8=ilog2_8(ival+one)
+    endif
+  end function i1log2_8
+
+  !> This function returns log(x+1)/log(2) unless x=maxint, in
+  !> which case log(x)/log(2) for 4 bit integer numbers.
+  !> @param[in] ival 4 bit integer numbers.
+  !> @return value for log(x+1)/log(2)
+  !> @author Stephen Gilbert @date 2000-06-21
+  function i1log2_4(ival)
+    implicit none
+    integer(kind=4), value :: ival
+    integer(kind=4)::i1log2_4
+    integer(kind=4), parameter :: one=1
+    if(ival+one<ival) then
+       i1log2_4=ilog2_4(ival)
+    else
+       i1log2_4=ilog2_4(ival+one)
+    endif
+  end function i1log2_4
+
+  !> This function returns log(x+1)/log(2) unless x=maxint, in
+  !> which case log(x)/log(2) for 2 bit integer numbers.
+  !> @param[in] ival 2 bit integer numbers.
+  !> @return value for log(x+1)/log(2)
+  !> @author Stephen Gilbert @date 2000-06-21
+  function i1log2_2(ival)
+    implicit none
+    integer(kind=2), value :: ival
+    integer(kind=2)::i1log2_2
+    integer(kind=2), parameter :: one = 1_2
+    if(ival+one<ival) then
+       i1log2_2=ilog2_2(ival)
+    else
+       i1log2_2=ilog2_2(ival+one)
+    endif
+  end function i1log2_2
+
+  !> This function returns log(x+1)/log(2) unless x=maxint, in
+  !> which case log(x)/log(2) for 1 bit integer numbers.
+  !> @param[in] ival 1 bit integer numbers.
+  !> @return value for log(x+1)/log(2)
+  !> @author Stephen Gilbert @date 2000-06-21
+  function i1log2_1(ival)
+    implicit none
+    integer(kind=1), value :: ival
+    integer(kind=1)::i1log2_1
+    integer(kind=1), parameter :: one = 1_1
+    if(ival+one<ival) then
+       i1log2_1=ilog2_1(ival)
+    else
+       i1log2_1=ilog2_1(ival+one)
+    endif
+  end function i1log2_1
+
+  !> This function returns log(x)/log(2) for 8 bit integer numbers.
+  !> @param[in] i_in 8 bit integer numbers.
+  !> @return value for log(x)/log(2)
+  !> @author Stephen Gilbert @date 2000-06-21
+  function ilog2_8(i_in)
+    implicit none
+    integer(kind=8), value :: i_in
+    integer(kind=8)::ilog2_8,i
+    ilog2_8=0
+    i=i_in
+    if(i<=0) return
+    if(iand(i,i-1)/=0) then
+       !write(0,*) 'iand i-1'
+       ilog2_8=1
+    endif
+    if(iand(i,Z'FFFFFFFF00000000')/=0) then
+       ilog2_8=ilog2_8+32
+       i=ishft(i,-32)
+       !write(0,*) 'iand ffffffff',i,ilog2_8
+    endif
+    if(iand(i,Z'00000000FFFF0000')/=0) then
+       ilog2_8=ilog2_8+16
+       i=ishft(i,-16)
+       !write(0,*) 'iand ffff' ,i,ilog2_8
+    endif
+    if(iand(i,Z'000000000000FF00')/=0) then
+       ilog2_8=ilog2_8+8
+       i=ishft(i,-8)
+       !write(0,*) 'iand ff',i,ilog2_8
+    endif
+    if(iand(i,Z'00000000000000F0')/=0) then
+       ilog2_8=ilog2_8+4
+       i=ishft(i,-4)
+       !write(0,*) 'iand f',i,ilog2_8
+    endif
+    if(iand(i,Z'000000000000000C')/=0) then
+       ilog2_8=ilog2_8+2
+       i=ishft(i,-2)
+       !write(0,*) 'iand c',i,ilog2_8
+    endif
+    if(iand(i,Z'0000000000000002')/=0) then
+       ilog2_8=ilog2_8+1
+       i=ishft(i,-1)
+       !write(0,*) 'iand 2',i,ilog2_8
+    endif
+  end function ilog2_8
+
+  !> This function returns log(x)/log(2) for 4 bit integer numbers.
+  !> @param[in] i_in 4 bit integer numbers.
+  !> @return value for log(x)/log(2)
+  !> @author Stephen Gilbert @date 2000-06-21
+  function ilog2_4(i_in)
+    implicit none
+    integer(kind=4), value :: i_in
+    integer(kind=4)::ilog2_4,i
+    ilog2_4=0
+    i=i_in
+    if(i<=0) return
+    if(iand(i,i-1)/=0) then
+       !write(0,*) 'iand i-1'
+       ilog2_4=1
+    endif
+    if(iand(i,Z'FFFF0000')/=0) then
+       ilog2_4=ilog2_4+16
+       i=ishft(i,-16)
+       !write(0,*) 'iand ffff' ,i,ilog2_4
+    endif
+    if(iand(i,Z'0000FF00')/=0) then
+       ilog2_4=ilog2_4+8
+       i=ishft(i,-8)
+       !write(0,*) 'iand ff',i,ilog2_4
+    endif
+    if(iand(i,Z'000000F0')/=0) then
+       ilog2_4=ilog2_4+4
+       i=ishft(i,-4)
+       !write(0,*) 'iand f',i,ilog2_4
+    endif
+    if(iand(i,Z'0000000C')/=0) then
+       ilog2_4=ilog2_4+2
+       i=ishft(i,-2)
+       !write(0,*) 'iand c',i,ilog2_4
+    endif
+    if(iand(i,Z'00000002')/=0) then
+       ilog2_4=ilog2_4+1
+       i=ishft(i,-1)
+       !write(0,*) 'iand 2',i,ilog2_4
+    endif
+  end function ilog2_4
+
+  !> This function returns log(x)/log(2) for 2 bit integer numbers.
+  !> @param[in] i_in 2 bit integer numbers.
+  !> @return value for log(x)/log(2)
+  !> @author Stephen Gilbert @date 2000-06-21
+  function ilog2_2(i_in)
+    implicit none
+    integer(kind=2), value :: i_in
+    integer(kind=2)::ilog2_2,i
+    ilog2_2 = 0_2
+    i=i_in
+    if(i<=0) return
+    if(iand(i,int(i-1,kind=2))/=0) then
+       !write(0,*) 'iand i-1'
+       ilog2_2 = 1_2
+    endif
+    if(iand(i,Z'FF00')/=0) then
+       ilog2_2 = ilog2_2 + 8_2
+       i=ishft(i,-8)
+       !write(0,*) 'iand ff',i,ilog2_2
+    endif
+    if(iand(i,Z'00F0')/=0) then
+       ilog2_2 = ilog2_2 + 4_2
+       i=ishft(i,-4)
+       !write(0,*) 'iand f',i,ilog2_2
+    endif
+    if(iand(i,Z'000C')/=0) then
+       ilog2_2 = ilog2_2 + 2_2
+       i=ishft(i,-2)
+       !write(0,*) 'iand c',i,ilog2_2
+    endif
+    if(iand(i,Z'0002')/=0) then
+       ilog2_2 = ilog2_2 + 1_2
+       i=ishft(i,-1)
+       !write(0,*) 'iand 2',i,ilog2_2
+    endif
+  end function ilog2_2
+
+  !> This function returns log(x)/log(2) for 1 bit integer numbers.
+  !> @param[in] i_in 1 bit integer numbers.
+  !> @return value for log(x)/log(2)
+  !> @author Stephen Gilbert @date 2000-06-21
+  function ilog2_1(i_in)
+    implicit none
+    integer(kind=1), value :: i_in
+    integer(kind=1)::ilog2_1,i
+    ilog2_1 = 0_1
+    i=i_in
+    if(i<=0) return
+    if(iand(i,int(i-1,kind=1))/=0) then
+       !write(0,*) 'iand i-1'
+       ilog2_1 = 1_1
+    endif
+    if(iand(i,Z'F0')/=0) then
+       ilog2_1 = ilog2_1 + 4_1
+       i=ishft(i,-4)
+       !write(0,*) 'iand f',i,ilog2_1
+    endif
+    if(iand(i,Z'0C')/=0) then
+       ilog2_1 = ilog2_1 + 2_1
+       i=ishft(i,-2)
+       !write(0,*) 'iand c',i,ilog2_1
+    endif
+    if(iand(i,Z'02')/=0) then
+       ilog2_1 = ilog2_1 + 1_1
+       i=ishft(i,-1)
+       !write(0,*) 'iand 2',i,ilog2_1
+    endif
+  end function ilog2_1
+end module intmath