C PICAX2.FOR C C---------------------------------------------------------------------- C C PICAX OVERLAY MODULE - REGION 2 C C---------------------------------------------------------------------- SUBROUTINE DEFINE (N, TYPE, STRING) C C---------------------------------------------------------------------- C C PRINTS N, UVAR(N) AND DESCRIPTIVE ASCII STRING ON CONSOLE C C THIS ROUTINE IS PART OF THE PICAX PROGRAM C WRITTEN BY ROBERT WALRAVEN, UCD - APPLIED SCIENCE C LAST MODIFICATION ON 17 JUL 81 C C---------------------------------------------------------------------- C COMMON /U VAR / NUVAR, UVAR(1) COMMON /P TITLE / LTITLE (36) BYTE TYPE C IF (N .GT. NUVAR) RETURN IF (N .EQ. 1) WRITE (5,1) LTITLE 1 FORMAT(1X,36A2) VALUE = UVAR(N) WRITE (5,10) N 10 FORMAT(' VAR('I2') = ',$) IF (TYPE .EQ. 'I') IVALUE = VALUE IF (TYPE .EQ. 'I') WRITE (5,20) IVALUE IF (TYPE .EQ. 'R') WRITE (5,30) VALUE IF (TYPE .EQ. 'E') WRITE (5,40) VALUE 20 FORMAT(I12,5X$) 30 FORMAT(F12.5,5X$) 40 FORMAT(1PE12.5,5X$) CALL PRINT (STRING) RETURN END SUBROUTINE DELETE C C---------------------------------------------------------------------- C C DELETE A LINE FROM THE PROGRAM C C THIS ROUTINE IS PART OF THE PICAX PROGRAM C WRITTEN BY ROBERT WALRAVEN, UCD - APPLIED SCIENCE C LAST MODIFICATION ON 4 AUG 80 C C---------------------------------------------------------------------- C COMMON /P INTER / LINE, ICMND COMMON /PROGRM / NLINES, N LN MAX, PROG(1) C I = LINE NM(LINE) IF (I.EQ.0) RETURN IF (I .EQ. NLINES) GO TO 20 DO 10 J=NLINES,I,-1 N = (J-1)*5 DO 10 JJ=1,5 NN = N+JJ 10 PROG (NN) = PROG (NN+5) 20 NLINES = NLINES - 1 RETURN END SUBROUTINE ERROR (I) C C---------------------------------------------------------------------- C C PRINT ERROR MESSAGES C C THIS ROUTINE IS PART OF THE PICAX PROGRAM C WRITTEN BY ROBERT WALRAVEN, UCD - APPLIED SCIENCE C LAST MODIFICATION ON 19 SEP 81 C C---------------------------------------------------------------------- C COMMON /P FLAGS / PROG ON, EXPT ON, QUERY LOGICAL PROG ON, EXPT ON, QUERY DATA IBELL /"100007/ C PROG ON = .FALSE. DO 1 J=1,10 1 CALL PRINT(IBELL) WRITE (5,2) I 2 FORMAT(' ERROR 'I2' -'$) GO TO (10,20,30,40,50,60,70,80,90,100,110,120,130,140,150, 1 160,170),I C 10 WRITE (5,12) 12 FORMAT(' OOPS. YOU TYPED A CONTROL-C. TYPE EX TO EXIT.') RETURN 20 WRITE (5,22) 22 FORMAT(' THAT IS NOT A COMMAND. TYPE HE IF YOU NEED HELP.') RETURN 30 WRITE (5,32) 32 FORMAT(' MISTEAK-IN LINE. PLEASE RETYPE IT.') RETURN 40 WRITE (5,42) 42 FORMAT(' VARIABLE INDEX OUT OF RANGE') RETURN 50 WRITE (5,52) 52 FORMAT(' DO LOOP TO NON-EXISTENT LINE') RETURN 60 WRITE (5,62) 62 FORMAT(' FIND ERROR') RETURN 70 WRITE (5,72) 72 FORMAT(' GO TO NON EXISTENT LINE') RETURN 80 WRITE (5,82) 82 FORMAT(' COMMANDS ARE ONE OR TWO LETTERS FOLLOWED BY' 1 /' UP TO 4 FLOATING POINT NUMBERS (SEPARATED BY COMMAS).' 2 /' FOR A LIST OF VALID COMMANDS TYPE LC.') RETURN 90 WRITE (5,92) 92 FORMAT(' OPEN ERROR') RETURN 100 WRITE (5,102) 102 FORMAT(' LINE NUMBER MUST BE BETWEEN 1 AND 999') RETURN 110 WRITE (5,112) 112 FORMAT(' NO SUCH LINE NUMBER') RETURN 120 WRITE (5,122) 122 FORMAT(' PROGRAM BUFFER FULL') RETURN 130 WRITE (5,132) 132 FORMAT(' OUTPUT FILE NOT OPEN') RETURN 140 WRITE (5,142) 142 FORMAT(' FILE ALREADY OPEN') RETURN 150 WRITE (5,152) 152 FORMAT(' NO INPUT FILE') RETURN 160 WRITE (5,162) 162 FORMAT(' NO FILES OPEN') RETURN 170 WRITE (5,172) 172 FORMAT(' NO FILE OPEN ON THAT LOGICAL UNIT') RETURN C END SUBROUTINE INIT C C---------------------------------------------------------------------- C C INITIALIZE PICAX VARIABLES C C THIS ROUTINE IS PART OF THE PICAX PROGRAM C WRITTEN BY ROBERT WALRAVEN, UCD - APPLIED SCIENCE C LAST MODIFICATION ON 19 SEP 81 C C---------------------------------------------------------------------- C COMMON /P C VAR / NCVAR, CVAR(4) COMMON /P DO VAR / DO FRST, DO LAST, DO CNT COMMON /P FILES / NOPEN, LUNOPN(6), LUNFND(6), NFOUND COMMON /P FLAGS / PROG ON, EXPT ON, QUERY COMMON /PROGRM / NLINES, N LN MAX, PROG(50) COMMON /P TITLE / LTITLE(36) COMMON /P VAR / NCTRLC, LN PTR, P VERSN COMMON /U VAR / NUVAR,UVAR(13) LOGICAL PROG ON, EXPT ON, QUERY INTEGER DO FRST, DO LAST, DO CNT C P VERSN = 1.0 NCVAR = 4 N LN MAX = 10 NCTRLC = 0 NLINES = 0 DO CNT = 0 PROG ON = .FALSE. NOPEN = 0 NFOUND = 0 DO 1 I=1,6 LUN OPN (I) = 0 1 LUN FND (I) = 0 EXPT ON = .FALSE. QUERY = .FALSE. DO 10 I=1,16 II = I 10 CALL SETERR(II,100) CALL SCCA (NCTRLC) DO 20 I=1,35 20 LTITLE(I) = ' ' LTITLE(36) = 0 CALL ALFMOD WRITE (5,30) P VERSN 30 FORMAT(' PICAX VERSION 'F5.2' 5 DEC 81') CALL UINIT RETURN END SUBROUTINE INSERT C C---------------------------------------------------------------------- C C INSERT A LINE INTO THE PROGRAM C C THIS ROUTINE IS PART OF THE PICAX PROGRAM C WRITTEN BY ROBERT WALRAVEN, UCD - APPLIED SCIENCE C LAST MODIFICATION ON 4 AUG 80 C C---------------------------------------------------------------------- C COMMON /P C VAR / NCVAR, CVAR(1) COMMON /P INTER / LINE, ICMND COMMON /P MATCH / MCMND, NMATCH, CHARS COMMON /PROGRM / NLINES, N LN MAX, PROG(1) DIMENSION N(2) EQUIVALENCE (PACK,N(1)) C IF (NLINES .GT. 0) GO TO 10 NLINES = 1 INDEX = 1 GO TO 90 10 DO 20 INDEX = 1,NLINES PACK = PROG(INDEX*5-4) IF (N(1) .EQ. LINE) GO TO 90 IF (N(1) .GT. LINE) GO TO 40 20 CONTINUE INDEX = NLINES + 1 40 IF (NLINES .LT. N LN MAX) GO TO 60 CALL ERROR(12) RETURN 60 NLINES = NLINES + 1 IF (INDEX .GE. NLINES) GO TO 90 70 DO 80 J=NLINES,INDEX+1,-1 M = (J-1)*5 DO 80 JJ=1,5 NN = M+JJ 80 PROG (NN) = PROG (NN-5) 90 N(1) = LINE N(2) = NMATCH PROG(INDEX*5-4) = PACK DO 100 I=1,4 100 PROG (INDEX*5+I-4) = CVAR(I) RETURN END SUBROUTINE PLIST C C---------------------------------------------------------------------- C C LISTS THE CURRENT PROGRAM C C THIS ROUTINE IS PART OF THE PICAX PROGRAM C WRITTEN BY ROBERT WALRAVEN, UCD - APPLIED SCIENCE C LAST MODIFICATION ON 4 AUG 80 C C---------------------------------------------------------------------- C COMMON /P INTER / LINE, ICMND COMMON /P MATCH / MCMND, NMATCH, MCHAR1, MCHAR2 COMMON /PROGRM / NLINES, N LN MAX, PROG(1) DIMENSION N(2),V(4) EQUIVALENCE (PACK,N(1)) C IF (NLINES .EQ. 0) RETURN CALL ERASE MCMND = 1 DO 30 I=1,NLINES PACK = PROG(I*5-4) LINE = N(1) ICMND = N(2) CALL SEARCH ICMND = MCHAR1 DO 10 J>1,4 10 V(J) = PROG(I*5-4+J) WRITE (5,20) LINE,ICMND,V 20 FORMAT(1X,I3,2X,A2,4(1PE15.4)) 30 CONTINUE MCMND = 0 LINE = 0 RETURN END SUBROUTINE TITLE C C---------------------------------------------------------------------- C C GET THE TITLE FROM THE CONSOLE C C THIS ROUTINE IS PART OF THE PICAX PROGRAM C WRITTEN BY ROBERT WALRAVEN, UCD - APPLIED SCIENCE C LAST MODIFICATION ON 4 AUG 80 C C---------------------------------------------------------------------- C COMMON /P TITLE / LTITLE (36) C WRITE (5,10) 10 FORMAT (' TITLE: '$) READ (5,20) LTITLE 20 FORMAT(36A2) RETURN END