diff --git a/CMakeLists.txt b/CMakeLists.txt index c56070123..6112967dd 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -183,9 +183,7 @@ set_target_properties(ccpp_physics PROPERTIES VERSION ${PROJECT_VERSION} target_include_directories(ccpp_physics PUBLIC $) -target_link_libraries(ccpp_physics PUBLIC w3emc::w3emc_d - sp::sp_d - NetCDF::NetCDF_Fortran) +target_link_libraries(ccpp_physics PUBLIC NetCDF::NetCDF_Fortran) # Define where to install the library install(TARGETS ccpp_physics diff --git a/physics/GWD/cires_tauamf_data.F90 b/physics/GWD/cires_tauamf_data.F90 index 4f12b2ec1..f5fbf256d 100644 --- a/physics/GWD/cires_tauamf_data.F90 +++ b/physics/GWD/cires_tauamf_data.F90 @@ -1,5 +1,5 @@ module cires_tauamf_data - + use w3emc, only: w3doxdat, w3kind, w3movdat use machine, only: kind_phys !........................................................................................... ! tabulated GW-sources: GRACILE/Ern et al., 2018 and/or Resolved GWs from C384-Annual run diff --git a/physics/GWD/cires_ugwpv1_module.F90 b/physics/GWD/cires_ugwpv1_module.F90 index 9c3fa24ee..809abc84d 100644 --- a/physics/GWD/cires_ugwpv1_module.F90 +++ b/physics/GWD/cires_ugwpv1_module.F90 @@ -11,10 +11,11 @@ module cires_ugwpv1_module !................................................................................... ! ! - use machine, only : kind_phys - use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, rhp4, khp, hpskm - use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar - use ugwp_wmsdis_init, only : tau_min, tamp_mpa + use machine, only : kind_phys + use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, rhp4, khp, hpskm + use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar + use ugwp_wmsdis_init, only : tau_min, tamp_mpa + use w3emc, only : iw3jdn implicit none logical :: module_is_initialized @@ -436,7 +437,6 @@ subroutine calendar_ugwp(yr, mm, dd, ddd_ugwp) integer, intent(in) :: yr, mm, dd integer :: ddd_ugwp - integer :: iw3jdn integer :: jd1, jddd jd1 = iw3jdn(yr,1,1) jddd = iw3jdn(yr,mm,dd) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 index 6b1b29af1..c8742000f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 @@ -7,6 +7,8 @@ !> @{ module GFS_phys_time_vary + use w3emc, only: w3doxdat, w3kind, w3movdat + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec use mersenne_twister, only: random_setseed, random_number diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 index 3293e09e4..4f708c964 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 @@ -3,6 +3,8 @@ module GFS_time_vary_pre + use w3emc, only: iw3jdn, w3difdat, w3kind + use funcphys, only: gfuncphys implicit none @@ -93,7 +95,7 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys real(kind=kind_dbl_prec) :: rinc8(5) - integer :: iw3jdn + integer :: w3kindreal,w3kindint integer :: jd0, jd1 real :: fjd diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 index dd752d9b8..fa2a2738e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 @@ -7,6 +7,8 @@ !! IN and CCN data. module iccninterp + use w3emc, only: w3doxdat, w3kind, w3movdat + implicit none private diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F index 369a94358..bfd677800 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F @@ -7069,6 +7069,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & &, tile_num_ch, i_index, j_index) ! use machine , only : kind_io8,kind_io4, kind_dbl_prec + use w3emc, only : w3movdat implicit none character(len=*), intent(in) :: tile_num_ch integer, intent(in) :: i_index(len), j_index(len) @@ -8574,6 +8575,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & &, outlat, outlon, me) use machine , only : kind_io8,kind_dbl_prec,kind_sngl_prec use sfccyc_module, only : mdata + use w3emc, only : w3movdat implicit none integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, & & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, & diff --git a/physics/MP/Morrison_Gettelman/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 index 174a1a1a1..d7c8f9a87 100644 --- a/physics/MP/Morrison_Gettelman/aerinterp.F90 +++ b/physics/MP/Morrison_Gettelman/aerinterp.F90 @@ -6,6 +6,7 @@ !! This module contain subroutines of reading and interpolating !! aerosol data for MG microphysics. module aerinterp + use w3emc, only: w3doxdat, w3kind, w3movdat implicit none diff --git a/physics/Radiation/radiation_astronomy.f b/physics/Radiation/radiation_astronomy.f index b25c89a8c..a21040938 100644 --- a/physics/Radiation/radiation_astronomy.f +++ b/physics/Radiation/radiation_astronomy.f @@ -75,9 +75,9 @@ !> \brief This module sets up astronomical quantities for solar radiation !! calculations. !! -!! Operational GFS selection for Solar constant value -!! (namelist control parameter - \b ISOL = 2) -!! \n ISOL=0: presribed value = 1366 \f$W m^{-2}\f$ (old) +!! Operational GFS selection for Solar constant value +!! (namelist control parameter - \b ISOL = 2) +!! \n ISOL=0: presribed value = 1366 \f$W m^{-2}\f$ (old) !! \n ISOL=10: prescibed value = 1361 \f$W m^{-2}\f$ (new) !! \n ISOL=1: NOAA old yearly solar constant table with 11-year cycle (range: 1944-2006) !! \n ISOL=2: NOAA new yearly solar constant table with 11-year cycle (range: 1850-2019) @@ -86,10 +86,11 @@ !! \version NCEP-Radiation_astronomy v5.2 Jan 2013 !> This module sets up astronomy quantities for solar radiation calculations. - module module_radiation_astronomy + module module_radiation_astronomy ! - use machine, only : kind_phys + use machine, only : kind_phys use module_iounitdef, only : NIRADSF + use w3emc, only : iw3jdn, w3fs26 ! implicit none ! @@ -196,7 +197,7 @@ subroutine sol_init & degrad = 180.0/con_pi tpi = 2.0 * con_pi hpi = 0.5 * con_pi - pid12 = con_pi/f12 + pid12 = con_pi/f12 ! --- initialization isolflg = isolar @@ -400,7 +401,6 @@ subroutine sol_update & real (kind=kind_phys) :: fjd, fjd1, dlt, r1, alp integer :: jd, jd1, iyear, imon, iday, ihr, imin, isec - integer :: iw3jdn integer :: i, iyr, iyr1, iyr2, jyr, nn, nswr, icy1, icy2, icy logical :: file_exist @@ -901,7 +901,7 @@ subroutine coszmn & coszdg(i) = coszen(i) * rstp if (istsun(i) > 0 .and. coszen(i) /= 0.0_kind_phys) then coszen(i) = coszen(i) / istsun(i) - endif + endif enddo ! return diff --git a/physics/SFC_Layer/UFS/module_nst_water_prop.f90 b/physics/SFC_Layer/UFS/module_nst_water_prop.f90 index 858659e90..edb798c37 100644 --- a/physics/SFC_Layer/UFS/module_nst_water_prop.f90 +++ b/physics/SFC_Layer/UFS/module_nst_water_prop.f90 @@ -8,6 +8,7 @@ module module_nst_water_prop use machine , only : kind_phys use module_nst_parameters , only : t0k, zero, one, half + use w3emc, only : iw3jdn implicit none ! @@ -544,7 +545,6 @@ subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) !$$$ ! integer :: jyr,jmnth,jday,jhr,jmn,jd - integer :: iw3jdn real (kind=kind_phys) fjd jd=iw3jdn(jyr,jmnth,jday) if(jhr.lt.12) then diff --git a/physics/photochem/h2ointerp.f90 b/physics/photochem/h2ointerp.f90 index f5a1f36c6..711c1d54a 100644 --- a/physics/photochem/h2ointerp.f90 +++ b/physics/photochem/h2ointerp.f90 @@ -6,7 +6,7 @@ !> This module contains subroutines of reading and interpolating !! h2o coefficients. module h2ointerp - + use w3emc, only: w3doxdat, w3kind, w3movdat implicit none private diff --git a/physics/tools/w3emc.F90 b/physics/tools/w3emc.F90 new file mode 100644 index 000000000..58bcf23a3 --- /dev/null +++ b/physics/tools/w3emc.F90 @@ -0,0 +1,343 @@ +module w3emc + use machine, only: kind_sngl_prec, kind_dbl_prec + implicit none + public :: w3fs26 + + interface w3difdat + module procedure :: w3difdat32 + module procedure :: w3difdat64 + end interface w3difdat + + interface w3movdat + module procedure :: w3movdat32 + module procedure :: w3movdat64 + end interface w3movdat + + interface w3reddat + module procedure :: w3reddat32 + module procedure :: w3reddat64 + end interface w3reddat + +contains + + ! @brief Computes julian day number from year (4 digits), month, and day. + ! @author Ralph Jones @date 1987-03-29 + ! Computes julian day number from year (4 digits), month, + ! and day. iw3jdn is valid for years 1583 a.d. to 3300 a.d. + ! Julian day number can be used to compute day of week, day of + ! year, record numbers in an archive, replace day of century, + ! find the number of days between two dates. + ! @param[in] IYEAR Integer year (4 Digits) + ! @param[in] MONTH Integer month of year (1 - 12) + ! @param[in] IDAY Integer day of month (1 - 31) + ! @return IW3JDN Integer Julian day number + ! - Jan 1, 1960 is Julian day number 2436935 + ! - Jan 1, 1987 is Julian day number 2446797 + + ! @note Julian period was devised by joseph scaliger in 1582. + ! Julian day number #1 started on Jan. 1,4713 B.C. Three major + ! chronological cycles begin on the same day. A 28-year solar + ! cycle, a 19-year luner cycle, a 15-year indiction cycle, used + ! in ancient rome to regulate taxes. It will take 7980 years + ! to complete the period, the product of 28, 19, and 15. + ! scaliger named the period, date, and number after his father + ! Julius (not after the julian calendar). This seems to have + ! caused a lot of confusion in text books. Scaliger name is + ! spelled three different ways. Julian date and Julian day + ! number are interchanged. A Julian date is used by astronomers + ! to compute accurate time, it has a fraction. When truncated to + ! an integer it is called an Julian day number. This function + ! was in a letter to the editor of the communications of the acm + ! volume 11 / number 10 / october 1968. The Julian day number + ! can be converted to a year, month, day, day of week, day of + ! year by calling subroutine w3fs26. + ! @author Ralph Jones @date 1987-03-29 + function iw3jdn(iyear, month, iday) + integer, intent(in) :: iyear, month, iday + integer :: iw3jdn + iw3jdn = iday - 32075 & + + 1461 * (iyear + 4800 + (month - 14) / 12) / 4 & + + 367 * (month - 2 - (month -14) / 12 * 12) / 12 & + - 3 * ((iyear + 4900 + (month - 14) / 12) / 100) / 4 + end function iw3jdn + + + + !> @brief Return the real kind and integer kind used in w3 lib. + !> @author Jun Wang @date 2011-06-24 + !> This subprogram returns the real kind and the integer kind that the w3 lib + !> is compiled with. + !> @param[out] KINDREAL Kind of real number in w3 lib + !> @param[out] KINDINT Kind of integer number in w3 lib + !> + !> @author Jun Wang @date 2011-06-24 + subroutine w3kind(kindreal, kindint) + implicit none + integer,intent(out) :: kindreal,kindint + ! get real kind from a real number + kindreal=kind(1.0) + kindint=kind(1) + end subroutine w3kind + + + !> @brief Returns the integer day of week, the day + !> of year, and julian day given an NCEP absolute date and time. + !> @author Mark Iredell @date 1998-01-05 + + !> @param[in] IDAT Integer (8) NCEP absolute date and time + !> (year, month, day, time zone, hour, minute, second, millisecond) + !> @param[out] JDOW Integer day of week (1-7, where 1 is sunday) + !> @param[out] JDOY Integer day of year (1-366, where 1 is january 1) + !> @param[out] JDAY Integer julian day (day number from jan. 1,4713 b.c.) + !> + !> @author Mark Iredell @date 1998-01-05 + subroutine w3doxdat(idat, jdow, jdoy, jday) + integer :: idat(8), jdow, jdoy, jday + integer :: jy, jm, jd + + ! get julian day and then get day of week and day of year + jday=iw3jdn(idat(1), idat(2), idat(3)) + call w3fs26(jday, jy, jm, jd, jdow, jdoy) + end subroutine w3doxdat + + + !> @brief Return a time interval between two dates. + !> @author Mark Iredell @date 1998-01-05 + !> Returns the elapsed time interval from + !> an NCEP absolute date and time given in the second argument until + !> an NCEP absolute date and time given in the first argument. + !> The output time interval is in one of seven canonical forms + !> of the ncep relative time interval data structure. + !> @param[in] JDAT Integer (8) ncep absolute date and time + !> (year, month, day, time zone, hour, minute, second, millisecond) + !> @param[in] IDAT Integer (8) ncep absolute date and time + !> (year, month, day, time zone, hour, minute, second, millisecond) + !> @param[in] IT Integer relative time interval format type + !> (-1 for first reduced type (hours always positive), + !> 0 for second reduced type (hours can be negative), + !> 1 for days only, 2 for hours only, 3 for minutes only, + !> 4 for seconds only, 5 for milliseconds only) + !> @param[out] RINC Real (5) ncep relative time interval + !> (days, hours, minutes, seconds, milliseconds) + !> (time interval is positive if jdat is later than idat.) + !> + !> @author Mark Iredell @date 1998-01-05 + subroutine w3difdat32(jdat, idat, it, rinc) + integer :: it + integer :: jdat(8),idat(8) + real(kind_sngl_prec) :: rinc(5) + real(kind_sngl_prec) :: rinc1(5) + + ! difference the days and time and put into canonical form + rinc1(1)=iw3jdn(jdat(1),jdat(2),jdat(3)) - & + iw3jdn(idat(1),idat(2),idat(3)) + rinc1(2:5)=jdat(5:8)-idat(5:8) + call w3reddat(it,rinc1,rinc) + end subroutine w3difdat32 + + subroutine w3difdat64(jdat, idat, it, rinc) + integer :: it + integer :: jdat(8),idat(8) + real(kind_dbl_prec) :: rinc(5) + real(kind_dbl_prec) :: rinc1(5) + + ! difference the days and time and put into canonical form + rinc1(1)=iw3jdn(jdat(1),jdat(2),jdat(3)) - & + iw3jdn(idat(1),idat(2),idat(3)) + rinc1(2:5)=jdat(5:8)-idat(5:8) + call w3reddat(it,rinc1,rinc) + end subroutine w3difdat64 + + + + ! @brief Year, month, day from julian day number + ! @author Ralph Jones @date 1987-03-29 + subroutine w3fs26(jldayn, iyear, month, iday, idaywk, idayyr) + integer :: jldayn, iyear, month, iday, idaywk, idayyr + integer :: i, j, l + real :: n + l = jldayn + 68569 + n = 4 * l / 146097 + l = l - (146097 * n + 3) / 4 + i = 4000 * (l + 1) / 1461001 + l = l - 1461 * i / 4 + 31 + j = 80 * l / 2447 + iday = l - 2447 * j / 80 + l = j / 11 + month = j + 2 - 12 * l + iyear = 100 * (n - 49) + i + l + idaywk = mod((jldayn + 1),7) + 1 + idayyr = jldayn - & + (-31739 +1461 * (iyear+4799) / 4 - 3 * ((iyear+4899)/100)/4) + end subroutine w3fs26 + + !> @file + !> @brief Reduce a time interval to a canonical form. + !> @author Mark Iredell @date 1998-01-05 + !> ### Program History Log: + !> Date | Programmer | Comment + !> -----|------------|-------- + !> 1998-01-05 | Mark Iredell | Initial. + !> + !> @param[in] IT Relative time interval format type + !> - (-1 for first reduced type (hours always positive), + !> - 0 for second reduced type (hours can be negative), + !> - 1 for days only, 2 for hours only, 3 for minutes only, + !> - 4 for seconds only, 5 for milliseconds only) + !> @param[in] RINC NCEP relative time interval (days, hours, minutes, seconds, + !> milliseconds) + !> @param[out] DINC NCEP relative time interval (days, hours, minutes, + !> seconds, milliseconds) + !> + !> @author Mark Iredell @date 1998-01-05 + subroutine w3reddat32(it, rinc, dinc) + integer :: it + real(kind_sngl_prec) :: rinc(5), dinc(5) + ! parameters for number of units in a day + ! and number of milliseconds in a unit + ! and number of next smaller units in a unit, respectively + integer, dimension(5), parameter :: itd=(/1,24,1440,86400,86400000/), & + itm=itd(5)/itd + integer, dimension(4), parameter :: itn=itd(2:5)/itd(1:4) + integer, parameter :: np=16 + integer :: iinc(4), jinc(5), kinc(5) + integer :: ms + + ! first reduce to the first reduced form + iinc=floor(rinc(1:4)) + ! convert all positive fractional parts to milliseconds + ! and determine canonical milliseconds + jinc(5)=nint(dot_product(rinc(1:4)-iinc,real(itm(1:4)))+rinc(5)) + kinc(5)=modulo(jinc(5),itn(4)) + ! convert remainder to seconds and determine canonical seconds + jinc(4)=iinc(4)+(jinc(5)-kinc(5))/itn(4) + kinc(4)=modulo(jinc(4),itn(3)) + ! convert remainder to minutes and determine canonical minutes + jinc(3)=iinc(3)+(jinc(4)-kinc(4))/itn(3) + kinc(3)=modulo(jinc(3),itn(2)) + ! convert remainder to hours and determine canonical hours + jinc(2)=iinc(2)+(jinc(3)-kinc(3))/itn(2) + kinc(2)=modulo(jinc(2),itn(1)) + ! convert remainder to days and compute milliseconds of the day + kinc(1)=iinc(1)+(jinc(2)-kinc(2))/itn(1) + ms=dot_product(kinc(2:5),itm(2:5)) + + ! next reduce to either single value canonical form + ! or to one of the two reduced forms + if(it.ge.1.and.it.le.5) then + ! ensure that exact multiples of 1./np dinc(it)=real(kinc(1))*itd(it)+rp/np + else + ! the reduced form is done except the second reduced form is modified + ! for negative time intervals with fractional days + dinc=kinc + if(it.eq.0.and.kinc(1).lt.0.and.ms.gt.0) then + dinc(1)=dinc(1)+1 + dinc(2:5)=mod(ms-itm(1),itm(1:4))/itm(2:5) + endif + endif + end subroutine w3reddat32 + + subroutine w3reddat64(it, rinc, dinc) + integer :: it + real(kind_dbl_prec) :: rinc(5), dinc(5) + ! parameters for number of units in a day + ! and number of milliseconds in a unit + ! and number of next smaller units in a unit, respectively + integer, dimension(5), parameter :: itd=(/1,24,1440,86400,86400000/), & + itm=itd(5)/itd + integer, dimension(4), parameter :: itn=itd(2:5)/itd(1:4) + integer, parameter :: np=16 + integer :: iinc(4), jinc(5), kinc(5) + integer :: ms + + ! first reduce to the first reduced form + iinc=floor(rinc(1:4)) + ! convert all positive fractional parts to milliseconds + ! and determine canonical milliseconds + jinc(5)=nint(dot_product(rinc(1:4)-iinc,real(itm(1:4)))+rinc(5)) + kinc(5)=modulo(jinc(5),itn(4)) + ! convert remainder to seconds and determine canonical seconds + jinc(4)=iinc(4)+(jinc(5)-kinc(5))/itn(4) + kinc(4)=modulo(jinc(4),itn(3)) + ! convert remainder to minutes and determine canonical minutes + jinc(3)=iinc(3)+(jinc(4)-kinc(4))/itn(3) + kinc(3)=modulo(jinc(3),itn(2)) + ! convert remainder to hours and determine canonical hours + jinc(2)=iinc(2)+(jinc(3)-kinc(3))/itn(2) + kinc(2)=modulo(jinc(2),itn(1)) + ! convert remainder to days and compute milliseconds of the day + kinc(1)=iinc(1)+(jinc(2)-kinc(2))/itn(1) + ms=dot_product(kinc(2:5),itm(2:5)) + + ! next reduce to either single value canonical form + ! or to one of the two reduced forms + if(it.ge.1.and.it.le.5) then + ! ensure that exact multiples of 1./np dinc(it)=real(kinc(1))*itd(it)+rp/np + else + ! the reduced form is done except the second reduced form is modified + ! for negative time intervals with fractional days + dinc=kinc + if(it.eq.0.and.kinc(1).lt.0.and.ms.gt.0) then + dinc(1)=dinc(1)+1 + dinc(2:5)=mod(ms-itm(1),itm(1:4))/itm(2:5) + endif + endif + end subroutine w3reddat64 + + + !> @file + !> @brief Return a date from a time interval and date + !> @author Mark Iredell @date 1998-08-01 + !> This subprogram returns the date and time that is a given + !> NCEP relative time interval from an NCEP absolute date and time. + !> The output is in the NCEP absolute date and time data structure. + !> + !> ### Program History Log: + !> Date | Programmer | Comment + !> -----|------------|-------- + !> 1998-01-05 | Mark Iredell | Initial. + !> + !> @param[in] RINC NCEP relative time interval (days, hours, minutes, seconds + !> milliseconds) + !> @param[in] IDAT NCEP absolute date and time (year, month, day, time zone, + !> hour, minute, second, millisecond) + !> @param[in] JDAT NCEP absolute date and time (year, month, day, time zone, + !> hour, minute, second, millisecond) (jdat is later than idat if time + !> interval is positive.) + !> + !> @author Mark Iredell @date 1998-08-01 + subroutine w3movdat32(rinc, idat, jdat) + real(kind_sngl_prec) :: rinc(5) + integer :: idat(8), jdat(8), jdow, jdoy, jldayn + real(kind_sngl_prec) :: rinc1(5), rinc2(5) + + ! add the interval to the input time of day and put into reduced form + ! and then compute new date using julian day arithmetic. + rinc1(1)=rinc(1) + rinc1(2:5)=rinc(2:5)+idat(5:8) + call w3reddat(-1,rinc1,rinc2) + jldayn=iw3jdn(idat(1),idat(2),idat(3))+nint(rinc2(1)) + call w3fs26(jldayn,jdat(1),jdat(2),jdat(3),jdow,jdoy) + jdat(4)=idat(4) + jdat(5:8)=nint(rinc2(2:5)) + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + end subroutine w3movdat32 + + subroutine w3movdat64(rinc, idat, jdat) + real(kind_dbl_prec) :: rinc(5) + integer :: idat(8), jdat(8), jdow, jdoy, jldayn + real(kind_dbl_prec) :: rinc1(5), rinc2(5) + + ! add the interval to the input time of day and put into reduced form + ! and then compute new date using julian day arithmetic. + rinc1(1)=rinc(1) + rinc1(2:5)=rinc(2:5)+idat(5:8) + call w3reddat(-1,rinc1,rinc2) + jldayn=iw3jdn(idat(1),idat(2),idat(3))+nint(rinc2(1)) + call w3fs26(jldayn,jdat(1),jdat(2),jdat(3),jdow,jdoy) + jdat(4)=idat(4) + jdat(5:8)=nint(rinc2(2:5)) + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + end subroutine w3movdat64 + +end module w3emc