#%A-RCB-0077-SL-19 LSTGEN -- TABLE GENERATOR FOR LST DEFINE EOF 1 DEFINE START -1 DEFINE NORM 0 DEFINE MAXNUMBS 5 DEFINE LUDI 1 DEFINE LUDO 2 DEFINE LUT 5 DEFINE NAMIN 'LSTTAB.DAT' DEFINE NAMOUT 'LSTTAB.FTN;1' DEFINE DECLAR 'LSTDCL.FTN;1' DEFINE OUTPUTDESCRIPTION UNIT=LUDO,TYPE='NEW',CARRIAGECONTROL='LIST' DEFINE CHARACTER LOGICAL*1 DEFINE SLASH '/' DEFINE ZERO "60 DEFINE EOS 0 DEFINE NEWLINE -2 DEFINE OUTPUT CALLOUTPUT DEFINE BEGIN CALLBEGIN DEFINE ENDUP CALLENDUP #%^ # Reads input file LSTTAB.DAT. Each input line has format: # nstate, func, next1, next2,... # where # nstate is the state number -- all states must be there, in order. # func is the function number # nexti are the state transitions -- maximum of 4 # # Writes output file LSTTAB.FTN containing a DATA statement. # Also writes output file LSTDCL.FTN containing a PARAMETER and a DIMENSION # statement. # # Errors: Missing state or state out of order. # INTEGER IA(MAXNUMBS); LOGICAL OK; DATA OK/.TRUE./ # BEGIN MEMORY = 0 # WHILE (INPUT(N,IA)~=EOF) [ MEMORY = MEMORY + 1 IF(N~=MEMORY) [ OK = .FALSE. IF (N>>MEMORY) [ I = N - 1 IF (I==MEMORY) [ WRITE(LUT,110) MEMORY 110 FORMAT(' LSTGEN: STATE',I4,' MISSING') ] ELSE [ WRITE(LUT,130) MEMORY,I 130 FORMAT(' LSTGEN: STATES',I4,' TO',I4,' MISSING') ] MEMORY = N ] ELSE [ WRITE(LUT,150) N 150 FORMAT(' LSTGEN: STATE',I4,' OUT OF ORDER') ] ] IF(OK) OUTPUT(N,IA) ] OUTPUT(N,IA) ENDUP(N) STOP ' -- FINISHED' END #%%A-RCB-0077-SL-19 LSTGEN -- FILE OPENING SUBROUTINE SUBROUTINEBEGIN # # Open files for state tables and write the beginning of the block # data program LSTTAB.FTN # OPEN (UNIT=LUDI,NAME=NAMIN,TYPE='OLD') OPEN (OUTPUTDESCRIPTION,NAME=NAMOUT) # CALL ERRSET(64,,.FALSE.,,.FALSE.) # WRITE (LUDO,10) 10 FORMAT (6X,'BLOCK DATA', /6X,'INCLUDE ''LSTDCL.FTN''', /6X,'COMMON /TABLE/ TABLE') RETURN END #%%A-RCB-0077-SL-19 LSTGEN -- INPUT ROUTINE INTEGER FUNCTION INPUT(N,IA) # INTEGER IA(MAXNUMBS) # # Returns first number on the line in N and the next 5 in IA. Value is EOF # when EOF encountered. Conversion errors are ignored, so arbitrary # comments may be inserted. Comments may also be inserted on the # same line, provided the line has MAXNUMBS+1 commas. The extra comma # is required to terminate the last number. # 100 READ(LUDI,110,END=200,ERR=100) N,IA 110 FORMAT(I20,MAXNUMBS I20) RETURN(NORM) # 200 RETURN(EOF) END #%%A-RCB-0077-SL-19 LSTGEN -- OUTPUT ROUTINE SUBROUTINEOUTPUT(N,IA) INTEGER IA(MAXNUMBS) # # Writes a one-line data statement for each element in IA # DO I = 1,MAXNUMBS WRITE (LUDO,10) I,N,IA(I) 10 FORMAT (6X,'DATA TABLE(', I2, ',' ,I3, ')/', I4, '/') # RETURN END #%%A-RCB-0077-SL-19 LSTGEN -- DECLARATION ROUTINE SUBROUTINEENDUP(N) # # Generate parameter statement and dimension for BTABLE, in file DECLAR.FTN # WRITE (LUDO,10) 10 FORMAT (6X,'END') CLOSE(UNIT=LUDO) OPEN (OUTPUTDESCRIPTION,NAME=DECLAR) # NSTA = N NEVEN = MAXNUMBS - 1 # WRITE(LUDO,110) NSTA,NEVEN 110 FORMAT(6X,'PARAMETER NSTA=',I3,',NEVEN=',I3) WRITE(LUDO,130) 130 FORMAT(6X,'INTEGER TABLE(NEVEN+1,NSTA)') CLOSE(UNIT=LUDO) RETURN END