*
*       CHNGDO reads a syntactically correct EXTENDED FORTRAN program
*   (through F:111) and changes DO statements to prevent zero trip loops
*   so the program will produce same results on CP-6 ANSFORT as EXTENDED
*   FORTRAN did.  In other words, make all DO statements make at least one
*   pass though the loop even if terminating condition is satisfied
*   on the initial pass.  For instance, the statement:
*      DO 99 I=1,J
*   would be changed by CHNGDO to:
*      DO 99 I=1,MAX(1,J)
*
*   Sample run:
*      !SET F:111/extended-fortran-source
*      !SET F:112/cp6-ansfort-source;OUT
*      !SET F:108 ME
*      !CHNGDO.
*
*   NOTES:
*     1)  CHNGDO reads through F:111, writes the changed program through
*         F:112 and echoes the before and after DO statements through
*         F:108.  The ';OUT' must be included on the F:112 SET as in sample
*         above.
*
*     2)  Programs which run correctly on CP-V ANSFORT should NOT be run
*         through this program because CP-V ANSFORT supports zero trip
*         DO statements the same as CP-6.
*
*     3)  CHNGDO will NOT detect the following condition properly:
*           BEG= 80
*           END= 1
*           INCR= -1
*           DO 99 I=BEG,END,INCR
*         CHNGDO will change it to:
*           DO 99 I=BEG,MAX(BEG,END),INCR
*         when it should be:
*           DO 99 I=BEG,MIN(BEG,END),INCR
*
*     4)  CHNGDO will NOT handle continued DO statements
*
*     5)  CHNGDO will not change a statement whose parameters are all
*         numeric(Ex: DO 99 I=1,80,2)
*
*     6)  CHNGDO will NOT change implied DO statements.
*
      IMPLICIT INTEGER(A-Z)
      COMMON /STRINGS/ INSTRING, TMPSTR, OUTSTRNG
      CHARACTER*80 OUTSTRNG
      CHARACTER*90 INSTRING, TMPSTR
      INTEGER INCNT/0/, OUTCNT/0/
      GO TO 560
520   OUTSTRNG= INSTRING
530   WRITE(112,540) OUTSTRNG(1:OUTLEN)
540   FORMAT(A80)
      OUTCNT= OUTCNT+1
560   READ(111,540,END=870) INSTRING
      INCNT= INCNT+1
*
*   Skip comments and continue lines
*
      OUTLEN= LNGTH(INSTRING)
      IF (INSTRING(1:1) .EQ. 'C'  .OR.
     1    INSTRING(1:1) .EQ. '*'  .OR.
     2    INSTRING(6:6) .NE. ' ')  GO TO 520
*
*   Compress INSTRING creating TMPSTR getting rid of all blanks to
*   make compares much easier.
*
      CALL COMPRESS
      IF (TMPSTR(7:8) .NE. 'DO')  GO TO 520
      SRCINDX= 7
      CALL DODO(520S,740S,780S,820S)
      STOP '* RETURNED FROM CALL DODO *'
740   WRITE(5,750) INCNT,INSTRING
750   FORMAT(' * Unexpected end of line *'/
     1       I5,' Before: ',A80)
      GO TO 520
780   WRITE(5,790) INCNT, INSTRING
790   FORMAT(' * Statement should be continued *'/
     1       I5,' Before: ',A80)
      GO TO 520
820   WRITE(5,830) INCNT,INSTRING,OUTCNT+1,OUTSTRNG(1:OUTLEN)
830   FORMAT('0* Changed *'/
     1       I5,' Before: ',A80/
     2       I5,'  After: ',A80)
      GO TO 530
870   STOP '** EOF hit on F:111 **'
      END
      SUBROUTINE DODO(*,*,*,*,*)
*
*   Process statement beginning with 'DO':
*     We will:
*        RETURN 1 if statement isn't really a DO-LOOP
*        RETURN 2 if Unexpected end of line hit
*        RETURN 3 if statement should be continued
*
      IMPLICIT INTEGER(A-Z)
      COMMON /COMON/ LENGTH, SEMICNT, SRCINDX, INCNT, OUTLEN
      COMMON /STRINGS/ INSTRING, TMPSTR, OUTSTRNG
      CHARACTER*1  BYTE
      CHARACTER*80 OUTSTRNG, FIRST, SECOND, THIRD
      CHARACTER*90 INSTRING, TMPSTR
*
*   Skip numeric digits after 'DO'
*
      DO 230 I=SRCINDX+2,LENGTH
         BYTE= TMPSTR(I:I)
         IF (BYTE .LT. '0'  .OR.
     1       BYTE .GT. '9')  GO TO 350
