********************************************************************** * * * FLOW CHART GENERATOR * * * * Version 1.04 * * ReRelese: H281226 * * * ********************************************************************** * * C *---+----1----+----2----+----3----+----4----+----5----+----6----+----7-> C INTEGER MAXSUB , MINSUB , MAXSTR , MAXLAY C PARAMETER ( MAXSUB=100, MINSUB=0, MAXSTR=10, MAXLAY=5 ) C INTEGER SUBLEN(MINSUB:MAXSUB) , CALSUB(MINSUB:MAXSUB) INTEGER CALNAM(MINSUB:MAXSUB,MINSUB:MAXSUB) CHARACTER SUBNAM(MINSUB:MAXSUB)*10 C DO 1000 I=MINSUB,MAXSUB SUBLEN(I) = 0 CALSUB(I) = 0 SUBNAM(I) = ' ' DO 1100 J=MINSUB,MAXSUB CALNAM(J,I) = 0 1100 CONTINUE 1000 CONTINUE C CALL READTX( SUBNAM, SUBLEN, CALSUB, CALNAM, MAXSUB, MAXSTR, & MINSUB, MAXLAY ) C CALL PRNFLW( SUBNAM, SUBLEN, CALSUB, CALNAM, MAXSUB, MAXSTR, & MINSUB, MAXLAY ) C STOP END C C C ************************************* * R E A D T X * ************************************* C SUBROUTINE READTX(SUBNAM, SUBLEN, CALSUB, CALNAM, MAXSUB, & MAXSTR, MINSUB, MAXLAY ) C INTEGER MAXSUB , MAXSTR , SUBPOS , LINCNT , CUTSTA , STRPIT INTEGER SUBCNT , TOTSUB , CALCNT , LOPCNT , MINSUB INTEGER MAXLAY , ERRNUM INTEGER SUBLEN(MINSUB:MAXSUB) , CALSUB(MINSUB:MAXSUB) INTEGER CALNAM(MINSUB:MAXSUB,MINSUB:MAXSUB) CHARACTER SUBNAM(MINSUB:MAXSUB)*10 CHARACTER LINSTR*72 , KEYWD1*10, KEYWD2*4 , SUBSTR*10 CHARACTER SPACEC*1 INTEGER ICOM , NCOM PARAMETER (NCOM = 2) CHARACTER COMMENT(NCOM)*1 DATA COMMENT/'C','*'/ C KEYWD1 = 'SUBROUTINE' KEYWD2 = 'CALL' SPACEC = ' ' LINCNT = 1 CALSUB(0) = 0 SUBLEN(1) = 1 SUBNAM(0) = ' ' SUBNAM(1) = 'MAIN ' SUBCNT = 2 CALSUB(0) = 0 C OPEN(15,STATUS='SCRATCH') C 1000 READ( 5, '(A72)', ERR=1999 , END=1900 ) LINSTR CALL UPPER(LINSTR) WRITE(15,'(A72)') LINSTR DO 1001 ICOM=1,NCOM IF ( LINSTR(1:1) .EQ. COMMENT(ICOM) ) GOTO 1100 1001 CONTINUE SUBPOS=INDEX( LINSTR, KEYWD1) IF ( SUBPOS .NE. 0 ) THEN DO 1200 STRPIT=1,SUBPOS-1 IF ( LINSTR(STRPIT:STRPIT) .NE. SPACEC ) GOTO 1100 1200 CONTINUE CUTSTA=SUBPOS+10 CALL CUTNAM( CUTSTA, LINSTR, SUBSTR ) SUBNAM(SUBCNT) = SUBSTR SUBLEN(SUBCNT) = LINCNT SUBCNT = SUBCNT + 1 IF ( SUBCNT .GT. MAXSUB ) THEN ERRNUM=1 CALL PRNERR( ERRNUM ) END IF END IF 1100 LINCNT = LINCNT + 1 GOTO 1000 C 1900 REWIND ( 15, ERR=1998 ) C SUBLEN(SUBCNT) = LINCNT TOTSUB = SUBCNT - 1 C LINCNT = 1 SUBCNT = 1 CALCNT = 1 C 2000 READ( 15, '(A72)', END=2999 ) LINSTR IF ( LINCNT .GE. SUBLEN(SUBCNT+1)) THEN CALSUB(SUBCNT) = CALCNT -1 SUBCNT = SUBCNT + 1 IF ( SUBCNT .GT. MAXSUB ) THEN ERRNUM=1 CALL PRNERR( ERRNUM ) END IF CALCNT = 1 END IF DO 2001 ICOM=1,NCOM IF ( LINSTR(1:1) .EQ. COMMENT(ICOM) ) GOTO 2100 2001 CONTINUE SUBPOS=INDEX( LINSTR, KEYWD2) IF ( SUBPOS .NE. 0 ) THEN CUTSTA=SUBPOS+4 CALL CUTNAM( CUTSTA, LINSTR, SUBSTR ) DO 2300 LOPCNT=2,TOTSUB IF ( SUBSTR .EQ. SUBNAM(LOPCNT) ) THEN CALNAM( SUBCNT, CALCNT ) = LOPCNT CALCNT = CALCNT + 1 IF ( CALCNT .GT. MAXSUB ) THEN ERRNUM=1 CALL PRNERR( ERRNUM ) END IF GOTO 2100 END IF 2300 CONTINUE IF ( LOPCNT .EQ. TOTSUB ) THEN WRITE ( 6, *) '[ERROR]-> UNDEFIND SUBROUTINE CALL' WRITE ( 6, *) '[NAME]-->',SUBSTR,'[LINE]-->',LINCNT END IF END IF 2100 LINCNT=LINCNT+1 GOTO 2000 C 2999 CONTINUE C WRITE ( 6, '(75(1H*))' ) WRITE ( 6, * ) ' ' C DO 3000 LOPCNT=1,TOTSUB WRITE ( 6, 3010) LOPCNT,SUBNAM(LOPCNT),SUBLEN(LOPCNT), & SUBLEN(LOPCNT+1)-1,CALSUB(LOPCNT) 3010 FORMAT ( 1H ,'[',I3,'] ',A10,' {',I5,' - ',I5,'} (',I2,')') DO 3100 CALCNT=1,CALSUB(LOPCNT) WRITE( 6, 3020) CALCNT,SUBNAM(CALNAM(LOPCNT,CALCNT)), & SUBLEN(CALNAM(LOPCNT,CALCNT)) 3020 FORMAT ( 1H ,' [',I3,'] ',A10,' {',I5,'}') 3100 CONTINUE WRITE ( 6, *) ' ' 3000 CONTINUE C WRITE ( 6, '(75(1H*))' ) C RETURN C 1998 ERRNUM = 4 CALL PRNERR( ERRNUM ) C 1999 ERRNUM = 3 CALL PRNERR( ERRNUM ) C END C C ************************************* * P R N F L W * ************************************* C SUBROUTINE PRNFLW(SUBNAM, SUBLEN, CALSUB, CALNAM, MAXSUB, & MAXSTR, MINSUB, MAXLAY ) C INTEGER MAXSUB , MAXSTR , MINSUB , MAXLAY , ERRNUM INTEGER CULYFG , PTLYFG , LAYCNT , CULYCA , CURLAY INTEGER SUBLEN(MINSUB:MAXSUB) , CALSUB(MINSUB:MAXSUB) INTEGER CALNAM(MINSUB:MAXSUB,MINSUB:MAXSUB) INTEGER LYSBCA( 5 ) , LYSBNA( 5 ) CHARACTER SUBNAM(MINSUB:MAXSUB)*10 CHARACTER NAMPTN(5)*7 , LINPTN(2)*15 CHARACTER NAMSTR(5)*15 , LINSTR(5)*15 DATA LYSBNA/5*0/ , LYSBCA/5*0/ C CURLAY = 1 LYSBNA(CURLAY) = 1 C NAMPTN(1) = ' --+-- ' NAMPTN(2) = ' +-- ' NAMPTN(3) = ' | ' NAMPTN(4) = ' ' NAMPTN(5) = ' ' C LINPTN(1) = ' | ' LINPTN(2) = ' ' C WRITE ( 6, * ) ' ' WRITE ( 6, 900 ) WRITE ( 6, * ) ' ' 900 FORMAT ('|<-----1----->||<-----2----->||<-----3----->|', & '|<-----4----->||<-----5----->|' ) C * LINE LOOP 1000 CURLAY = 1 C DO 1200 LAYCNT=1,MAXLAY IF ( LYSBCA(LAYCNT) .EQ. CALSUB(LYSBNA(LAYCNT)) ) THEN LYSBCA(LAYCNT) = 0 CALSUB(LYSBNA(LAYCNT)) = 0 END IF NAMSTR(LAYCNT) = ' ' LINSTR(LAYCNT) = ' ' 1200 CONTINUE C * LAYER LOOP 2000 CULYFG = 0 PTLYFG = 0 C IF ( CURLAY .GT. MAXLAY ) THEN ERRNUM = 2 CALL PRNERR( ERRNUM) END IF C CULYCA = CALSUB(LYSBNA(CURLAY)) C IF ( LYSBCA(CURLAY) .NE. 0 ) THEN CULYFG = 1 ELSE CULYFG = 0 END IF C IF ( CURLAY .LT. 5 ) THEN DO 2200 LAYCNT=CURLAY+1,MAXLAY IF ( LYSBCA(LAYCNT) .NE. 0 ) THEN PTLYFG = 1 GOTO 2300 END IF 2200 CONTINUE ELSE PTLYFG = 0 2300 END IF C * PATTERN [1] [4] C IF ( CULYFG .EQ. 0 .AND. PTLYFG .EQ. 0 ) THEN IF ( CULYCA .EQ. 0 ) THEN NAMSTR( CURLAY ) = SUBNAM( LYSBNA( CURLAY ))(1:8) & // NAMPTN(4) GOTO 2100 ELSE NAMSTR( CURLAY ) = SUBNAM( LYSBNA( CURLAY ))(1:8) & // NAMPTN(1) LYSBCA( CURLAY ) = LYSBCA ( CURLAY ) + 1 IF ( CURLAY .EQ. 5 ) THEN ERRNUM = 2 CALL PRNERR( ERRNUM ) END IF LYSBNA( CURLAY + 1 ) = & CALNAM( LYSBNA( CURLAY ), LYSBCA( CURLAY )) END IF END IF C * PATTERN [2] C IF ( CULYFG .EQ. 1 .AND. PTLYFG .EQ. 0 ) THEN NAMSTR( CURLAY ) = SUBNAM( 0 )(1:8) & // NAMPTN(2) LYSBCA( CURLAY ) = LYSBCA ( CURLAY ) + 1 IF ( CURLAY .EQ. 5 ) THEN ERRNUM = 2 CALL PRNERR( ERRNUM ) END IF LYSBNA( CURLAY + 1 ) = & CALNAM( LYSBNA( CURLAY ), LYSBCA( CURLAY )) END IF C * PATTERN [3] C IF ( CULYFG .EQ. 1 .AND. PTLYFG .EQ. 1 ) THEN NAMSTR( CURLAY ) = SUBNAM( 0 )(1:8) & // NAMPTN(3) END IF C * PATTERN [5] C IF ( CULYFG .EQ. 0 .AND. PTLYFG .EQ. 1 ) THEN NAMSTR( CURLAY ) = SUBNAM( 0 )(1:8) & // NAMPTN(5) END IF C IF ( CULYCA .EQ. LYSBCA(CURLAY) ) THEN LINSTR( CURLAY ) = LINPTN( 2 ) ELSE LINSTR( CURLAY ) = LINPTN( 1 ) END IF C CURLAY = CURLAY + 1 GOTO 2000 C * WRITE POINT 2100 WRITE ( 6, 2010 ) NAMSTR(1), NAMSTR(2), NAMSTR(3), & NAMSTR(4), NAMSTR(5) WRITE ( 6, 2010 ) LINSTR(1), LINSTR(2), LINSTR(3), & LINSTR(4), LINSTR(5) 2010 FORMAT (1H ,5A15) C DO 1100 LAYCNT=1,MAXLAY IF ( LYSBCA(LAYCNT) .NE. CALSUB(LYSBNA(LAYCNT)) ) GOTO 1000 1100 CONTINUE C WRITE( 6, 900 ) RETURN END C ************************************* * C U T N A M * ************************************* C SUBROUTINE CUTNAM(SUBPOS, LINSTR, SUBSTR) C INTEGER SUBPOS , CHACNT , STACUT , ENDCUT CHARACTER LINSTR*72 , SUBSTR*10 , SPACEC*1 , KAKKOC*1 CHARACTER LINCHA*1 C SPACEC = ' ' KAKKOC = '(' SUBCNT = 1 C DO 1000 CHACNT=SUBPOS,72 LINCHA=LINSTR(CHACNT:CHACNT) IF ( LINCHA .NE. SPACEC) GOTO 2000 1000 CONTINUE C 2000 STACUT = CHACNT C IF ( INDEX( LINSTR, KAKKOC ) .EQ. 0 ) THEN ENDCUT = STACUT + 6 ELSE ENDCUT = INDEX( LINSTR, KAKKOC ) - 1 ENDIF C IF (STACUT .LE. ENDCUT) THEN SUBSTR = LINSTR( STACUT : ENDCUT ) ELSE SUBSTR = ' ' END IF C 9999 RETURN END C C ************************************* * P R N E R R * ************************************* C SUBROUTINE PRNERR(ERRNUM) C INTEGER ERRNUM C IF ( ERRNUM .EQ. 1 ) THEN WRITE ( 6, * ) '[ERROR]-> TOO MANY SUBROUTINE CALL !!' STOP END IF C IF ( ERRNUM .EQ. 2 ) THEN WRITE ( 6, * ) '[ERROR]-> TOO MANY NESTING !!' STOP END IF C IF ( ERRNUM .EQ. 3 ) THEN WRITE ( 6, * ) '[ERROR]-> READ ERROR !!' STOP END IF C IF ( ERRNUM .EQ. 4 ) THEN WRITE ( 6, * ) '[ERROR]-> REWIND ERROR !!' STOP END IF C 1000 RETURN END C C ************************************* * U P P E R * ************************************* C SUBROUTINE UPPER(STR) C CHARACTER STR*(*) INTEGER CHACNT , SUBPOS CHARACTER UCHAR*26 , LCHAR*26 C DATA UCHAR /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ DATA LCHAR /'abcdefghijklmnopqrstuvwxyz'/ C DO 1000 CHACNT=1,LEN(STR) SUBPOS = INDEX(LCHAR , STR(CHACNT:CHACNT)) IF ( SUBPOS .NE. 0) STR(CHACNT:CHACNT) = UCHAR(SUBPOS:SUBPOS) 1000 CONTINUE RETURN END