Subroutine dtcdatinc ! (Line,Incmod) c routine to add or subtract sidereal units (days, weeks, months or years) c incmod = 1 for day (in COMMON) c = 2 for week c = 3 for month c = 4 for year c format is c +nn or -nn : add/subtract nn default units c +/- nnu (u=d,w,m,y) to add/subt that unit c output in defdat include 'comdtc.inc/nolist' byte ln1, ll c ml is 14 long to allow refs out of bounds to l for no. days in month... integer l(12), ml(14) ! length of months - Dec, Jan ... Dec, Jan 1 /31, 31,28,31, 30,31,30, 31,31,30, 31,30,31, 31/ equivalence (l(1), ml(2)), (line, ln1) include 'stmtfunc.for/nolist' c Begin code l(2) = 28 ! Initialize (may have been changed below) isign=1 ! Called only if + or - is first char of LINE if (ln1 .eq. '-') 1 isign = -1 c now grab off digits... magn=0 ! Initialize magnitude of value do n = 2, icmln ll = line(n) if (.not. numeric(ll)) 1 go to 5 ! Exit first non-numeric magn = (magn * 10) + icvtbn1(ll) end do n = icmln ! This many numeric, no overflow??? 5 continue if (magn .eq. 0) 1 magn = 1 if (alpha(ll)) 1 then ll = ll .and. ucmask c scan for d,w,m,y for units if (ll .eq. 'D') 1 then incmod=1 else if (ll .eq. 'W') then incmod=2 else if (ll .eq. 'M') then incmod=3 else if (ll .eq. 'Y') then incmod=4 else n = n - 1 ! Don't strip one we didn't use: alpha end if else n = n - 1 ! Don't strip one we didn't use: non-alpha end if call shrink(n, ifnb, lnb) ! Shift LINE over c magn now has magnitude, isign has sign and incmod has type of increment. if (incmod .le. 2) 1 then inctyp = 1 c adjust weeks as being 7 * days and treat together if (incmod .eq. 2) 1 magn = magn * 7 else inctyp = incmod - 1 end if c inctyp is 1 for day or week, 2 for month, 3 for year if (inctyp .eq. 1) ! Moving by days 1 then iddy = iddy + (isign * magn) c loop point if we move forward 100 if (iddy .gt. l(idmo)) 1 then lyd = 0 c account for leap years where february is 29 days long... if (islpyr(ibigyr) .and. (idmo .eq. 2)) 1 lyd = 1 iddy = iddy - l(idmo) - lyd idmo = idmo + 1 if (idmo .gt. 12) 1 then idmo = 1 ibigyr = ibigyr + 1 end if goto 100 end if c loop point if we move back 110 if (iddy .le. 0) 1 then c account for leap years. note ml is prev month so check def mo = 3 lyd = 0 if (islpyr(ibigyr) .and. (idmo .eq. 3)) 1 lyd = 1 iddy = iddy + ml(idmo) + lyd idmo = idmo - 1 if (idmo .le. 0) 1 then idmo = 12 ibigyr = ibigyr - 1 end if goto 110 end if else if (inctyp .eq. 2) then ! moving by months idmo = idmo + (isign * magn) 200 if (idmo .gt. 12) 1 then idmo = idmo - 12 ibigyr = ibigyr + 1 goto 200 end if 300 if (idmo .le. 0) 1 then idmo = idmo + 12 ibigyr = ibigyr - 1 goto 300 end if else if (inctyp .eq. 3) then ibigyr = ibigyr + (isign * magn) end if if (inctyp .ge. 2) ! months or years 1 then ! Must check if we exceed month length if (islpyr(ibigyr)) 1 then l(2) = 29 else l(2) = 28 end if iddy = min0(iddy, l(idmo)) ! force last day of month, if necessary end if idyr = mod(ibigyr, 100) ! Restrict to current 'century' end