diff --git a/utils/CMakeLists.txt b/utils/CMakeLists.txt index c68d607a..7f45a215 100644 --- a/utils/CMakeLists.txt +++ b/utils/CMakeLists.txt @@ -24,7 +24,7 @@ if (BUILD_D) if(CMAKE_C_COMPILER_ID MATCHES "^(Intel|IntelLLVM)$") set_target_properties(copygb2 PROPERTIES COMPILE_FLAGS "-r8 -auto -convert big_endian -fpp") elseif(CMAKE_C_COMPILER_ID MATCHES "^(GNU|Clang|AppleClang)$") - set_target_properties(copygb2 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fconvert=big-endian -cpp") + set_target_properties(copygb2 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fconvert=big-endian -cpp -frecursive") endif() install(TARGETS copygb2 RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR}) @@ -98,7 +98,7 @@ if(CMAKE_C_COMPILER_ID MATCHES "^(Intel|IntelLLVM)$") set_target_properties(copygb PROPERTIES COMPILE_FLAGS "-r8 -auto -heap-arrays") set_target_properties(grbindex PROPERTIES COMPILE_FLAGS "-convert big_endian -fpp") elseif(CMAKE_C_COMPILER_ID MATCHES "^(GNU|Clang|AppleClang)$") - set_target_properties(copygb PROPERTIES COMPILE_FLAGS "-fdefault-real-8") + set_target_properties(copygb PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -frecursive") set_target_properties(grbindex PROPERTIES COMPILE_FLAGS "-fconvert=big-endian -cpp") endif() diff --git a/utils/cnv21.F90 b/utils/cnv21.F90 index ce2a811f..35e90639 100644 --- a/utils/cnv21.F90 +++ b/utils/cnv21.F90 @@ -23,7 +23,6 @@ subroutine cnv21(ifl1,ifl2) integer,intent(in) :: ifl1,ifl2 CHARACTER(len=1),allocatable,dimension(:) :: cgrib - CHARACTER(len=8) :: ctemp type(gribfield) :: gfld integer,dimension(200) :: jids,jpdt,jgdt integer :: kpds(200),kgds(200),kens(200),kprob(2) @@ -31,7 +30,6 @@ subroutine cnv21(ifl1,ifl2) integer :: currlen=0 integer :: igds(5)=(/0,0,0,0,0/) real :: xprob(2) - logical*1,target,dimension(1) :: dummy logical :: unpack=.true. ! ! @@ -85,7 +83,7 @@ subroutine cnv21(ifl1,ifl2) ! Construct PDS ! call makepds(gfld%discipline,gfld%idsect,gfld%ipdtnum, & - gfld%ipdtmpl,gfld%ibmap,gfld%idrtnum, & + gfld%ipdtmpl,gfld%ibmap, & gfld%idrtmpl,kpds,iret) if (iret.ne.0) then print *,'cnv21: could not create pds in GRIB1' @@ -231,7 +229,6 @@ end subroutine cnv21 !> @param[in] ipdsnum GRIB2 Product Definition Template Number !> @param[in] ipdstmpl GRIB2 Product Definition Template entries for PDT 4.ipdsnum !> @param[in] ibmap GRIB2 bitmap indicator from octet 6, Section 6. -!> @param[in] idrsnum GRIB2 Data Representation Template Number !> @param[in] idrstmpl GRIB2 Data Representation Template entries !> @param[out] kpds GRIB1 PDS info as specified in W3FI63. !> - 1 id of center @@ -264,12 +261,12 @@ end subroutine cnv21 !> !> @author Stephen Gilbert @date 2003-06-12 subroutine makepds(idisc,idsect,ipdsnum,ipdstmpl,ibmap, & - idrsnum,idrstmpl,kpds,iret) + idrstmpl,kpds,iret) use params integer,intent(in) :: idsect(*),ipdstmpl(*),idrstmpl(*) - integer,intent(in) :: ipdsnum,idisc,idrsnum,ibmap + integer,intent(in) :: ipdsnum,idisc,ibmap integer,intent(out) :: kpds(*) integer,intent(out) :: iret diff --git a/utils/cnv22.F90 b/utils/cnv22.F90 index 65e7e88a..34510aa5 100644 --- a/utils/cnv22.F90 +++ b/utils/cnv22.F90 @@ -54,7 +54,6 @@ subroutine cnv22(ifl1,ifl2,ipack,usemiss,imiss,table_ver) integer :: table_ver logical :: unpack=.true. logical :: open_grb=.false. - logical*1,target,dimension(1) :: dummy ! ! --- Initialize Variables --- ! diff --git a/utils/copygb.F90 b/utils/copygb.F90 index c0a5e877..38d832fc 100644 --- a/utils/copygb.F90 +++ b/utils/copygb.F90 @@ -150,7 +150,6 @@ PROGRAM COPYGB CHARACTER*256 CARG,CG1,CX1,CGB,CXB,CGM,CXM,CG2,CNL INTEGER KARG(100), NTHREADS INTEGER KGDSI(200),IPOPT(20),JPDS1(200),JPDSB(200),IUV(100) - REAL RARG(100) CHARACTER*400 GDS DATA NTHREADS/1/ DATA IGI/-1/,KGDSI/19*0,255,180*0/ diff --git a/utils/copygb2.F90 b/utils/copygb2.F90 index 4ece3e68..68f650a7 100644 --- a/utils/copygb2.F90 +++ b/utils/copygb2.F90 @@ -162,8 +162,6 @@ PROGRAM COPYGB2 CHARACTER*256 CARG,CG1,CX1,CGB,CXB,CGM,CXM,CG2,CNL INTEGER KARG(100) INTEGER KGDTI(200),IPOPT(20),JPDT(200),JPDSB(200),IUV(100) - REAL RARG(100) - CHARACTER*400 GDS DATA IGDTN/-1/,KGDTI/200*0/ DATA IP/0/,IPOPT/20*-1/ DATA JPDTN/-1/,JPDT/200*-9999/,JPDSB/200*-1/ @@ -521,8 +519,7 @@ PROGRAM COPYGB2 ENDIF CALL CPGB(LG1,LX1,LGB,LXB,LGM,LXM,LG2, & IGDTN,KGDTI,IP,IPOPT,JPDTN,JPDT,NUV,IUV, & - JPDSB,JB,JBK,LAB,AB,LAM,AM,LXX,LWG, & - IDS,IBS,NBS) + JPDSB,JB,JBK,LAB,AB,LAM,AM,LXX) IF(LXX.GT.0) THEN CALL W3TAGE('COPYGB2 ') ENDIF @@ -577,16 +574,11 @@ END SUBROUTINE EUSAGE !> @param[in] lam integer flag for mask value !> @param[in] am real mask value !> @param[in] lxx integer flag for verbose output - !> @param[in] lwg integer flag for stdin selection - !> @param[in] ids integer (255) decimal scaling (-9999 for no change) - !> @param[in] ibs integer (255) binary scaling (-9999 for no change) - !> @param[in] nbs integer (255) number of bits (-9999 for no change) !> !> @author Iredell @date 96-07-19 SUBROUTINE CPGB(LG1,LX1,LGB,LXB,LGM,LXM,LG2, & IGDTN,KGDTI,IP,IPOPT,JPDTN,JPDT,NUV,IUV, & - JPDSB,JB,JBK,LAB,AB,LAM,AM,LXX,LWG, & - IDS,IBS,NBS) + JPDSB,JB,JBK,LAB,AB,LAM,AM,LXX) USE GRIB_MOD PARAMETER(MBUF=256*1024) @@ -596,11 +588,8 @@ SUBROUTINE CPGB(LG1,LX1,LGB,LXB,LGM,LXM,LG2, & INTEGER JPDSB(100),IUV(100) INTEGER KGDTI(200) INTEGER IPOPT(20) - INTEGER IDS(255),IBS(255),NBS(255) - INTEGER JPDS(200),JGDS(200),JENS(5) + INTEGER JGDS(200),JENS(5) INTEGER KPDSB(200),KGDSB(200),KENSB(5) - INTEGER KPDSM(200),KGDSM(200),KENSM(5) - CHARACTER*80 CIN LOGICAL UNPACK TYPE( GRIBFIELD ) :: GFLD1,GFLDM @@ -710,13 +699,12 @@ SUBROUTINE CPGB(LG1,LX1,LGB,LXB,LGM,LXM,LG2, & IF(LXX.GT.0) CALL INSTRUMENT(1,KALL1,TTOT1,TMIN1,TMAX1) IF(IGDTN.GE.0.AND.IGDTN.LE.65534) THEN MF=MAX(M1,MB,MM) - CALL CPGB1(LG1,LX1,M1, & + CALL CPGB1(LG1,LX1, & MBUF,MF,MI, & IGDTN,KGDTI,IP,IPOPT,JPDTN,JPDT,NUV,IUV, & JPDSB,JB,JBK,LAB,AB,LAM,AM, & - IDS,IBS,NBS, & LGB,LXB,MB,CBUFB,NLENB,NNUMB,MNUMB, & - LGM,LXM,MM, & + LGM,LXM, & LG2,LXX,KR1-1,NO,IRET1) ENDIF IF(LAM.EQ.5) THEN ! clean-up @@ -779,7 +767,6 @@ END SUBROUTINE CPGB !> !> @param[in] lg1 integer unit number for grib file 1 !> @param[in] lx1 integer unit number for grib index file 1 - !> @param[in] m1 integer dimension of grib field 1 !> @param[in] mbuf integer dimension of index buffers !> @param[in] mf integer dimension of field !> @param[in] mi integer dimension of output grid @@ -798,9 +785,6 @@ END SUBROUTINE CPGB !> @param[in] ab real map threshold !> @param[in] lam integer flag for mask value !> @param[in] am real mask value - !> @param[in] ids integer (255) decimal scaling (-9999 for no change) - !> @param[in] ibs integer (255) binary scaling (-9999 for no change) - !> @param[in] nbs integer (255) number of bits (-9999 for no change) !> @param[in] lgb integer unit number for grib file map !> @param[in] lxb integer unit number for grib index file map !> @param[in] mb integer dimension of grib field map @@ -810,7 +794,6 @@ END SUBROUTINE CPGB !> @param[in] mnumb integer number of index records map skipped !> @param[in] lgm integer unit number for grib file merge !> @param[in] lxm integer unit number for grib index file merge - !> @param[in] mm integer dimension of grib field merge !> @param[in] lg2 integer unit number for grib file 2 !> @param[in] lxx integer flag for verbose output !> @param[in] ks1 integer input record counter @@ -818,13 +801,12 @@ END SUBROUTINE CPGB !> @param[out] iret integer return code !> !> @author Iredell @date 96-07-19 - SUBROUTINE CPGB1(LG1,LX1,M1, & + SUBROUTINE CPGB1(LG1,LX1, & MBUF,MF,MI, & IGDTN,KGDTI,IP,IPOPT,JPDTN,JPDT,NUV,IUV, & JPDSB,JB,JBK,LAB,AB,LAM,AM, & - IDS,IBS,NBS, & LGB,LXB,MB,CBUFB,NLENB,NNUMB,MNUMB, & - LGM,LXM,MM, & + LGM,LXM, & LG2,LXX,KS1,NO,IRET) USE GRIB_MOD USE GRIDTEMPLATES @@ -835,11 +817,8 @@ SUBROUTINE CPGB1(LG1,LX1,M1, & INTEGER JJPDT(200) INTEGER,TARGET :: KGDTI(200) INTEGER IPOPT(20) - INTEGER IDS(255),IBS(255),NBS(255) - INTEGER JPDS(200),JGDS(200),JENS(5) - INTEGER KPDS1(200),KGDS1(200),KENS1(5) + INTEGER JGDS(200),JENS(5) INTEGER KPDSB(200),KGDSB(200),KENSB(5) - INTEGER KPDSM(200),KGDSM(200),KENSM(5) INTEGER,POINTER :: TMPPTR(:) LOGICAL*1 LR(MF) LOGICAL*1,POINTER :: L1I(:),LBI(:) diff --git a/utils/prgrib2.F90 b/utils/prgrib2.F90 index d5120aa6..fcf22279 100644 --- a/utils/prgrib2.F90 +++ b/utils/prgrib2.F90 @@ -294,132 +294,132 @@ end subroutine frmt !> !> @author Stephen Gilbert @date 2010-09-08 subroutine prvtime(ipdtn, ipdtmpl, listsec1, tabbrev) - implicit none - - integer, intent(in) :: ipdtn - integer, intent(in) :: ipdtmpl(*), listsec1(*) - character(len = 110), intent(out) :: tabbrev - - character(len = 16) :: reftime, endtime - character(len = 12) :: tmpval2 - character(len = 12) :: tmpval - character(len = 10) :: tunit - integer, dimension(200) :: ipos, ipos2 - integer :: is, itemp, itemp2, iunit, iuni2t2, iunit2, iutpos, iutpos2, j - - data ipos /7*0, 16, 23, 17, 19, 18, 32, 31, 27*0, 17, 20, 0, 0, 22, & - 25, 43*0, 23, 109*0/ - - data ipos2 /7*0, 26, 33, 27, 29, 28, 42, 41, 27*0, 22, 30, 0, 0, 32, & - 35, 43*0, 33, 109*0/ - - tabbrev(1:100) = " " - - ! Determine unit of time range. - if ((ipdtn .ge. 0 .and. ipdtn .le. 15) .or. ipdtn .eq. 32 & - .or. ipdtn .eq. 50 .or. ipdtn .eq. 51 & - .or. ipdtn .eq. 91) then - iutpos = 8 - elseif (ipdtn .ge. 40 .and. ipdtn .le. 43) then - iutpos = 9 - elseif (ipdtn .ge. 44 .and. ipdtn .le. 47) then - iutpos = 14 - elseif (ipdtn .eq. 48) then - iutpos = 19 - elseif (ipdtn .eq. 52) then - iutpos = 11 - else - iutpos = 8 - endif - - ! Determine first unit of time range. - selectcase(ipdtmpl(iutpos)) - case (0) - tunit = "minute" - iunit = 1 - case (1) - tunit = "hour" - iunit = 1 - case (2) - tunit = "day" - iunit = 1 - case (3) - tunit = "month" - iunit = 1 - case (4) - tunit = "year" - iunit = 1 - case (10) - tunit = "hour" - iunit = 3 - case (11) - tunit = "hour" - iunit = 6 - case default - tunit = "hour" - iunit = 1 - end select - - ! Determine second unit of time range. - if (ipdtn .eq. 0) then - iunit2 = 1 - iutpos2 = 0 - else - iutpos2 = ipos2(ipdtn) - if (iutpos2 .gt. 0) then - selectcase(ipdtmpl(iutpos2)) - case (0) - iunit2 = 1 - case (1) - iunit2 = 1 - case (2) - iunit2 = 1 - case (3) - iuni2t2 = 1 - case (4) - iunit2 = 1 - case (10) - iunit2 = 3 - case (11) - iunit2 = 6 - case default - iunit2 = 1 - end select - endif - endif - - write(reftime, fmt = '(i4,3i2.2,":",i2.2,":",i2.2)') (listsec1(j), j = 6, 11) - itemp = abs(ipdtmpl(iutpos + 1)) * iunit - write(tmpval, '(I0)') itemp - write(tabbrev, fmt = '("valid at ", i4)') ipdtmpl(iutpos + 1) - - ! Determine Reference Time: Year, Month, Day, Hour, Minute, Second. - if ((ipdtn .ge. 0 .and. ipdtn .le. 7) .or. ipdtn .eq. 15 & - .or. ipdtn .eq. 20 .or. (ipdtn .ge. 30 .and. ipdtn .le. 32) & - .or. ipdtn .eq. 40 .or. ipdtn .eq. 41 .or. ipdtn .eq. 44 & - .or. ipdtn .eq. 45 .or. ipdtn .eq. 48 .or. & - (ipdtn .ge. 50 .and. ipdtn .le. 52)) then ! Point in time - tabbrev = "valid " // trim(tmpval) // " " // trim(tunit) // " after " // reftime - else - is = ipos(ipdtn) ! Continuous time interval - write(endtime, fmt = '(i4,3i2.2,":",i2.2,":",i2.2)') (ipdtmpl(j), j = is, is + 5) - itemp2 = abs(ipdtmpl(iutpos2 + 1)) * iunit2 - itemp2 = itemp + itemp2 - write(tmpval2, '(I0)') itemp2 - if (ipdtn .eq. 8 .and. ipdtmpl(9) .lt. 0) then - tabbrev = "(" // trim(tmpval) // " -" & - // trim(tmpval2) // ") valid " // trim(tmpval) // & - " " // trim(tunit) // " before " & - // reftime // " to " //endtime - elseif ((ipdtn .ge. 8 .and. ipdtn .le. 14) .or. & - (ipdtn .ge. 42 .and. ipdtn .le. 47) .or. & - ipdtn .eq. 91) then ! Continuous time interval - tabbrev = "(" // trim(tmpval) // " -" & - // trim(tmpval2) // " hr) valid " // trim(tmpval) // & - " " // trim(tunit) // " after " & - // reftime // " to " // endtime - endif - endif - - return + implicit none + + integer, intent(in) :: ipdtn + integer, intent(in) :: ipdtmpl(*), listsec1(*) + character(len = 110), intent(out) :: tabbrev + + character(len = 16) :: reftime, endtime + character(len = 12) :: tmpval2 + character(len = 12) :: tmpval + character(len = 10) :: tunit + integer, dimension(200) :: ipos, ipos2 + integer :: is, itemp, itemp2, iunit, iuni2t2, iunit2, iutpos, iutpos2, j + + data ipos /7*0, 16, 23, 17, 19, 18, 32, 31, 27*0, 17, 20, 0, 0, 22, & + 25, 43*0, 23, 109*0/ + + data ipos2 /7*0, 26, 33, 27, 29, 28, 42, 41, 27*0, 22, 30, 0, 0, 32, & + 35, 43*0, 33, 109*0/ + + tabbrev(1:100) = " " + + ! Determine unit of time range. + if ((ipdtn .ge. 0 .and. ipdtn .le. 15) .or. ipdtn .eq. 32 & + .or. ipdtn .eq. 50 .or. ipdtn .eq. 51 & + .or. ipdtn .eq. 91) then + iutpos = 8 + elseif (ipdtn .ge. 40 .and. ipdtn .le. 43) then + iutpos = 9 + elseif (ipdtn .ge. 44 .and. ipdtn .le. 47) then + iutpos = 14 + elseif (ipdtn .eq. 48) then + iutpos = 19 + elseif (ipdtn .eq. 52) then + iutpos = 11 + else + iutpos = 8 + endif + + ! Determine first unit of time range. + selectcase(ipdtmpl(iutpos)) + case (0) + tunit = "minute" + iunit = 1 + case (1) + tunit = "hour" + iunit = 1 + case (2) + tunit = "day" + iunit = 1 + case (3) + tunit = "month" + iunit = 1 + case (4) + tunit = "year" + iunit = 1 + case (10) + tunit = "hour" + iunit = 3 + case (11) + tunit = "hour" + iunit = 6 + case default + tunit = "hour" + iunit = 1 + end select + + ! Determine second unit of time range. + if (ipdtn .eq. 0) then + iunit2 = 1 + iutpos2 = 0 + else + iutpos2 = ipos2(ipdtn) + if (iutpos2 .gt. 0) then + selectcase(ipdtmpl(iutpos2)) + case (0) + iunit2 = 1 + case (1) + iunit2 = 1 + case (2) + iunit2 = 1 + case (3) + iuni2t2 = 1 + case (4) + iunit2 = 1 + case (10) + iunit2 = 3 + case (11) + iunit2 = 6 + case default + iunit2 = 1 + end select + endif + endif + + write(reftime, fmt = '(i4,3i2.2,":",i2.2,":",i2.2)') (listsec1(j), j = 6, 11) + itemp = abs(ipdtmpl(iutpos + 1)) * iunit + write(tmpval, '(I0)') itemp + write(tabbrev, fmt = '("valid at ", i4)') ipdtmpl(iutpos + 1) + + ! Determine Reference Time: Year, Month, Day, Hour, Minute, Second. + if ((ipdtn .ge. 0 .and. ipdtn .le. 7) .or. ipdtn .eq. 15 & + .or. ipdtn .eq. 20 .or. (ipdtn .ge. 30 .and. ipdtn .le. 32) & + .or. ipdtn .eq. 40 .or. ipdtn .eq. 41 .or. ipdtn .eq. 44 & + .or. ipdtn .eq. 45 .or. ipdtn .eq. 48 .or. & + (ipdtn .ge. 50 .and. ipdtn .le. 52)) then ! Point in time + tabbrev = "valid " // trim(tmpval) // " " // trim(tunit) // " after " // reftime + else + is = ipos(ipdtn) ! Continuous time interval + write(endtime, fmt = '(i4,3i2.2,":",i2.2,":",i2.2)') (ipdtmpl(j), j = is, is + 5) + itemp2 = abs(ipdtmpl(iutpos2 + 1)) * iunit2 + itemp2 = itemp + itemp2 + write(tmpval2, '(I0)') itemp2 + if (ipdtn .eq. 8 .and. ipdtmpl(9) .lt. 0) then + tabbrev = "(" // trim(tmpval) // " -" & + // trim(tmpval2) // ") valid " // trim(tmpval) // & + " " // trim(tunit) // " before " & + // reftime // " to " //endtime + elseif ((ipdtn .ge. 8 .and. ipdtn .le. 14) .or. & + (ipdtn .ge. 42 .and. ipdtn .le. 47) .or. & + ipdtn .eq. 91) then ! Continuous time interval + tabbrev = "(" // trim(tmpval) // " -" & + // trim(tmpval2) // " hr) valid " // trim(tmpval) // & + " " // trim(tunit) // " after " & + // reftime // " to " // endtime + endif + endif + + return end subroutine prvtime \ No newline at end of file diff --git a/utils/tocgrib2.F90 b/utils/tocgrib2.F90 index 150a0c50..36deecc1 100644 --- a/utils/tocgrib2.F90 +++ b/utils/tocgrib2.F90 @@ -45,11 +45,9 @@ PROGRAM tocgrib2 integer :: nbul, nrec, mbul, dayofmonth, hourofday integer, parameter :: lenhead=21, jrew=0 - CHARACTER * 6 BULHED CHARACTER * 80 DESC, WMOHEAD CHARACTER * 200 fileb, filei, fileo CHARACTER * 6 envvar - CHARACTER * 4 KWBX CHARACTER * 1 CSEP(80) CHARACTER * 1 WMOHDR(lenhead) character(len=1), pointer, dimension(:) :: gribm diff --git a/utils/tocgrib2super.F90 b/utils/tocgrib2super.F90 index 483e749e..ca87217b 100644 --- a/utils/tocgrib2super.F90 +++ b/utils/tocgrib2super.F90 @@ -54,7 +54,6 @@ PROGRAM tocgrib2super CHARACTER * 80 DESC,WMOHEAD CHARACTER * 200 fileb,filei,fileo,filea CHARACTER * 6 envvar - CHARACTER * 4 KWBX CHARACTER * 1 CSEP(80) CHARACTER * 1 WMOHDR(lenhead) character(len=1),pointer,dimension(:) :: gribm