SUBROUTINE FRMEDT(INLIN,LEND) C COPYRIGHT 1984 GLENN AND MARY EVERHART C FORMULA EDIT TO FIND AND EDIT FORMULAS OF FORM C {VAR C AND REPLACE THE VARIABLE SPEC BY FORMULA FOR THAT VARIABLE INCLUDE 'VKLUGPRM.FTN' PARAMETER CUP=1 C ADD LOGICAL NAMES IN THE FOLLOWING FASHION, TO BE MANIPULATED C HERE ALONE: C C STORE LOGICAL NAMES, UP TO 16 CHARS, HERE IN AN ARRAY WITH C DESIRED ID1,ID2 VALUES OF CELLS TO LOAD. WHERE A {NAME IS SEEN, C REPLACE WITH DESIRED CELL ADDRESS. C TO DEFINE LOGICAL NAMES, LOOK FOR = AFTER A NAME. IF = IS SEEN C AFTER THE { CHARACTER, ASSUME IT'S A LINE OF FORM {SALES=AA0 C (OR {SALES=00 TO DEASSIGN) AND STORE THE NAME. UP TO THE USER C TO PUT THE DESIRED FORMULA IN AS HE LIKES. MAY USE A TEST STMT C IF DESIRED. INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV INTEGER*2 LLCMD,LLDSP COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP LOGICAL*1 NAMARY(20,RCL) C ALLOW AS MANY NAMES AS THERE ARE ROWS... ARBITRARY... INTEGER*2 NAMNUM(10,RCL) EQUIVALENCE(NAMARY(1,1),NAMNUM(1,1)) C NAMNUM(9,RCL) AND NAMNUM(10,RCL) ARE RRW AND RCL C STORAGE. NAMARY(1-18,RCL) STORES NAME ASCII TEXT (POSSIBLY C NULL TERMINATED). FIND CELLS VIA LINEAR SEARCH. INTEGER*2 NAMMAX C NAMMAX IS MAX DIM OF NAMARY THAT'S FILLED IN. LOGICAL*1 INLIN(110),WRK1(120),WRK2(128) INTEGER*2 LEND DATA NAMMAX/0/ LCNT=0 1000 IF(LCNT.GT.20)RETURN I1=INDEX(INLIN,'{') IF(I1.LE.0.OR.I1.GT.70)RETURN IF(INLIN(I1).NE.'{')RETURN I2=INDEX(INLIN,'=') IF(I2.LE.0.OR.I2.LT.I1.OR.I2.GT.70.OR.INLIN(I2) 1 .NE.'=')GOTO 5400 IF((I2-I1).LE.1)GOTO 5400 C HERE SEE AN = SIGN AFTER A {VAR STRING. ATTEMPT TO EVALUATE. C GUARANTEED AT LEAST 1 CHARACTER OF NAME. I3=MIN0((I2-I1-1),16) c check if * seen ( text would then be {*= ) for printout c of symbol table IF(INLIN(I1+1).NE.'*')GOTO 5600 IF(NAMMAX.LE.0)GOTO 5600 CALL UVT100(CUP,LLCMD,1) CALL UVT100(12,2,0) C ERASE LINE WRITE(6,5601) 5601 FORMAT('Output File:') read(5,5602)(wrk1(II),II=1,80) 5602 format(110a1) DO 5603 N=1,78 NN=79-N IF(WRK1(NN).GT.32)GOTO 5604 WRK1(NN)=0 5603 CONTINUE 5604 CONTINUE CLOSE(UNIT=8) CALL ASSIGN(8,WRK1) C OPEN OUTPUT FOR WRITE C THEN DUMP SYMBOLS THERE C SYMBOL TABLE DUMP CAN BE SAVED ANYWHERE AND REENTERED AS C ASSIGNMENT STMTS. WRK1(1)='{' DO 5607 N=2,110 5607 WRK1(N)=0 WRK1(18)='=' DO 5605 N=1,NAMMAX IF(NAMNUM(9,N)+NAMNUM(10,N).LE.0)GOTO 5605 DO 5608 NN=1,16 5608 WRK1(NN+1)=NAMARY(NN,N) CALL IN2AS(NAMNUM(9,N),WRK1(19)) ENCODE(3,5606,WRK1(23),ERR=5419)NAMNUM(10,N)-1 5606 FORMAT(I3) K=3 WRK2(1)='T' WRK2(2)='E' WRK2(3)=' ' DO 5609 KK=1,106 I4=WRK1(KK) IF(I4.LE.32)GOTO 5609 K=K+1 WRK2(K)=I4 5609 CONTINUE C WRITE OUT DEFINITIONS AS IF THEY WERE ASSIGMNENT STMTS. WRITE(8,5610)(WRK2(KK),KK=1,K) 5610 FORMAT(110A1) 5605 CONTINUE CLOSE(UNIT=8) GOTO 5419 5600 CONTINUE LO=I2+1 IHI=LO+25 CALL VARSCN(INLIN,LO,IHI,LSTCHR,ID1,ID2,IVLD) C IF IVLD=0 ASSUME WE'RE UNDEFINING THE SYMBOL IF(IVLD.GT.0)GOTO 5402 C INVALID SYMBOL ... UNDEFINE STRING DO 5403 I4=1,NAMMAX DO 5404 I5=1,I3 IF(INLIN(I1+I5).NE.NAMARY(I5,I4))GOTO 5403 5404 CONTINUE C GOT IT IF WE FALL THRU NAMNUM(9,I4)=0 NAMNUM(10,I4)=0 DO 5443 I5=1,16 5443 NAMARY(I5,I4)=0 C ZERO THE ELEMENT DEFINITION AND FORGET IT... 5403 CONTINUE GOTO 5419 5402 CONTINUE C VALID ARRAY ELEMENT, DEFINE IT. IF(NAMMAX.LE.0)GOTO 5406 DO 5405 I4=1,NAMMAX IF(NAMNUM(9,I4)+NAMNUM(10,I4).EQ.0)GOTO 5410 5405 CONTINUE GOTO 5406 5410 CONTINUE C GOT IT IF WE FALL HERE NAMNUM(9,I4)=ID1 NAMNUM(10,I4)=ID2 C ZERO THE ELEMENT DEFINITION AND FORGET IT... GOTO 5407 5406 CONTINUE IF(NAMMAX.LT.0)NAMMAX=0 NAMMAX=MIN0(NAMMAX+1,RCL) NAMNUM(9,NAMMAX)=ID1 NAMNUM(10,NAMMAX)=ID2 C NOW SAVE THE SYMBOL NAME I4=NAMMAX 5407 CONTINUE C ZERO CHARACTERS FIRST, THEN FILL IN DO 5409 I5=1,16 5409 NAMARY(I5,I4)=0 DO 5408 I5=1,I3 NAMARY(I5,I4)=INLIN(I1+I5) 5408 CONTINUE C NO FURTHER PROCESSING IF WE DID ANY DEFINITION... JUST EXIT 5419 INLIN(1)='%' DO 5421 I5=2,110 5421 INLIN(I5)=0 C JUST NULL OUT THE LINE IF A DEFINITION. KEEPS FROM FURTHER C ERRORS... RETURN 5400 CONTINUE C NOW THAT DEFINITIONS ARE TAKEN CARE OF (IF ANY) C HANDLE SYMBOLIC SEARCHES IF(NAMMAX.LE.0)GOTO 5505 LSTCHR=I1+1 DO 5501 I4=1,NAMMAX DO 5502 I5=1,16 IF(NAMARY(I5,I4).LE.47)GOTO 5502 IF(INLIN(I1+I5).LE.47)GOTO 5502 LSTCHR=I1+I5+1 IF(INLIN(I1+I5).NE.NAMARY(I5,I4))GOTO 5501 C ALLOW MATCH PROVIDED THAT AT LEAST 1ST CHAR IS LEGAL. C IF(NAMARY(1,I4).GE.48.AND.NAMARY(I5,I4).LE.47)GOTO 5560 5502 CONTINUE 5560 CONTINUE C IF WE FALL THRU WE HAVE A MATCH ID1=NAMNUM(9,I4) ID2=NAMNUM(10,I4) C LAST CHECK: BE SURE WE AREN'T GIVING A DELETED SYMBOL. IF((ID1+ID2).GT.0)GOTO 5500 5501 CONTINUE 5505 CONTINUE C ONLY ALLOW IF THERE IS A { CHAR THERE LO=I1+1 IHI=LO+25 CALL VARSCN(INLIN,LO,IHI,LSTCHR,ID1,ID2,IVLD) IF(IVLD.LE.0)RETURN 5500 CONTINUE DO 11 N1=1,120 11 WRK1(N1)=0 C HERE HAVE A VALID CONSTRUCT SO REPLACE IT C (ONLY ONE PER LINE THIS TIME ROUND) C IRX=(ID2-1)*RRW+ID1 CALL REFLEC(ID2,ID1,IRX) C COPY FIRST PART OF FORMULA TO WORK ARRAY LO=I1-1 IHI=0 IF(LO.LE.0)GOTO 10 DO 1 N1=1,LO IHI=N1 WRK1(IHI)=INLIN(N1) 1 CONTINUE 10 CONTINUE IHI=IHI+1 CALL WRKFIL(IRX,WRK2,0) C WRKFIL READS THE FORMULA INTO WRK2. NEXT FIND END OF TEXT DO 2 N1=1,110 LO=111-N1 IF(WRK2(LO).GT.32)GOTO 3 2 CONTINUE 3 CONTINUE C LO NOW IS LENGTH OF FORMULA DO 4 N1=1,LO WRK1(IHI)=WRK2(N1) IF(IHI.LT.110)IHI=IHI+1 4 CONTINUE C TACK ON ANY MORE TEXT C RELY ON INLIN BEING 110 CHARS LONG DO 5 N1=LSTCHR,110 WRK1(IHI)=INLIN(N1) IF(IHI.LT.110)IHI=IHI+1 5 CONTINUE C NOW COPY 110 CHARS BACK TO INLIN DO 6 N1=1,110 6 INLIN(N1)=WRK1(N1) DO 7 N1=1,110 LO=111-N1 IF(INLIN(LO).GT.32)GOTO 8 C INLIN(LO)=32 7 CONTINUE 8 LEND=LO LCNT=LCNT+1 GOTO 1000 C KEEP LOOKING & RECURSING BUT IMPOSE LIMIT C RETURN END