230      CONTINUE
      OUTPUT ' ','* Nothing past nnn of "DOnnn"',INCNT
250   OUTLEN= LNGTH(INSTRING)
      RETURN 1
*
*   If I=SRCINDX+2 Then
*        there was no numeric digit(s) after the 'DO' which means
*        it is probably a variable beginning with 'DO'
*   Else Build what should be a do-loop index variable;  However,
*        If we fall through the loop;  it would appear we hit variable
*        of the form 'DOnnnxx'(Bummer!)
*
350   IF (I .EQ. SRCINDX+2)  GO TO 250
      SRCINDX= I
      DO 390 I=SRCINDX,LENGTH
         IF (TMPSTR(I:I) .EQ. '=')  GO TO 480
390      CONTINUE
      OUTPUT '* Expected ='
410   OUTLEN= LNGTH(INSTRING)
      RETURN 2
*
*   Find beginning parameter of DO statement by skipping everything
*   til next comma(making sure when comma is found that it is not
*   within parenthesis(Ex:  DO 1 I=A(1,3),B)
*
480   PARENS= FIRSTLN= SECONDLN= THIRDLN= 0
      SRCINDX= I+1
      DO 640 I=SRCINDX,LENGTH
         BYTE= TMPSTR(I:I)
         IF ((BYTE .GE. 'A'  .AND.
     1        BYTE .LE. 'Z')       .OR.
     2       (BYTE .GE. '0'  .AND.
     3        BYTE .LE. '9'))  GO TO 640
         IF (BYTE .NE. '(')  GO TO 590
         GO TO 640
590      IF (BYTE .NE. ')')  GO TO 620
         PARENS= PARENS-1
         GO TO 640
620      IF (BYTE .EQ. ','  .AND.
     1       PARENS .LE. 0)  GO TO 750
640      CONTINUE
*
*   If we fall through the above loop, it means someone is getting
*   very sneaky with their variable names.  Namely of the form:
*      DO123X= L
*   which looks like a DO LOOP until we find no comma after the L!
*
      GO TO 250
*
*   FIRST = b   of 'DO 99 I=b,e,i'
*
750   FIRST= TMPSTR(SRCINDX:I-1)
      FIRSTLN= LNGTH(FIRST)
      SRCINDX= SECSTRT= I+1
      DO 920 I=SRCINDX,LENGTH
         BYTE= TMPSTR(I:I)
         IF ((BYTE .GE. 'A'  .AND.
     1        BYTE .LE. 'Z')      .OR.
     2       (BYTE .GE. '0'  .AND.
     3        BYTE .LE. '9'))  GO TO 920
         IF (BYTE .NE. '(')  GO TO 870
         PARENS= PARENS+1
         GO TO 920
870      IF (BYTE .NE. ')')  GO TO 900
         PARENS= PARENS-1
         GO TO 920
900      IF (BYTE .EQ. ','  .AND.
     1       PARENS .LE. 0)  GO TO 940
920      CONTINUE
      I= LENGTH+1
940   IF (PARENS .NE. 0)  RETURN 3
      SECOND= TMPSTR(SECSTRT:I-1)
      IF ((SECOND(1:4) .EQ. 'MIN(')  .OR.
     1    (SECOND(1:4) .EQ. 'MAX('))  GO TO 250
      SECONDLN= LNGTH(SECOND)
      IF (I .GT. LENGTH)  GO TO 1190
      SRCINDX= THRDSTRT= I+1
      DO 1150 I=SRCINDX,LENGTH
         BYTE= TMPSTR(I:I)
         IF ((BYTE .GE. 'A'  .AND.
     1        BYTE .LE. 'Z')       .OR.
     2       (BYTE .GE. '0'  .AND.
     3        BYTE .LE. '9'))  GO TO 1150
         IF (BYTE .NE. '(')  GO TO 1100
         GO TO 1150
1100     IF (BYTE .NE. ')')  GO TO 1130
         PARENS= PARENS-1
         GO TO 1150
1130     IF (BYTE .EQ. ','  .AND.
     1       PARENS .LE. 0)  GO TO 1170
1150     CONTINUE
      I= LENGTH+1
1170  THIRD= TMPSTR(THRDSTRT:I-1)
      THIRDLN= LNGTH(THIRD)
1190  CALL ISITNUM(FIRST,FIRSTLN,ANS1)
      CALL ISITNUM(SECOND,SECONDLN,ANS2)
      IF (ANS1+ANS2 .NE. 2)  GO TO 1240
      OUTSTRNG= INSTRING
1230  RETURN 4
1240  CALL FINDCORR(INSTRING,7,SECSTRT,7,OUTLEN)
      OUTLEN= OUTLEN-1
      OUTSTRNG(1:OUTLEN)= INSTRING(1:OUTLEN)
      MAXLOC= OUTLEN+2
      OUTSTRNG(OUTLEN+1:OUTLEN+4)= 'MAX('
      OUTLEN= OUTLEN+5
      OUTSTRNG(OUTLEN:OUTLEN+FIRSTLN-1)= FIRST(1:FIRSTLN)
      OUTLEN= OUTLEN+FIRSTLN
      OUTSTRNG(OUTLEN:OUTLEN)= ','
      OUTSTRNG(OUTLEN+1:OUTLEN+SECONDLN)= SECOND(1:SECONDLN)
      OUTLEN= OUTLEN+SECONDLN+1
      OUTSTRNG(OUTLEN:OUTLEN)= ')'
      IF (THIRDLN .LE. 0)  GO TO 1230
      OUTLEN= OUTLEN+1
      CALL ISITNUM(THIRD,THIRDLN,ANS3)
      OUTSTRNG(OUTLEN:OUTLEN)= ','
      OUTSTRNG(OUTLEN+1:OUTLEN+THIRDLN)= THIRD(1:THIRDLN)
      OUTLEN= OUTLEN+THIRDLN+1
      IF (THIRD(1:1) .EQ. '-')  OUTSTRNG(MAXLOC:MAXLOC+1)= 'IN'
      GO TO 1230
      END
      SUBROUTINE ISITNUM(STRING,LENGTH,ANSWER)
*
*   See if 'STRING' is numeric(ignoring trailing blanks)
*
*     Return:
*        ANSWER=0  means not numeric
*        ANSWER=1  means numeric
*
      IMPLICIT INTEGER(A-Z)
      CHARACTER*(*) STRING
      ANSWER= 0
      DO 150 I=1,LENGTH
         IF (STRING(I:I) .LT. '0')  RETURN
         IF (STRING(I:I) .GT. '9')  RETURN
150      CONTINUE
      ANSWER= 1
      RETURN
      END
      FUNCTION LNGTH(STRING)
*
*   Return length of string, searching from end of string left until
*   either a non-blank is found or beginning of string is hit.
*
      CHARACTER*(*) STRING
      DO 90 LNGTH= LEN(STRING),1,-1
         IF (STRING(LNGTH:LNGTH) .NE. ' ')  RETURN
90       CONTINUE
      LNGTH= 0
      RETURN
      END
      SUBROUTINE FINDCORR(STRING,CURCMPTR,DESCMPTR,CURUNPTR,NEWUNPTR)
*
*   Find corresponding position in uncompressed string as in the
*   compressed string.
*
      IMPLICIT INTEGER(A-Z)
      CHARACTER*(*) STRING
      NBYTES= DESCMPTR-CURCMPTR+1
      DO 130 PTR=CURUNPTR,32767
         IF (STRING(PTR:PTR) .EQ. ' ')  GO TO 130
         NBYTES= NBYTES-1
         IF (NBYTES .LE. 0)  GO TO 160
130      CONTINUE
      OUTPUT '* Fell thru loop in FINDCORR',PTR,CURCMPTR,DESCMPTR
      OUTPUT CURUNPTR,NEWUNPTR
160   NEWUNPTR= PTR
      RETURN
      END
      SUBROUTINE COMPRESS
*
*   Create TMPSTR by eliminating all blanks between columns 7-72
*   of INSTRING.
*
      IMPLICIT INTEGER(A-Z)
      COMMON /COMON/ LENGTH, SEMICNT, SRCINDX, INCNT, OUTLEN
      COMMON /STRINGS/ INSTRING, TMPSTR, OUTSTRNG
      CHARACTER*1  BYTE
      CHARACTER*80 OUTSTRNG
      CHARACTER*90 INSTRING, TMPSTR
      SEMICNT= 0
      LENGTH= 6
      QUOTESWT= -1
      TMPSTR(1:6)= INSTRING(1:6)
      DO 260 SRCINDX=7,72
         BYTE= INSTRING(SRCINDX:SRCINDX)
         IF (BYTE .EQ. ' ')  GO TO 260
         LENGTH= LENGTH+1
         TMPSTR(LENGTH:LENGTH)= BYTE
     pH
         QUOTESWT= -QUOTESWT
         GO TO 260
240      IF (BYTE .NE. ';')  GO TO 260
         IF (QUOTESWT .LE. 0)  SEMICNT= SEMICNT+1
260      CONTINUE
      RETURN
      END

