Subroutine TIMINC(Line,Incmod) C ROUTINE TO ADD OR SUBTRACT TIME BYTE LINE(84) INTEGER INCMOD C INCMOD = 1 FOR DAY 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 INTEGER IDYR,IDMO,IDDY COMMON/DEFDAT/IDYR,IDMO,IDDY C OUTPUT IN DEFDAT INTEGER ML(14) C LENGTH OF MONTHS INTEGER L(12) EQUIVALENCE(L(1),ML(2)) DATA ML/31,31,28,31,30,31,30,31,31,30,31,30,31,31/ C ML IS 14 LONG TO ALLOW REFS OUT OF BOUNDS TO L FOR NO. C DAYS IN MONTH... ISIGN=1 IF(LINE(1).EQ.'-')ISIGN=-1 C SQUASH LINE DOWN AND MAKE SURE UPPER CASE DO 1 N=1,83 LL=LINE(N+1) IF(LL.GT.97)LL=LL-32 1 LINE(N)=LL LINE(84)=0 C SCAN FOR D,W,M,Y FOR UNITS DO 2 N=1,80 IF(LINE(N).EQ.'D')THEN INCMOD=1 LINE(N)=0 GOTO 3 ELSE IF (LINE(N).EQ.'W')THEN INCMOD=2 LINE(N)=0 GOTO 3 ELSE IF (LINE(N).EQ.'M')THEN INCMOD=3 LINE(N)=0 GOTO 3 ELSE IF (LINE(N).EQ.'Y')THEN INCMOD=4 LINE(N)=0 GOTO 3 END IF 2 CONTINUE 3 CONTINUE C NOW GRAB OFF DIGITS... MAGN=0 C MAGN GETS MAGNITUDE TO GRAB DO 4 N=1,80 LL=LINE(N) IF(LL.EQ.32)GOTO 4 IF(LL.GE.48.AND.LL.LE.57) THEN MAGN=10*MAGN+(LL-48) ELSE GOTO 5 END IF 4 CONTINUE 5 CONTINUE IF(MAGN.EQ.0)MAGN=1 C MAGN NOW HAS MAGNITUDE, ISIGN HAS SIGN AND INCMOD HAS TYPE OF C INCREMENT. IF(INCMOD.LE.2) THEN INCTYP=1 ELSE INCTYP=INCMOD-1 END IF C INCTYP IS 1 FOR DAY OR WEEK, 2 FOR MONTH, 3 FOR YEAR IF(INCMOD.EQ.2)MAGN=MAGN*7 C ADJUST WEEKS AS BEING 7 * DAYS AND TREAT TOGETHER IF(INCTYP.EQ.1)THEN IDDY=IDDY+ISIGN*MAGN C LOOP POINT IF WE MOVE FORWARD 100 IF(IDDY.GT.L(IDMO)) THEN LYD=0 C ACCOUNT FOR LEAP YEARS WHERE FEBRUARY IS 29 DAYS LONG... IF(4*(IDYR/4).EQ.IDYR.AND.IDMO.EQ.2)LYD=1 IDDY=IDDY-L(IDMO)-LYD IDMO=IDMO+1 IF(IDMO.GT.12)THEN IDMO=1 IDYR=IDYR+1 END IF GOTO 100 END IF C LOOP POINT IF WE MOVE BACK 110 IF(IDDY.LE.0)THEN C ACCOUNT FOR LEAP YEARS. NOTE ML IS PREV MONTH SO CHECK DEF MO=3 LYD=0 IF(4*(IDYR/4).EQ.IDYR.AND.IDMO.EQ.3)LYD=1 IDDY=IDDY+ML(IDMO)+LYD IDMO=IDMO-1 IF(IDMO.LE.0)THEN IDMO=12 IDYR=IDYR-1 END IF GOTO 110 END IF ELSE IF(INCTYP.EQ.2)THEN IDMO=IDMO+ISIGN*MAGN 200 IF(IDMO.GT.12)THEN IDMO=IDMO-12 IDYR=IDYR+1 GOTO 200 END IF 300 IF(IDMO.LE.0)THEN IDMO=IDMO+12 IDYR=IDYR-1 GOTO 300 END IF ELSE IF(INCTYP.EQ.3)THEN IDYR=IDYR+ISIGN*MAGN END IF RETURN END