PROGRAM FIXN0I C C FUNCTION: C MOVE DATA FROM SAVE AREA N TO SAVE AREA 0 AND ON BGAMMA'CA' C MACRO ADDRESSES STUDY CONTAINED IN SAVE AREA N AND MACRO C CONTINUES EXECUTION C INTEGER PC(4096),ICNT(256),ICNT19(256),STRLIN(10) LOGICAL*1 BCNT(512),TITLE(6),ERR,BYT1,BYT2,BYT3 C C NEW FILE NOT CREATED IN FIXS10 C EQUIVALENCE (ICNT,BCNT,FILE) REAL*8 FILE,GAMMAL,GAMMAM DATA GAMMAL/12RSY0GAMMALSYS/ DATA GAMMAM/12RSY0GAMMAMSYS/ DATA TITLE/'F','I','X','N','0','I'/ DATA STRLIN/2,53,104,155,206,257,308,359,410,461/ CALL GAMSTP(ICNT,TITLE) NLINE = 10 C C OPEN SAVE AREA ZERO TO CURRENT LINE C CALL SAVOP(0,ISAVE0,ICNT,IERR) ITP = 33 CALL READW(256,ICNT,ITP,ISAVE0) LINE = ICNT(39) CALL CLOSEC(ISAVE0) CALL IFREEC(ISAVE0) C C GET PARAMETERS C CALL GPV(2,NPF,ICNT,ERR) IF (ERR.LT.0) STOP 'PARAMETER IN FIXN0I ' IF (NPF.LE.0) STOP ' PARAMETERS MISSING OR GT 2' IF (NPF.EQ.1) GOTO 1 N = ICNT(1) ISTORE = 0 !STORE IN ZERO IF (N.GE.ICNT(2)) GOTO 20 !LAST STUDY POSSIBLE? C C OPEN SAVE AREAS 0 , N AND 19 C CALL SAVOP(ISTORE,ISAVE0,ICNT,IERR) CALL SAVOP(N,ISAVEN,ICNT,IERR) IWDS = ICNT(84) C C OPEN SAVE 19 AND CHECK IF NEW STUDY ? C CALL SAVOP(19,ISAV19,ICNT19,IERR) DO 3 I = 9,256 IF(I.EQ.42.OR.I.EQ.43.OR.I.EQ.44) GOTO 3 !IGNORE SA30 C WRITE(7,300)ICNT19(I),ICNT(I),N,I IF (ICNT19(I).NE.ICNT(I)) GOTO 2 !NEW STUDY? 3 CONTINUE GOTO 20 2 NLINE = -1 300 FORMAT(' NEXT ',6IO) CALL FIXSVA(ISAVEN,ISAVE0,FILE,PC,ICNT) C C OPEN GAMMAM TO STORE OM SAVE N C CALL CRTFIL(GAMMAM,53,IGAMMM,1) ISVN = 17 IGAM = 0 IPAGE = 1 IF (IWDS.LE.4096) GOTO 9 ISVN = 33 IPAGE = 4 9 DO 7 JJ = 1,IPAGE CALL READW(4096,PC,ISVN,ISAVEN) 7 CALL WRITW(4096,PC,IGAM,IGAMMM) C C OPEN GAMMAL.SYS TO INCREMENT SAVE AREA C 1 CALL CRTFIL(GAMMAL,53,IGAMML,1) ITP = 0 CALL READW(256,BCNT,ITP,IGAMML) DO 5 I = STRLIN(LINE),STRLIN(LINE)+49 C C SEARCH FOR TWO !! IE "41 C IF (BCNT(I).EQ."41.AND.BCNT(I+1).EQ."41) GOTO 4 GOTO 5 C C SEARCH FOR LINE !!2 OR !!2,0 C 4 IF (BCNT(I+3).EQ."200) GOTO 10 IF (BCNT(I+5).EQ."200.AND.BCNT(I+3).EQ."54) GOTO 10 C C SEARCH FOR LINE !!20 OR !! 20,30 C IF (BCNT(I+4).EQ."200) GOTO 30 IF (BCNT(I+7).EQ."200.AND.BCNT(I+4).EQ."54) GOTO 30 5 CONTINUE GOTO 20 10 BCNT(I+2) = BCNT(I+2) + 1 IF (BCNT(I+2).NE."72) GOTO 11 C C SET UP TO GOTO SVAR10 C BYT1 = BCNT(I+3) BYT2 = BCNT(I+4) BYT3 = BCNT(I+5) BCNT(I+2) = "61 BCNT(I+3) = "60 BCNT(I+4) = BYT1 BCNT(I+5) = BYT2 BCNT(I+6) = BYT3 GOTO 11 C C SET UP TO INCREMENT 2 DIGIT SVAR'S C 30 BCNT(I+3) = BCNT(I+3) + 1 IF (BCNT(I+3).NE."72) GOTO 11 BCNT(I+2) = BCNT(I+2) + 1 BCNT(I+3) = "60 11 ITP = 0 CALL WRITW(256,BCNT,ITP,IGAMML) C C CLOSE ALL CHANNELS C 20 DO 15 J = 1,10 I = J - 1 CALL CLOSEC(I) 15 CALL IFREEC(I) CALL GAMCA(ICNT,NLINE) END