C   01/11/84            MEMBER NAME  CREDIT   (S)           FORTRAN
C
C-----------------------------------------------------------------------
      SUBROUTINE CREDIT
C-----------------------------------------------------------------------
C
C   AUTHOR : J. OLSSON     SUMMER 79 : HANDLES JOYS COMMAND
C
C      MOD : J. OLSSON     31/08/82  :
C      MOD : P. HILL/C.B.  17/02/84  : CDTLCO --> CDST
C      MOD : C. BOWDERY    07/03/84  : REVERSE CDTL 13/20
C      MOD : C. BOWDERY    06/06/84  : USES NEW KOMMAN AND DISPLY
C LAST MOD : J. HAGEMANN   17/10/84  : USES NEW HITMRK
C
C     EDITING PATTERN RECOGNITION RESULTS FOR THE JADE INNER DETECTOR
C
C-----------------------------------------------------------------------
C
C     ENTER THIS ROUTINE AFTER PERFORMING CELL PATTERN RECOGNITION AND
C     BACKTRACING, AND BEFORE LOOPING OVER TRACKS AND WRITING RESULTS
C     BANKS (PATR AND JHTL).      THE ROUTINE KNTREL IS BYPASSED AND
C     CALLED AFTER THE EDITING IS FINISHED.
C
C-----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
C
      LOGICAL DSPDTM
      LOGICAL TBIT,REMEMB,REMB1,REMBDT,MEASY,TRHIT,TLHT,DSP22,DSP24
      LOGICAL DSP13,DSP20,DSP17,DSP4,DSP26
      LOGICAL FL18,FL22,FL24
C
      COMMON / CPROJ  / XMINR,XMAXR,YMINR,YMAXR,IPRJC,FL18,FL22,FL24
      COMMON / CGRAP2 / BCMD,DSPDTM(30),ISTVW,JTVW
      COMMON / CLBPGM / LBPGM(30)
      COMMON / CHEADR / HEAD(108)
C
      COMMON / CWORK1 / R,FI,R1,FI1,X1,Y1,R2,FI2,X2,Y2,ZET,X3,Y3,X4,Y4,
     +                  KZAMP,HWORK(400),XLTR(200),YLTR(200),XLST(100),
     +                  YLST(100),HKTRAR(100),HKTRS(100)
      COMMON / CJTRIG / PI,TWOPI
      COMMON / CJCELL / NCELL(3),NWIRES(3)
C
#include "cworkpr.for"
#include "cworkeq.for"
#include "cpatlm.for"
#include "cdata.for"
C
#include "cjdrch.for"
#include "cgeo1.for"
#include "cgraph.for"
C
      DIMENSION HELP(2),LABERR(100),HAPPY(100),HIPPIE(9,100),LBLREM(200)
C
      EQUIVALENCE (LABL,HELP(1))
      EQUIVALENCE
     +           (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2)),(IRING ,IDWRK(3))
     +         , (IERRCD,IDWRK(4)),(NTRKEL,IDWRK(5))
C
C                            MASKS FOR TRACK NO. IN HIT LABEL
C
      DATA MSKTR1/ZFE/,MSKILL /Z10000/, MSKEEP /ZFFFEFFFF/
C
C                            MASKS FOR BAD HIT (XYFIT)
C
      DATA NPATR /'PATR'/, JHTL /'JHTL'/, LHEAD /8/,LTRBK/48/
      DATA LAB8/Z80000/,LAB80/Z800000/,LAB1/Z10000/
      DATA LBL26/Z20/
      DATA LAB3/Z30000/,LAB4/Z40000/,LAB0/Z80000000/
C
      DATA HELP/0,0/,HCALL/0/,DM/0./
C
C------------------  C O D E  ------------------------------------------
C
      CALL TRMOUT(80,'PATREC EDIT,
     $    VERSION FROM 29.05.81.^')
      IF(HEAD(18).GT.1400) ZFITLM(1) = 70.
      IF(HEAD(18).GT.1400) ZFITLM(2) = 35.
      IJHTL=IBLN('JHTL')
      IJETC=IBLN('JETC')
      IPATR=IBLN('PATR')
      IPPATR = IDATA(IPATR)
C MOVE PATR BANK TO END OF BOS DATA AND RESET LENGTH TO 0 TRACKS
      CALL CMVE(IPPATR,IER)
      IZW = IDATA(IPPATR+2)*LTRBK
      CALL BCHM(IPPATR,-IZW,IER)
      IDATA(IPPATR+1) = LHEAD
      IDATA(IPPATR+2) = 0
      IDATA(IPPATR+3) = LTRBK
      IPJHTL=IDATA(IJHTL)
C ZERO SET JHTL BANK
      CALL SETSL(IDATA(IPJHTL+2),0,4*(IDATA(IPJHTL)-1),0)
      HCALL = HCALL + 1
      IF(HCALL.GT.1) GO TO 102
      SH1 = BLDEP*.10
      SH2 = BLFI*.16667
      SH3 = 4.*SH2
      DEFIX = TWOPI/84.
102   REMEMB = DSPDTL(6)
      REMB1 = DSPDTL(10)
      ISTOLD = ISTANV
      LSTOLD = LASTVW
      ISTVWL = ISTVW
      JTVWL  = JTVW
      ISTVW = 0
      JTVW = 0
      SXINR = SXIN
      SXAXR = SXAX
      SYINR = SYIN
      SYAXR = SYAX
      IXBKKR = IXBKK(40)
      DSP22 = FL22
      DSP24 = FL24
      DSP26 = DSPDTL(26)
      DSP20 = DSPDTL(20)
      DSP28 = DSPDTL(28)
      DSP14 = DSPDTL(14)
      DSP17 = DSPDTL(17)
      DSP4  = DSPDTL(4)
      DSPDTL(4) = .FALSE.
      DSPDTL(14) = .FALSE.
      DSPDTL(17) = .TRUE.
      DSPDTL(20) = .FALSE.
      DSPDTL(26) = .FALSE.
      DSPDTL(28) = .FALSE.
C  SET FLAGS FOR FITTING PROGRAM TO PROTECT EDITING RESULTS
      IGPLM7 = IGFP(1)
      IGPLIM = IXYF(1)
      LMCERT = IMCERT
C SET FLAG TO ENABLE BOTH PREPROCESSORS IN ZRFIT
C     LMZFIT(10) = 3
      IMCERT = 1
      CALL TRMOUT(80,'IMCERT NOW = 1 (DEFAULT), CHANGE BY COMMAND 35^')
      NTRLM = 0
C     XYFIT CONTROL WORD (VIA BIT STRUCTURE)
C     BIT ON MEANS :
C     BIT 31 .. MAKE A SINGLE FIT TO THE HITS AND STOP
C     BIT 30 .. NEVER PERFORM A CIRCLE FIT
C     BIT 29 .. RECALCULATE ABERRATIONS AND MAKE ONE MORE FIT
C     BIT 28 .. STORE TRACK ELEMENT CHI**2'S WHEN BIT 31 SET
C     BIT 27 .. STOP TRYING TO REJECT WORST TRACK ELEMENT
C     BIT 26 .. NEVER CHECK L/R SOLUTION WITH FIT  (ASSURED BY LBL26)
      IXYF(1) = LOR(IXYF(1),LBL26)
      JUMP = 0
      ICFIT = 0
      IMAGE = 0
      LABHED = 0
      DO 7646 I = 1,100
7646  LABERR(I) = 0
      TRHIT = .FALSE.
      TLHT = .FALSE.
      IPJCA=IDATA(IJETC)
      IPJ = 2*IPJCA + 2
      NWO = HDATA(IPJ+97)-HDATA(IPJ+1) + 98
      NHITS = (HDATA(IPJ+97)-HDATA(IPJ+1))/4
      HPFRE0 = HPFREE
      KK = 1
      GO TO 8001
112   CALL TRMOUT(80,'CODE 0: EXIT     CODE 1:  INSTRUCTION CODE LIST
     1  CODE 2: HARDCOPY^')
      CALL TRMOUT(80,'CODE 3: JOYSTICK     CODE 4: RESET SCALE     CODE
     15: COMMENT OPTION^')
      CALL TRMOUT(80,'CODE 6: SHOW EVENT     CODE 7: CHANGE DISPLAY VIEW
     1^')
      CALL TRMOUT(80,'CODE 8: CALL GRAPHICS DISPLAY ROUTINE     CODE 9:
     1WRITE BACKTRACE RESULTS^')
      CALL TRMOUT(80,'CODE 10: DISPLAY ALL HITS ASSOCIATED WITH TRACK EL
     1EMENTS^')
      CALL TRMOUT(80,'CODE 11: DISPLAY ALL HITS NOT ASSOCIATED WITH TRAC
     1K ELEMENTS^')
      CALL TRMOUT(80,'CODE 12: DISPLAY ALL HITS ASSOCIATED WITH A PARTIC
     1ULAR TRACK ELEMENT^')
      CALL TRMOUT(80,'CODE 13: DISPLAY ALL HITS ASSOCIATED WITH TRACK EL
     1EMENTS,LR SOLVED^')
      CALL TRMOUT(80,'CODE 14: DISPLAY ALL HITS ASSOCIATED WITH TRACK EL
     1EMENTS,LR UNSOLVED^')
      CALL TRMOUT(80,'CODE 15: DISPLAY ALL HITS ASSOCIATED WITH A PARTIC
     1ULAR TRACK ELEMENT,LR SOLVED^')
      CALL TRMOUT(80,'CODE 16: DISPLAY ALL HITS ASSOCIATED WITH TRACKS.^
     1')
      CALL TRMOUT(80,'CODE 17: DISPLAY ALL HITS NOT ASSOCIATED WITH TRAC
     1KS.^')
      CALL TRMOUT(80,'CODE 18: DISPLAY ALL HITS ASSOCIATED WITH PARTICUL
     1AR TRACKS.^')
      CALL TRMOUT(80,'CODE 19: DISPLAY ALL HITS, MARKING TRACK-ASSOCIATE
     1D ONES.^')
      CALL TRMOUT(80,'CODE 20: CHANGE DISPLAY DETAILS.    CODE 21: WRITE
     1 MIDOUT ARRAYS^')
      CALL TRMOUT(80,'CODE 22: TRIAL FIT AND DISPLAY OF ALL TRACKS^')
      CALL TRMOUT(80,'CODE 23: TRIAL FIT AND DISPLAY OF SELECTED TRACK(S
     $).^')
      CALL TRMOUT(80,'CODE 24: TRACK EDITING FACILITY^')
      CALL TRMOUT(80,'CODE 25: TRACK ELEMENT EDITING FACILITY^')
      CALL TRMOUT(80,'CODE 26: DISPLAY HITS ACCORDING TO HIT LABEL BANK
     $FROM TESTFIT^')
      CALL TRMOUT(80,'CODE 27: DISPLAY RAW EVENT, MARKING SELECTED TRACK
     $S,INCLUDING MIRRORS.^')
      CALL TRMOUT(80,'CODE 28: CHANGE LIMITS IN COMMON /CPATLM/ OR COMMO
     $N /CJDRCH/^')
      CALL TRMOUT(80,'CODE 29: CREATE BACKTRACE AND MIDOUT ARRAYS FROM P
     $REVIOUS HIT LABEL ARRAY.^')
      CALL TRMOUT(80,'CODE 30: SHOW RESULTS OF ALREADY EXISTING PATR BAN
     $KS.^')
      CALL TRMOUT(80,'CODE 31: ZX AND ZY PROJECTIONS^')
      CALL TRMOUT(80,'CODE 32: CREATE NEW TRACK ELEMENT BY JOYSTICK INPU
     $T.^')
      CALL TRMOUT(80,'CODE 33: ACTIVATE/DEACTIVATE AUTOMATIC DELETION OF
     * LOW ENERGY TRACKS^')
      CALL TRMOUT(80,'CODE 34: SAVE OR RECOVER STATUS OF EDITING^')
      CALL TRMOUT(80,'CODE 35: ACTIVATE/DEACTIVATE AUTOMATIC DELETION OF
     *OVERLAPPING TRACKS^')
      CALL TRMOUT(80,'CODE 36: ACTIVATE/DEACTIVATE DISPLAY OF HITS BY TR
     *ACK NUMBERS^')
      CALL TRMOUT(80,'CODE 37: ACTIVATE/DEACTIVATE DISPLAY OF HITS BY TR
     *ACK ELEMENT NUMBERS^')
      CALL TRMOUT(80,'CODE 38: SET INNER AND OUTER RANGE LIMITS FOR HITS
     * OF A TRACK^')
      CALL TRMOUT(80,'CODE 39: CALL SUBROUTINE SPARE^')
      CALL TRMOUT(80,'CODE 9999: EXPRESS EXIT FROM EDIT^')
1601  IQQ = 0
1602  CALL TRMOUT(80,'COMMAND? (1=LIST)^')
      IXBKK(40) = IXBKKR
      CALL FYRINT(NN,NN2,NN3,NN4)
1603  NN = NN + 1
      IF(NN.NE.24) ICFIT = 0
      IF(NN.EQ.10000) GO TO 9000
      IF(IQQ.NE.0)
     $ CALL DIAGIN('NN NN2 NN3 NN4      ',4,NN,NN2,NN3,NN4,I,I)
      HALO = NN/100
      IF(NN.GE.100) NN = NN - 100
2905  IF(NN.LT.1.OR.NN.GT.41) GO TO 1601
      JNDEX = ISTANV
      IF(ISTANV.GT.7) JNDEX = JNDEX - 4
      GO TO (100,112,300,400,500,600,700,800,900,1000,1100,1100,1100
     $ ,1100,1100,1100,1700,1700,1900,1700,2100,2200,2300,2400
     $ ,2500,2600,2300,2800,2900,3000,3100,3200,3300,3400,3500,3600
     $ ,3700,3800,3900,4000,4100),NN
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
300   CALL TRMOUT(80,'ENTER YES TO CONFIRM REQUEST FOR HARDCOPY !^')
      CALL DECIDE(IANSW)
      IF(IANSW.NE.1) GO TO 1601
      IF(NN2.EQ.0) GO TO 2131
      CALL TRMOUT(80,' TRAILING NUMBER, COPY ON EXTERNAL PRINTER^')
      CALL HDCEXT
      GO TO 1601
2131  CALL TRMOUT(80,' NO TRAILING NUMBER, COPY ON INTERNAL PRINTER^')
      CALL HDCOPY
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
400   CALL JOYS(0,0.)
      IMAGE = ISTANV
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
500   CALL SETSCL(ISTANV)
      FL22 = .FALSE.
      IMAGE = 0
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
600   CALL COMENT
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
700   CALL ERASE
      IF(HALO.EQ.1) CALL JADISP(ISTANV)
      CALL EVDISP(ISTANV)
      IF((ISTANV.LT.4.OR.ISTANV.EQ.14).AND.DSPDTL(17))
     $ CALL PROJEC(ISTANV)
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
800   IF(NN2.EQ.0) GO TO 842
      KK = NN2
      GO TO 8002
842   CALL TRMOUT(80,
     1'PLEASE ENTER NUMBER OF STANDARD VIEW YOU WOULD LIKE.^')
      CALL TRMOUT(80,
     1'RA=1. RB=2. RC=3. ZXA=4. ZXB=5. ZXC=6. ZXD=7. ZYA=8. ZYB=9. ZYC=100027500
     10. ZYD=11.^')
      CALL TRMOUT(80,'FW=12. RU=13. CYL=14.^')
      CALL FYRINT(KK,KK2,KK3,KK4)
      IF(KK2.EQ.0) GO TO 8002
      NN = KK
      NN2 = KK2
      NN3 = KK3
      NN4 = KK4
      GO TO 1603
8002  IF(KK.EQ.1.OR.KK.EQ.2.OR.KK.EQ.4.OR.KK.EQ.5.
     $OR.KK.EQ.8.OR.KK.EQ.9.OR.KK.EQ.14) GO TO 8001
      CALL TRMOUT(80,'NOT AVAILABLE. PLEASE TRY AGAIN.^')
      GO TO 842
8001  ISTANV = KK
      CALL SETSCL(ISTANV)
      FL22 = .FALSE.
      LASTVW = ISTANV
      IF(IMAGE.NE.ISTANV) GO TO 8051
      FL22 = .TRUE.
      XMIN = XMINR
      YMIN = YMINR
      XMAX = XMAXR
      YMAX = YMAXR
      CALL DWINDO (XMIN,XMAX,YMIN,YMAX)
8051  SXIN=XMIN
      SYIN=YMIN
      SXAX=XMAX
      SYAX=YMAX
      XXXX = XMIN
      YYYY = YMIN+.76*(YMAX-YMIN)
      CALL CHRSIZ(4)
      CALL CSIZE(IHO,IVE)
      SSSS = IVE*(YMAX-YMIN)/6240.
      YYYY = YYYY - 15.*SSSS
      SSSS = IVE*.55
      CALL MOVEA(XXXX,YYYY)
      CALL SEELOC(IHO,IVE)
      XXXX = IHO
      YYYY = IVE
      YYYY = YYYY - 3.*SSSS
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
900   CALL TRMOUT(80,'TO RETURN PROPERLY FROM GRAPHICS DISPLAY, GIVE COM
     $MAND RET^')
      CALL TRMOUT(80,'WARNING: NON DISPLAY COMMANDS WILL DESTROY YOUR ED
     $ITING WORK ...^')
      KTREL = LSTCMD
C***
 901  CALL KOMMAN
      IF( LSTCMD .GT. 100 ) GO TO 100
      CALL DISPLY
      IF( LSTCMD .EQ. 48  ) GO TO 902
      GO TO 901
C***
 902  LSTCMD = KTREL
      REMEMB = DSPDTL(6)
      REMB1 = DSPDTL(10)
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C
C  WRITE BACKTRACE RESULT ARRAYS; TRACK - TRACK ELEMENT ASSOCIATION
C
1000  CONTINUE
      DO 740  ITR = 1,NTR
740   IF(NN2.EQ.0.OR.ITR.EQ.NN2)
     $ WRITE(6,7400) ITR,HNREL(ITR),(HISTR(INR,ITR),INR=1,9)
7400  FORMAT(' TRACK:',I3,' NR OF ELEMENTS:',I4,' ELEMENTS:',9I4)
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C
C  TRACK ELEMENTS DISPLAY
C
1100  JNDX = NN-10
      IF(JNDX.EQ.3.OR.JNDX.EQ.6) GO TO 1300
      GO TO 222
1300  IKTR = 0
1301  CALL TRMOUT(80,'PLEASE ENTER TRACK ELEMENT NR 1 TO 100, ANY OTHER
     $TO PROCEED^')
      CALL FYRINT(KK,KK2,KK3,KK4)
      IF(KK2.EQ.0) GO TO 1392
      NN = KK
      NN2 = KK2
      NN3 = KK3
      NN4 = KK4
      GO TO 1603
1392  KTREL = KK
      IF(KTREL.LE.0.OR.KTREL.GT.100) GO TO 1321
      IKTR = IKTR + 1
      IF(IKTR.LE.HNTR) GO TO 1322
      IKTR = IKTR - 1
      GO TO 222
1322  HKTRAR(IKTR) = KTREL
      GO TO 1301
1321  IF(IKTR.GT.0) GO TO 222
      CALL TRMOUT(80,'NO VALID TRACK ELEMENT NUMBER HAS BEEN ENTERED^')
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C
C  TRACK DISPLAY
C
1700  KNDX = NN-16
      GO TO 802
2800  KNDX = 5
      GO TO 1901
1900  KNDX = 3
1901  IKTR = 0
      IKTRS = 0
      IF(NN.EQ.19.AND.NN2.EQ.0) GO TO 802
      IF(NN.EQ.28.AND.NN2.EQ.0) GO TO 802
1919  IF(NN2.NE.0) KTR = NN2
      IF(NN2.NE.0) GO TO 1939
1918  CALL TRMOUT(80,'ENTER TRACK NR.^')
      CALL FYRINT(KK,KK2,KK3,KK4)
      IF(KK2.EQ.0) GO TO 1399
      NN = KK
      NN2 = KK2
      NN3 = KK3
      NN4 = KK4
      GO TO 1603
1399  KTR = KK
1939  IF(NN.NE.28.OR.KTR.LE.NTR) GO TO 1940
      DO 1941  KTR = 1,NTR
      HKTRAR(KTR) = KTR
1941  HKTRS(KTR) = KTR
      IKTR = NTR
      IKTRS = NTR
      GO TO 802
1940  IF(KTR.LE.0.OR.KTR.GT.NTR) GO TO 1921
      IKTR = IKTR + 1
      IKTRS = IKTRS + 1
      IF(IKTR.LE.NTR) GO TO 1922
      IKTR = IKTR - 1
      IKTRS = IKTRS - 1
      IF(JUMP.EQ.0) GO TO 802
      GO TO 2401
1922  HKTRAR(IKTR) = KTR
      HKTRS(IKTRS) = KTR
      IF(NN2.NE.0) GO TO 1921
      GO TO 1918
1921  IF(IKTR.GT.0.AND.JUMP.EQ.0) GO TO 802
      IF(IKTR.GT.0.AND.JUMP.NE.0) GO TO 2401
      CALL TRMOUT(80,'NO VALID TRACK NUMBER HAS BEEN ENTERED^')
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C-------  CHANGE DISPLAY DETAILS;  CODE TAKEN FROM DISPLY -------------I
C--
2100  IF(NN2.NE.0) NDTL = NN2
      IF(NN2.NE.0) GO TO 2107
2108  CALL TRMOUT(80,'PLEASE ENTER OPTION; ENTER 0 FOR LIST^')
      CALL FYRINT(KK,KK2,KK3,KK4)
      IF(KK2.EQ.0) GO TO 2199
      NN = KK
      NN2 = KK2
      NN3 = KK3
      NN4 = KK4
      GO TO 1603
2199  NDTL = KK
2107  IF(NDTL.GT.0.AND.NDTL.LT.61) GO TO 2103
      CALL CDST( 0 )
      GO TO 2108
 2103 IF(NDTL.LE.30.AND.NDTL.NE.26) DSPDTL(NDTL)=.NOT.DSPDTL(NDTL)
      IF(NDTL.GT.30) DSPDTM(NDTL-30)=.NOT.DSPDTM(NDTL-30)
      IF(NDTL.EQ.26) CALL TRMOUT(80,'CDTL 26 NOT AVAILABLE, SORRY^')
      REMEMB = DSPDTL(6)
      REMB1 = DSPDTL(10)
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C
C  WRITE MIDOUT ARRAYS; DETAILED INFORMATION ABOUT TRACK ELEMENTS
C
2200  WRITE(6,503) HNTR
      WRITE(6,504) (HNTCEL(I),I=1,98)
      WRITE(6,505)
      WRITE(6,506) ((I,IPCL(I),NRHT(I),NWR1(I),DS1(I),SL1(I),NWR2(I),
     $ DS2(I),SL2(I),LBL(I),NTREL(I),ICRO(I)),I=1,HNTR)
503   FORMAT(' HNTR ',I10)
504   FORMAT(' HNTCEL ',15I4)
505   FORMAT(' EL CEL NHT  WR1       DS1       SL1  WR2       DS2
     $SL2  LBL NTREL ICRO')
506   FORMAT(' ',I2,I4,I4,I5,E10.2,E10.2,I5,E10.2,E10.2,1X,Z5,I6,I5)
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C-------  TRACK FITTING AND DISPLAY, ALL TRACKS -----------------------I
C--
C     MEMORIZE 1. FREE LOC. IN CWORK
2300  IF( NN .EQ. 23  .AND.  NN2 .EQ. 0 ) DSPDTL(13) = .NOT. DSPDTL(13)
      DO 2301 I = 1,NTR
2301  HKTRAR(I) = I
      IKTR = NTR
      GO TO 2459
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C-------  TRACK FITTING AND DISPLAY, SELECTED TRACK(S) ----------------I
C--
2400  JUMP = 1
      IF(NTR.LE.0) GO TO 1601
C PREVENT KNTREL FROM ITERATING
      IXBKK(40) = 0
      IF(NN2.NE.0) ICFIT = ICFIT + 1
      IF(ICFIT.GT.27) ICFIT = 1
      GO TO 1901
2401  JUMP = 0
C
2459  HPFRE0 = HPFREE
      CALL TRLORD
C     DO 2402  I = 1,100
C     HAPPY(I) = HNREL(I)
C     DO 2402  J= 1,9
C2402  HIPPIE(J,I) = HISTR(J,I)
C      DO 2403  I = 1,200
C2403  LBLREM(I) = LBL(I)
C      NTRREM = NTR
      IF(IQQ.NE.0) WRITE(JUSCRN,2415) IKTR,NTR,HNTR
2415  FORMAT(' IKTR AND NTR,HNTR BEFORE KNTREL ',3I6)
      CALL KNTREL(HKTRAR,IKTR)
      IPPATR=IDATA(IPATR)
      IPJHTL=IDATA(IJHTL)
      IF(IQQ.NE.0) WRITE(JUSCRN,2416) IKTR,NTR,HNTR
2416  FORMAT(' IKTR AND NTR,HNTR AFTER KNTREL ',3I6)
      IF(NN.EQ.27) GO TO 2425
      IF(NN.EQ.23) CALL RSDISP(LASTVW)
      IF((NN.EQ.23).AND.(LASTVW.EQ.13)) CALL YAMADA(0)
      IF(NN.NE.24) GO TO 2427
      DSP13 = DSPDTL(13)
      DSPDTL(13) = .FALSE.
      CALL RSDISP(LASTVW)
      IF(LASTVW.EQ.13) CALL YAMADA(0)
      DSPDTL(13) = .TRUE.
      YYY = YYYY - (ICFIT-1)*3.5*SSSS
      IPP = IPPATR + LHEAD
      IF(IDATA(IPPATR+2).GT.0) CALL TRTEXT(IPPATR,IPP,XXXX,YYY,SSSS)
      DSPDTL(13) = DSP13
2427  REMBDT = DSPDTL(16)
      ACMDRB = ACMD
      BCMDRB = BCMD
      IF(NN.EQ.23.OR.NN.EQ.24) ACMD = 99.
      IF(DSPDTL(17)) DSPDTL(16) = .TRUE.
      IF(DSPDTL(17).AND.(ISTANV.LT.4.OR.ISTANV.EQ.14).AND.
     $ IDATA(IPPATR+2).GT.0) CALL PROJEC(ISTANV)
      DSPDTL(16) = REMBDT
      ACMD = ACMDRB
      BCMD = BCMDRB
      GO TO 2426
2425  IPJHTL=IDATA(IJHTL)
      ACMDRB = ACMD
      BCMDRB = BCMD
      BCMD = FLOAT(IDATA(IPJHTL-2))
      ACMD = FLOAT(NN2)
      IF(HALO.EQ.1) ACMD = ACMD + 100.
      CALL TRKHIT
      ACMD = ACMDRB
      BCMD = BCMDRB
      IF(DSPDTL(17).AND.(ISTANV.LT.4.OR.ISTANV.EQ.14))
     $ CALL PROJEC(ISTANV)
C     RESET POINTERS AND TRACKBANK TO INITIAL STATE
2426  IPPATR=IDATA(IPATR)
      IZW = IDATA(IPPATR+2)*LTRBK
      CALL BCHM(IPPATR,-IZW,IER)
      IDATA(IPPATR+1) = LHEAD
      IDATA(IPPATR+2) = 0
      IDATA(IPPATR+3) = LTRBK
      IPJHTL=IDATA(IJHTL)
      CALL SETSL(IDATA(IPJHTL+2),0,4*(IDATA(IPJHTL)-1),0)
C     IF(IMCERT.NE.1) GO TO 2488
C     DO 2407  I = 1,100
C     HNREL(I) = HAPPY(I)
C     DO 2407  J= 1,9
C2407  HISTR(J,I) = HIPPIE(J,I)
C      NTR = NTRREM
2488  CONTINUE
2671  IF( NN .EQ .23  .AND.  NN2 .EQ. 0 ) DSPDTL(13) = .NOT. DSPDTL(13)
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C-------  TRACK EDITING  ----------------------------------------------I
C--
C-*-      GET OLD AND NEW TRACK NUMBER
2500  IF(NN2.NE.0) NTRED = NN2
      IF(NN2.NE.0) NTRNEW = NN3
      IF(NN2.NE.0) GO TO 2588
2587  CALL TRMOUT(80,'ENTER OLD&NEW TRACK (999=DELETE)^')
      CALL FYRINT(NTRED,NTRNEW,IDDD1,IDDD2)
2588  IF(NTRED.LT.1.OR.NTRED.GT.NTR.OR.NTRNEW.EQ.0) GO TO 1601
C-*-      SET POLARITY SHIFT
      IPOL = ISIGN(1,NTRNEW)
      NTRNEW = IABS(NTRNEW)
      IF(NTRNEW.EQ.999) NTRNEW = 0
      IF(NTRNEW.LE.NTRED.OR.NTRNEW.GT.NTR) GO TO 2508
      CALL TRMOUT(80,'EDITED TRACK NR MUST BE GE. NEW TRACK NR^')
      GO TO 2587
2508  NTRLED = HNREL(NTRED)
      IF(NTRNEW.LE.NTR) GO TO 2526
C-- ENTER HERE FOR RENUMBERING TRACK TO NTR + 1  (REORDERING)
      NTRNEW = NTR + 1
      HNREL(NTRNEW) = HNREL(NTRED)
      DO 2521 ITREL = 1,9
2521  HISTR(ITREL,NTRNEW) = HISTR(ITREL,NTRED)
      NTR = NTRNEW
      GO TO 2519
2526  IF(NTRNEW.EQ.0) GO TO 2509
      NTRLNW = HNREL(NTRNEW)
C-*-      REARRANGE BACKTRACE RESULT ARRAYS HISTR AND HNREL
      DO 2515  INR = 1,NTRLED
      HISTR(INR,NTRED) = IPOL*HISTR(INR,NTRED)
      IF(NTRED.EQ.NTRNEW.OR.INR+NTRLNW.GT.9) GO TO 2515
      HISTR(INR+NTRLNW,NTRNEW) = HISTR(INR,NTRED)
2515  CONTINUE
      IF(NTRED.EQ.NTRNEW) GO TO 2516
      HNREL(NTRNEW) = HNREL(NTRNEW) + HNREL(NTRED)
      IF(HNREL(NTRNEW).GT.9) HNREL(NTRNEW) = 9
CHECK IF SAME TRACK ELEMENT OCCURS TWICE
      NNREL = HNREL(NTRNEW)
      IF(NNREL.EQ.1) GO TO 2509
      NEWNRL = 0
      DO 2579  LNRL = 1, NNREL
      IF(LNRL.EQ.NNREL) GO TO 2577
      LLINRL = HISTR(LNRL,NTRNEW)
      NNREL2 = LNRL + 1
      DO 2578  JNRL = NNREL2,NNREL
      KLINRL = HISTR(JNRL,NTRNEW)
      IF(IABS(LLINRL).NE.IABS(KLINRL)) GO TO 2578
      GO TO 2579
2578  CONTINUE
2577  NEWNRL = NEWNRL + 1
      HISTR(NEWNRL,NTRNEW) = HISTR(LNRL,NTRNEW)
2579  CONTINUE
      HNREL(NTRNEW) = NEWNRL
      GO TO 2509
2516  CONTINUE
      IF(IPOL.EQ.-1) LABERR(NTRNEW) = LOR(LABERR(NTRNEW),LAB8)
      IF(IQQ.EQ.1) WRITE(JUSCRN,2712) (LABERR(I),I=1,NTR)
2712  FORMAT(' LABERR 2712 ',7(1X,Z8))
      GO TO 2731
2509  LABHED = LOR(LABHED,LAB80)
C-- ENTER HERE FOR DELETION OF TRACKS
      IF(NTRNEW.NE.0) GO TO 2513
      DO 2514  ITRL = 1,NTRLED
      ITRLX = HISTR(ITRL,NTRED)
      ITRLX = IABS(ITRLX)
2514  LBL(ITRLX) = LOR(LBL(ITRLX),MSKILL)
2513  IF(NTRNEW.EQ.0) GO TO 2519
      LABERR(NTRNEW) = LOR(LABERR(NTRNEW),LAB3)
2519  JTR = 0
      IF(IQQ.EQ.1) WRITE(JUSCRN,2710) (LABERR(I),I=1,NTR)
2710  FORMAT(' LABERR 2710 ',7(1X,Z8))
      DO 2511  ITR = 1,NTR
      IF(ITR.EQ.NTRED) GO TO 2511
      JTR = JTR + 1
      IF(ITR.LT.NTRED) GO TO 2511
      LABERR(JTR) = LABERR(ITR)
      NRTREL = HNREL(ITR)
      HNREL(JTR) = NRTREL
      DO 2512  INR = 1,NRTREL
2512  HISTR(INR,JTR) = HISTR(INR,ITR)
2511  CONTINUE
      NTR = NTR - 1
      NTRNEW = NTR
      IF(IQQ.EQ.1) WRITE(JUSCRN,2711) (LABERR(I),I=1,NTR)
2711  FORMAT(' LABERR 2711 ',7(1X,Z8))
2731  CONTINUE
C- - -   UPDATE ARRAY RLMTR, IF NECESSARY
      IF(NTRLM.LE.0.OR.NTRED.EQ.NTRNEW) GO TO 2739
      DO 2738  ITRLM = 1,NTRLM
      KTRR = LMRTR(1,ITRLM)
      IF(KTRR.NE.NTRED) GO TO 2738
      IF(NTRNEW.NE.0) GO TO 2737
      JTRLM = 0
      DO 2736  KTRLM = 1,NTRLM
      IF(NTRED.EQ.LMRTR(1,KTRLM)) GO TO 2736
      JTRLM = JTRLM + 1
      LMRTR(1,JTRLM) = LMRTR(1,KTRLM)
      RLMTR(2,JTRLM) = RLMTR(2,KTRLM)
      RLMTR(3,JTRLM) = RLMTR(3,KTRLM)
2736  CONTINUE
      IIILM = JTRLM
      GO TO 27399
2737  LMRTR(1,ITRLM) = NTRNEW
      GO TO 2739
2738  CONTINUE
      GO TO 2739
27399 NTRLM = IIILM
2739  CONTINUE
C - - - ZERO REMAINING ELEMENTS IN ARRAY HISTR, FOR CONVENIENCE OF EDIT
      DO 2732  ITR = 1,NTR
      INREL = HNREL(ITR)
      IF(INREL.GT.8) GO TO 2732
      INREL = INREL + 1
      DO 2733  JTR = INREL,9
2733  HISTR(JTR,ITR) = 0
2732  CONTINUE
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C---------             TRACK ELEMENT EDITING
C--
C --*--   GET TRACKELEMENT NUMBER AND NEW TRACK NUMBER
2600  IF(NN2.NE.0) NTELD = NN2
      IF(NN2.NE.0) NTRNEW = NN3
      IF(NN2.NE.0) GO TO 2699
2677  CALL TRMOUT(80,'ENTER TR.EL.&NEW TRACK (999=DELETE)^')
      CALL FYRINT(NTELD,NTRNEW,IDDD1,IDDD2)
2699  IF(NTELD.LT.1.OR.NTELD.GT.HNTR.OR.NTRNEW.EQ.0) GO TO 1601
      IF(NTRNEW.EQ.999) NTRNEW = 0
      IPOL = 1
      IF(NTRNEW.EQ.0) GO TO 2609
      LBL(NTELD) = LAND(LBL(NTELD),MSKEEP)
      IPOL = ISIGN(1,NTRNEW)
      IPOL1 = IPOL
      NTRNEW = IABS(NTRNEW)
      IF(NTRNEW.GT.NTR) NTRNEW = NTR + 1
      IF(NTRNEW.LE.100) GO TO 2609
      CALL TRMOUT(80,'NEW TRACK NUMBER EXCEEDS MAX.NUMBER OF TRACKS = 1000068900
     $0 ^')
      GO TO 1601
2609  CALL TRELTR(NTELD,NTROLD,KTR2)
      IF(NTRNEW.EQ.0) LBL(NTELD) = LOR(LBL(NTELD),MSKILL)
      IF(NTROLD.EQ.0) GO TO 2617
      IPOL = ISIGN(1,NTROLD)*IPOL
      NTROLD = IABS(NTROLD)
      NTRLED = HNREL(NTROLD)
      IF(NTRLED.GT.1) GO TO 2601
      WRITE(6,2611) NTROLD
2611  FORMAT(' THIS TRACK ELEM.IS THE ONLY ONE FOR TRACK ',I3,'. USE TRA
     $CK EDITING INSTEAD')
      GO TO 1601
2601  IF(NTRNEW.EQ.0) GO TO 2612
      IF(NTRNEW.GT.NTR) HNREL(NTRNEW) = 1
      NTRLNW = HNREL(NTRNEW)
      IF(NTRLNW.LT.9) GO TO 2612
      IF(NTROLD.EQ.NTRNEW) GO TO 2612
      WRITE (6,2613) NTRNEW
2613  FORMAT(' TRACK ',I3,' HAS ALREADY 9 TRACK ELEMENTS')
      GO TO 1601
2612  IF(IPOL1.LT.0) GO TO 2615
      IF(NTRNEW.GT.NTR) GO TO 2615
      DO 2614  IJ = 1,NTRLNW
      INTRLD = HISTR(IJ,NTRNEW)
      IF(NTELD.NE.IABS(INTRLD)) GO TO 2614
      CALL TRMOUT(80,'THIS TRACK ELEMENT IS ALREADY ASSOCIATED WITH THIS
     $ TRACK^')
      GO TO 1601
2614  CONTINUE
2615  IJ = 0
      IF(IQQ.NE.0)
     $CALL DIAGIN('NTLD NTN NTO IPL NTL',6,NTELD,NTRNEW,NTROLD,IPOL,
     $ NTRLED,NTR)
C --*--   UPDATE BACKTRACE RESULT ARRAYS
      DO 2602  ITRL = 1,NTRLED
      IIJJ = HISTR(ITRL,NTROLD)
      IF(NTELD.EQ.IABS(IIJJ)) GO TO 2602
      IJ = IJ + 1
      HISTR(IJ,NTROLD) = HISTR(ITRL,NTROLD)
2602  CONTINUE
      NTRLED = NTRLED - 1
      HNREL(NTROLD) = NTRLED
      LABERR(NTROLD) = LOR(LABERR(NTROLD),LAB1)
      LABERR(NTROLD) = LOR(LABERR(NTROLD),LAB4)
      IF(IQQ.EQ.1) WRITE(JUSCRN,2713) (LABERR(I),I=1,NTR)
2713  FORMAT(' LABERR 2713 ',7(1X,Z8))
      IF(IQQ.NE.0)
     $CALL DIAGHN('HISTR 1-6 NTROLD    ',6,HISTR(1,NTROLD),HISTR(2,NTROL
     $D),HISTR(3,NTROLD),HISTR(4,NTROLD),HISTR(5,NTROLD),HISTR(6,NTROLD)
     $)
      IF(IQQ.NE.0)
     $CALL DIAGHN('HNREL(NTROLD)       ',1,HNREL(NTROLD),HISTR(2,NTROLD)
     $,HISTR(3,NTROLD),HISTR(4,NTROLD),HISTR(5,NTROLD),HISTR(6,NTROLD))
2617  IF(NTRNEW.EQ.0) GO TO 2731
      LABERR(NTRNEW) = LOR(LABERR(NTRNEW),LAB1)
      LABERR(NTRNEW) = LOR(LABERR(NTRNEW),LAB4)
      IF(IQQ.EQ.1) WRITE(JUSCRN,2714) (LABERR(I),I=1,NTR)
2714  FORMAT(' LABERR 2714 ',7(1X,Z8))
      IF(NTRNEW.LE.NTR) GO TO 2623
      HISTR(1,NTRNEW) = NTELD*IPOL
      HNREL(NTRNEW) = 1
      GO TO 2634
C --*--   SECTION FOR INTERCHANGING TRACK ELEMENT
2623  NTRLED = HNREL(NTRNEW)
      HISTR(NTRLED+1,NTRNEW) = NTELD*IPOL
      HNREL(NTRNEW) = NTRLED+1
2634  IF(NTRNEW.GT.NTR) NTR = NTRNEW
      IF(IQQ.NE.0) WRITE(JUSCRN,2637) NTR
2637  FORMAT(' NTR AFTER TRACK ELEMENT EDITING ',I6)
      GO TO 2731
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C-------  CHANGE LIMITS IN COMMON /CPATLM/ OR COMMON /CJDRCH/ ---------I
C--
2900  IF(NN2.NE.0) GO TO 2901
      CALL TRMOUT(80,'ENTER 1 FOR CHANGE OF /CPATLM/, 2 FOR /CJDRCH/^')
      CALL FYRINT(KK,KK2,KK3,KK4)
      IF(KK2.EQ.0) GO TO 2999
      NN = KK
      NN2 = KK2
      NN3 = KK3
      NN4 = KK4
      GO TO 1603
2999  NN2 = KK
2901  IF(NN2.NE.1.AND.NN2.NE.2) GO TO 1601
      CALL CHANGE(NN2)
      IXBKKR = IXBKK(40)
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C-------  CREATE BACKTRACE AND MIDOUT ARRAYS FROM PREVIOUS JHTL BANK --I
C--
3000  CALL TRMOUT(80,'ENTER YES TO CONFIRM RESTORING INTENTION^')
      CALL DECIDE(IANSW)
      IF(IANSW.NE.1) GO TO 1601
      IF(NN2.NE.0) GO TO 3021
      CALL TRMOUT(80,' ENTER BOS NUMBER OF DESIRED HIT LABEL ARRAY:^')
      CALL FYRINT(KK,KK2,KK3,KK4)
      IF(KK2.EQ.0) GO TO 3099
      NN = KK
      NN2 = KK2
      NN3 = KK3
      NN4 = KK4
      GO TO 1603
3099  NBOS = KK
      GO TO 3022
3021  NBOS = NN2
3022  CALL CLOC(IPJHN,'JHTL',NBOS)
      IF(IPJHN.GT.0) GO TO 3023
      CALL TRMOUT(80,'BANK JHTL WITH THIS NUMBER DOES NOT EXIST^')
      GO TO 1601
3023  CALL RSTBTR(IPJHN)
      GO TO 2671
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C-------  RESULT DISPLAY OF ALREADY EXISTING PATR BANKS ---------------I
C--
3100  IF(NN2.NE.0) GO TO 3101
      CALL TRMOUT(80,'PLEASE ENTER DESIRED BANK NUMBER^')
      CALL FYRINT(KK,KK2,KK3,KK4)
      IF(KK2.EQ.0) GO TO 3199
      NN = KK
      NN2 = KK2
      NN3 = KK3
      NN4 = KK4
      GO TO 1603
3199  NN2 = KK
3101  REM = ACMD
      BREM = BCMD
      ACMD = FLOAT(NN2)
      CALL RSDISP(ISTANV)
      IF(ISTANV.EQ.13) CALL YAMADA(0)
      ACMD = REM
      BCMD = BREM
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C-------  DISPLAY PROJECTIONS OF ZX AND ZY VIEWS ---------------I
C--
3200  CALL PROJEC(ISTANV)
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C<><><><><>_____ CREATE NEW TRACK ELEMENT ______________<><><><><><><>
C--
3300  IF(HNTR.LT.200) GO TO 3301
      CALL TRMOUT(80,'MAXIMUM NUMBER OF TRACK ELEMENTS ALREADY EXISTS^')
       GO TO 1601
3301  IF(ISTANV.LE.3.OR.ISTANV.EQ.14) GO TO 3302
      CALL TRMOUT(80,'ELEMENTS CAN ONLY BE CREATED IN R-FI VIEWS.^')
      GO TO 1601
3302  IF(NN2.NE.0) NTRNEW = NN2
      IF(NN2.NE.0) GO TO 3365
      CALL TRMOUT(80,'ENTER TRACK DESTINATION (POSITIV!)^')
      CALL FYRINT(KK,KK2,KK3,KK4)
      IF(KK2.EQ.0) GO TO 3399
      NN = KK
      NN2 = KK2
      NN3 = KK3
      NN4 = KK4
      GO TO 1603
3399  NTRNEW = KK
      IF(NTRNEW.EQ.0) GO TO 1601
3365  NTRNEW = IABS(NTRNEW)
      IF(NTRNEW.GT.NTR) NTRNEW = NTR+1
      IF(NTRNEW.LE.100) GO TO 3318
      CALL TRMOUT(80,' ALREADY 100 TRACKS !^')
      GO TO 1601
3318  IF(HNREL(NTRNEW).LT.9) GO TO 3317
      CALL TRMOUT(43,'THIS TRACK HAS ALREADY NINE TRACK ELEMENTS !')
      GO TO 1601
3317  IF(NN2.EQ.0) CALL TRMOUT(80,'GIVE JOYSTICK INPUT:^')
      CALL VCURSR(HDUM,XIN,YIN)
      XIN = - XIN
      CALL MOVEA(-XIN-20.,YIN-20.)
      CALL DRAWA(-XIN+20.,YIN+20.)
      CALL MOVEA(-XIN+20.,YIN-20.)
      CALL DRAWA(-XIN-20.,YIN+20.)
      RIN = SQRT(XIN*XIN + YIN*YIN)
      CALL TRMOUT(80,'---^')
CHECK IF INSIDE SENSITIVE VOLUME OF DETECTOR AND DETERMINE RING NUMBER
      DO 3304 IRING = 1,3
      IF(RIN.GT.FIRSTW(IRING)-5..AND.RIN.LT.
     $ FIRSTW(IRING)+16.*RINCR(IRING)+5.) GO TO 3305
3304  CONTINUE
      CALL TRMOUT(80,'THIS POINT IS NOT INSIDE THE SENSITIVE VOLUME.^')
      GO TO 1601
3305  FIN = ATAN2(YIN,XIN)
      IF(FIN.LT.0.) FIN = FIN + TWOPI
      FIDEL = TWOPI/NCELL(IRING)
      KCELL = FIN/FIDEL + 1
      KCELL = KCELL + (IRING-1)*24
C  ADRESSES IN HDATA
      NILOW = HDATA(KCELL + IPJ)
      NIHIGH = HDATA(IPJ + KCELL + 1)
      NILOW = NILOW + IPJ + 98
      NIHIGH = NIHIGH + IPJ + 98
      IF(IQQ.NE.0) WRITE(JUSCRN,3321) KCELL,IRING,FIN,XIN,YIN
3321  FORMAT(' ** ',2I5,3E11.4)
      IF(NIHIGH-NILOW.GT.3) GO TO 3306
      CALL TRMOUT(80,'NO HITS IN THIS CELL !^')
      GO TO 1601
3306  NIHIGH = NIHIGH - 1
      NTELD = 0
      DISTMN = 10000.
      NI = NILOW
3307  IF(NI.GE.NIHIGH) GO TO 3311
      NIJ = NI
      IVVX = 0
      CALL FICOOR(IVVX,NI,NWE)
      ISGN = 1
      DIST = (XIN-X1)*(XIN-X1) + (YIN-Y1)*(YIN-Y1)
      IF(IQQ.NE.0) WRITE(JUSCRN,3322) DIST,DISTMN,X1,Y1,X2,Y2
3322  FORMAT(' DIST,MN XY12 ',6E11.4)
3308  IF(DIST.GE.DISTMN) GO TO 3309
      DISTMN = DIST
      NTELD = NIJ*ISGN
3309  IF(ISGN.EQ.-1) GO TO 3307
      ISGN = -1
      DIST = (XIN - X2)*(XIN - X2) + (YIN - Y2)*(YIN - Y2)
      IF(IQQ.NE.0) WRITE(JUSCRN,3327) DIST,DISTMN,ISGN
3327  FORMAT(' DIST DISTMN ISGN ',2E11.4,I5)
      GO TO 3308
3311  IF(DISTMN.LT.100.) GO TO 3310
      CALL TRMOUT(80,'NO HITS CLOSE TO THE INPUT POINT ! CLOSE WALL -->>
     $ WRONG CELL ?^')
      GO TO 1601
3310  NTRNEW = NTRNEW * ISIGN(1,NTELD)
      IF(IQQ.NE.0) WRITE(JUSCRN,3398) NTRNEW,NTELD
3398  FORMAT(' NTRNEW AND NTELD ',2I6)
      NIJ = IABS(NTELD)
      CALL FICOOR(IVVX,NIJ,NWE)
      XX = X1
      YY = Y1
      IF(NTELD.LT.0) XX = X2
      IF(NTELD.LT.0) YY = Y2
      CALL CRTREL(NTELD,IERR)
      IF(IERR.NE.0) GO TO 3499
      CALL TRNUMB(NTELD,1,XX,YY,DM)
      NTRED = NTRNEW
      GO TO 2699
3499  CALL TRMOUT(80,' ERROR IN CREATING THE TRACK ELEMENT ^')
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C ****************************************************************
C **    SWITCH ON/OFF AUTOMATIC DELETION OF LOW ENERGY TRACKS    *
C ****************************************************************
3400  IYBKK(14) = IYBKK(14) - 1
      IF(IYBKK(14).LT.0) IYBKK(14) = 1
      IF(IYBKK(14).EQ.0) CALL TRMOUT(80,'IYBKK(14)=0, LOW ENERGY TRACKS
     $ WILL NOT BE AUTOMATICALLY DELETED ^')
      IF(IYBKK(14).EQ.1) CALL TRMOUT(80,'IYBKK(14)=1, LOW ENERGY TRACKS
     $ WILL BE AUTOMATICALLY DELETED ^')
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C--       SAVE/RECOVER  CWORK CONTENT ON SCRATCH DISK FILE
C--
3500  IF(NN2.NE.0) GO TO 3501
      CALL TRMOUT(80,'PLEASE ENTER 1 TO SAVE CWORK ONTO DISK^')
      CALL TRMOUT(80,'OR 2 TO RETRIEVE DISK AND RESET CWORK.^')
      CALL FYRINT(KK,KK2,KK3,KK4)
      IF(KK2.EQ.0) GO TO 3599
      NN = KK
      NN2 = KK2
      NN3 = KK3
      NN4 = KK4
      GO TO 1603
3599  NN2=KK
3501  IF(NN2.EQ.1.OR.NN2.EQ.2) GO TO 3502
      CALL TRMOUT(80,'NONEXISTING OPTION ^')
      GO TO 1601
3502  CALL RETTEN(NN2)
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C--  ACTIVATE/DEACTIVATE M.GODDARDS AUTOMATIC EDITING OPTION
C--
3600  IMCERT = IMCERT - 1
      IF(IMCERT.LT.0) IMCERT = 1
      IF(IMCERT.EQ.0) CALL TRMOUT(80,'IMCERT=0, OVERLAPPING TRACKS WILL
     $ NOT BE AUTOMATICALLY DELETED ^')
      IF(IMCERT.EQ.1) CALL TRMOUT(80,'IMCERT=1, OVERLAPPING TRACKS WILL
     $ AUTOMATICALLY BE DELETED ^')
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C----ACTIVATE / DEACTIVATE HIT DISPLAY WITH TRACK OR TR.ELEMENT NUMBERS
C--
3700  TRHIT = .NOT.TRHIT
      GO TO 1601
3800  TLHT = .NOT.TLHT
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C----SET INNER AND OUTER RANGE LIMITS FOR HITS BELONGING TO A TRACK
C--
3900  IF(NN2.NE.0) KTR = NN2
      IF(NN2.NE.0) GO TO 3951
      CALL TRMOUT(80,'ENTER TRACK NUMBER^')
      CALL FYRINT(KK,KK2,KK3,KK4)
      IF(KK2.EQ.0) GO TO 3959
      NN = KK
      NN2 = KK2
      NN3 = KK3
      NN4 = KK4
      GO TO 1603
3959  KTR = KK
3951  IF(KTR.LE.0.OR.KTR.GT.NTR) GO TO 1601
      ITRLM = 0
      IF(NTRLM.EQ.0) GO TO 3954
      DO 3955 IH = 1,NTRLM
3955  IF(LMRTR(1,IH).EQ.KTR) ITRLM = IH
      IF(ITRLM.NE.0) GO TO 3952
3954  NTRLM = NTRLM + 1
      CALL TRMOUT(80,' ^')
      ITRLM = NTRLM
      IF(NTRLM.LE.5) GO TO 3952
      CALL TRMOUT(80,'ERROR... ALL POSITIONS ALREADY OCCUPIED!^')
      GO TO 1601
3952  IF(NN2.EQ.0)
     $ CALL TRMOUT(80,'ENTER INNER & OUTER LIMITS (JOYSTICK)^')
      DO 3953  IH = 1,2
      CALL VCURSR(HDUM,XIN,YIN)
      CALL MOVEA(XIN-20.,YIN-20.)
      CALL DRAWA(XIN+20.,YIN+20.)
      CALL MOVEA(XIN+20.,YIN-20.)
      CALL DRAWA(XIN-20.,YIN+20.)
      RIN = SQRT(XIN*XIN + YIN*YIN)
3953  RLMTR(1+IH,ITRLM) = RIN
      LMRTR(1,ITRLM) = KTR
      IF(RLMTR(2,ITRLM).LT.RLMTR(3,ITRLM)) GO TO 3949
      VAG = RLMTR(2,ITRLM)
      RLMTR(2,ITRLM) = RLMTR(3,ITRLM)
      RLMTR(3,ITRLM) = VAG
3949  IF(IQQ.NE.0) WRITE(6,3961) KTR,NTRLM,ITRLM,RLMTR(2,ITRLM),RLMTR(3,
     $ITRLM)
3961  FORMAT(' KTR NTRLM ITRLM R1-2 ',3I5,2E12.4)
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C--------------------------CALL SUBROUTINE SPARE------I
C--
4000  ACMDR = ACMD
      BCMDR = BCMD
      ACMD = FLOAT(NN2)
      CALL SPARE
      ACMD = ACMDR
      BCMD = BCMDR
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C
C  DEBUG PRINT SECTION, NOT IN NORMAL CODE LIST !
C
4100  IF(NN2.EQ.0) GO TO 3901
      IPPATR=IDATA(IPATR)
      WRITE (JUSCRN,3002) IPPATR,ACMD,IDATA(IPPATR-1)
     ,,IDATA(IPPATR-2)
3002  FORMAT(' IPPATR ACMD IDATA-1-2 ',I6,E11.4,2I8)
      WRITE (JUSCRN,3003) LASTVW,ISTANV,FL18,FL22
      WRITE (JUSCRN,3004) XMIN,YMIN,XMAX,YMAX
      WRITE (JUSCRN,3005) SXIN,SYIN,SXAX,SYAX
3003  FORMAT(' LASTVW ISTANV DSPT 18 -22 ',4I4)
3004  FORMAT(' XYMIN XYMAX ',4E12.4)
3005  FORMAT(' SXYIN SXYAX ',4E12.4)
      GO TO 1601
3901  IQQ = 1
      IF(NDDOUT.EQ.0) GO TO 1602
      CALL TRMOUT(80,'ENTER YES TO CONFIRM PRINT OPTION !^')
      CALL DECIDE(IANSW)
      IF(IANSW.EQ.1) GO TO 1602
      GOTO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C--------------------------TRACK ELEMENT DISPLAY SECTION------I
C--
C--  LOOP OVER NR OF WORDS IN EVENT
222   NI = IPJ + 95
      IHIT = 0
      HIHIT = -1
      NTRCL1 = HNTCEL(25) - 1
      NTRCL2 = HNTCEL(49) - 1
      MICKY = 0
      DO 8765  IZ = 1,200
      XLTR(IZ) = 0.
8765  YLTR(IZ) = 0.
802   CALL ERASE
      IF(HALO.EQ.1) CALL JADISP(ISTANV)
C---     WRITE OUT EVENT CAPTION.
      CALL CAPMRK(ISTANV,IESUM)
C---     WRITE PATREC CAPTION
      XXX = .55*(XMAX-XMIN) + XMIN
      YYY = .72*(YMAX-YMIN) + YMIN
      CALL MOVEA(XXX,YYY)
      CALL CORE(HWORK,42)
      WRITE(10,6799) NTR,HNTR
6799  FORMAT(' NR OF TRACKS ',I3,'    NR OF TR.ELEMENTS ',I3)
      CALL EOUTST(42,HWORK)
      IF(DSPDTL(17).AND.(ISTANV.LT.4.OR.ISTANV.EQ.14))
     $ CALL PROJEC(ISTANV)
      IF((NN.GT.16.AND.NN.LT.21).OR.NN.EQ.28) GO TO 801
224   NI = NI + 4
201   IHIT = IHIT + 1
      IF(IHIT.GT.NHITS) GO TO 2055
      HIHIT = HIHIT + 2
      IHIT1 = HIHIT
      IHIT2 = HIHIT + 1
      HELP(2) = HWRK(HPHL0+IHIT1-1)
      IF(IQQ.NE.0) WRITE(6,7500) IHIT,NI,HELP(2)
7500  FORMAT(' IHIT,NI,HELP2 ',2I8,2X,Z4)
      IF(LABL.EQ.0.AND.JNDX.EQ.2) GO TO 221
      IF(LABL.EQ.0.AND.JNDX.NE.2) GO TO 224
      IF(JNDX.EQ.1.OR.JNDX.EQ.3) GO TO 221
      IF(TBIT(LABL,20).AND.(JNDX.EQ.4.OR.JNDX.EQ.6)) GO TO 221
      IF(.NOT.TBIT(LABL,20).AND.JNDX.EQ.5) GO TO 221
      GO TO 224
221   ITRP = 1
      ITREL = LAND(LABL,MSKTR1)
      ITREL = SHFTR(ITREL,1)
      IF(IQQ.NE.0)
     $ CALL DIAGIN('JNDX ITREL IHIT NI  ',4,JNDX,ITREL,IHIT,NI,I,I)
      IF(JNDX.NE.3.AND.JNDX.NE.6) GO TO 2233
      DO 9255  IKT = 1,IKTR
9255  IF(HKTRAR(IKT).EQ.ITREL) GO TO 2233
      GO TO 224
2233  ISGN = 0
      IF(IQQ.NE.0) WRITE(6,2575) LABL,ITREL
2575  FORMAT(' LABL,ITREL ',Z4,I8)
      IF(JNDX.LT.4.OR..NOT.TBIT(LABL,20)) GO TO 223
      IF(ITRP.EQ.1.AND.TBIT(LABL,23)) ISGN = 1
C     IF(ITRP.EQ.2.AND.TBIT(LABL,19)) ISGN = 1
      IF(ITRP.EQ.1.AND..NOT.TBIT(LABL,23)) ISGN = -1
C     IF(ITRP.EQ.2.AND..NOT.TBIT(LABL,19)) ISGN = -1
223   IF(IQQ.NE.0) WRITE(6,2576) LABL,ITRP,ISGN
2576  FORMAT(' LABL,ITRP,ISGN ',Z4,2I8)
      IVVX = 0
      IF(ISTANV.GT.3.AND.ISTANV.LT.12) IVVX = 1
      IF(ISTANV.EQ.14) IVVX = 2
      NWIR = HDATA(NI)
      NWIR = SHFTR(NWIR,3)
      IRNG = NWIR/384
      IF(IRNG.GT.2) IRNG = 2
      IF(IRNG.GT.0) MICKY = NTRCL1
      IF(IRNG.GT.1) MICKY = NTRCL2
      KZAMP = 0
      CALL FICOOR(IVVX,NI,NWE)
      IF(NWE.LT.-500) GO TO 225
      IF(ISTANV.LT.4.OR.ISTANV.EQ.14) GO TO 7589
      IF(DSPDTL(9)) Y0 = R
C      GET PROJECTED Y-COORDINATE
       IF(ISTANV.LE.7) YPRO =  R*COS(FI)
       IF(ISTANV.GT.7) YPRO =  R*SIN(FI)
      IF(.NOT.DSPDTL(9)) Y0 = YPRO
      IF(JNDX.EQ.2) GO TO 2205
      XLTR(ITREL+MICKY) = - ZET
      YLTR(ITREL+MICKY) = Y0
2205  CALL HITMRK( JNDEX, ZET, Y0, 4.0, 0 )
      GO TO 205
C     CONVERSION TO XY OF PICTURE
7589  IF(ISGN.LT.0) GO TO 204
      IF(JNDX.EQ.2) GO TO 2206
      XLTR(ITREL+MICKY) = X1
      YLTR(ITREL+MICKY) = Y1
2206  CALL HITMRK( ISTANV, -X1, Y1, 4.0, 0 )
204   IF(ISGN.GT.0) GO TO 205
      IF(JNDX.EQ.2) GO TO 2207
      XLTR(ITREL+MICKY) = X2
      YLTR(ITREL+MICKY) = Y2
2207  CALL HITMRK( ISTANV, -X2, Y2, 4.0, 0 )
205   IF(IQQ.NE.0) WRITE(6,207) ITREL,IRNG,NWE,X1,Y1,X2,Y2
207   FORMAT(' TREL&RING&NWE ',3I4,' XY1 XY2 ',4F10.2)
      IF(NI.LE.(IPJ+NWO)) GO TO 201
      IF(JNDX.EQ.2) GO TO 225
C** WRITE OUT TRACK ELEMENT NUMBERS ON SCREEN
2055  IF(IQQ.NE.0) WRITE(6,2057) HNTR
2057  FORMAT(' HNTR = ',I10)
      DO 9876  II = 1,HNTR
      XXPR = XLTR(II)
      YYPR = YLTR(II)
      IF(ABS(XXPR).LT..1.AND.ABS(YYPR).LT..1) GO TO 9876
      ITTREL = NTREL(II)
      CALL TRNUMB(ITTREL,0,XXPR,YYPR,DM)
9876  CONTINUE
225   IF(ISTANV.GT.1..AND.ISTANV.LT.4) CALL PBGRFI(SH1,SH2,SH3,DEFIX)
      IF(ISTANV.GT.4..AND.ISTANV.LT.12.AND.ISTANV.NE.8)
     $ CALL PBGRZ(ISTANV,SH1,SH2,SH3)
      IF(ISTANV.EQ.14) CALL PBGCYL(DEFIX)
      IF(ISTANV.LT.4) CALL HODRFI
      GO TO 1601
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C--------------------------TRACK DISPLAY SECTION------I
C--
801   GO TO (810,810,813,810,815), KNDX
810   CONTINUE
      DO 823  ITR = 1,NTR
823   HKTRAR(ITR) = ITR
      IKTR = NTR
      GO TO (811,812,813,814), KNDX
811   CALL HITDSP(IKTR,0,0,0,TRHIT,TLHT,JNDEX,REMEMB,REMB1,IQQ)
      GO TO 225
812   CALL HITDSP(IKTR,1,1,0,TRHIT,TLHT,JNDEX,REMEMB,REMB1,IQQ)
      GO TO 225
814   CALL HITDSP(IKTR,0,0,1,TRHIT,TLHT,JNDEX,REMEMB,REMB1,IQQ)
      CALL HITDSP(IKTR,1,1,0,TRHIT,TLHT,JNDEX,REMEMB,REMB1,IQQ)
      GO TO 225
813   IF(NN2.EQ.0) GO TO 824
      CALL HITDSP(IKTR,0,0,1,TRHIT,TLHT,JNDEX,REMEMB,REMB1,IQQ)
827   IKL = 0
      IF(IKTRS.LE.0) GO TO 1601
      DO 825  ITR = 1,NTR
      DO 826  IKS = 1,IKTRS
826   IF(ITR.EQ.HKTRS(IKS)) GO TO 825
      IKL = IKL + 1
      HKTRAR(IKL) = ITR
825   CONTINUE
      IKTR = IKL
      GO TO 811
824   IKTRS = 0
828   CALL TRMOUT(80,'ENTER TRACK NR.^')
      CALL FYRINT(KTR,NN2,NN3,NN4)
      IF(NN2.EQ.0) GO TO 8281
      NN = KTR
      GO TO 1603
8281  IF(KTR.LE.0.OR.KTR.GT.NTR) GO TO 827
      IKTRS = IKTRS + 1
      IF(IKTRS.GT.NTR) GO TO 225
      HKTRS(IKTRS) = KTR
      HKTRAR(1) = KTR
      CALL HITDSP(1,0,0,1,TRHIT,TLHT,JNDEX,REMEMB,REMB1,IQQ)
      GO TO 828
815   IF(NN2.EQ.0) GO TO 834
      CALL HITDSP(IKTR,0,1,1,TRHIT,TLHT,JNDEX,REMEMB,REMB1,IQQ)
831   CALL HITDSP(IKTR,1,1,0,TRHIT,TLHT,JNDEX,REMEMB,REMB1,IQQ)
      GO TO 225
834   IKTR = 0
838   IF(IKTR.GT.NTR) GO TO 225
      CALL TRMOUT(80,'ENTER TRACK NR.^')
      CALL FYRINT(KTR,NN2,NN3,NN4)
      IF(NN2.EQ.0) GO TO 8381
      NN = KTR
      GO TO 1603
8381  IF(KTR.LE.0.OR.KTR.GT.NTR) GO TO 837
      IKTR = IKTR + 1
      HKTRS(IKTR) = KTR
      HKTRAR(1) = KTR
      CALL HITDSP(1,0,1,1,TRHIT,TLHT,JNDEX,REMEMB,REMB1,IQQ)
      GO TO 838
837   IF(KTR.LE.0) GO TO 8371
      IKTR = 0
      DO 8372  IKT = 1,NTR
      IKTR = IKTR + 1
      HKTRS(IKTR) = IKT
      HKTRAR(1) = IKT
8372  CALL HITDSP(1,0,1,1,TRHIT,TLHT,JNDEX,REMEMB,REMB1,IQQ)
8371  IF(IKTR.LE.0) GO TO 1601
      DO 839  IKT = 1,IKTR
839   HKTRAR(IKT) = HKTRS(IKT)
      GO TO 831
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
C--
C------------------------------ ACTIONS BEFORE LEAVING EDITING -------
C--
100   CALL TRMOUT(80,'DO YOU REALLY WANT TO LEAVE ?^')
      CALL DECIDE(IANSW)
      IF(IANSW.NE.1) GO TO 1601
      ILEAVE = 0
      CALL TRMOUT(80,'SHALL PATREC RESULTS BE SAVED IN BANKS?^')
      CALL DECIDE(IANSW)
      IF(IANSW.EQ.1) GO TO 95
      CALL TRMOUT(80,'ENTER YES TO DESTROY YOUR EDIT WORK !^')
      CALL DECIDE(IANSW)
      IF(IANSW.NE.1) GO TO 100
9000  IPJHTL=IDATA(IJHTL)
      NBOS = IDATA(IPJHTL-2)
      CALL BDLS(JHTL,NBOS)
      IPPATR=IDATA(IPATR)
      NBOS = IDATA(IPPATR-2)
      CALL BDLS(NPATR,NBOS)
      GO TO 9999
C--------
95    ILEAVE = 1
C     CALL RETTEN(1)
      IPJHTL=IDATA(IJHTL)
      NBNK = IDATA(IPJHTL-2)
      IPPATR=IDATA(IPATR)
      NBNK2 = IDATA(IPPATR-2)
      WRITE(6,3335) NBNK,NBNK2
3335  FORMAT(' EDITED BANKS  JHTL ',I2,' AND PATR ',I2,' HAVE BEEN CREAT
     $ED')
C
C            LOOP OVER TRACKS, WRITE BANKS
C
      IF(NTR.LE.0) GO TO 980
C
C     MEMORIZE 1. FREE LOC. IN CWORK
      HPFRE0 = HPFREE
C
      DO 7876 I = 1,NTR
7876  HKTRAR(I) = I
      CALL TRLORD
      CALL KNTREL(HKTRAR,NTR)
      IPPATR=IDATA(IPATR)
      IPJHTL=IDATA(IJHTL)
C              SET EDITING MARKER
      IPTRBK = IPPATR + LHEAD
      NTR   = IDATA(IPPATR+ 2)
      DO 7877 ITR = 1,NTR
      IDATA(IPTRBK+LTRBK) = LOR(IDATA(IPTRBK+LTRBK),LABERR(ITR))
      LABHED = LOR(IDATA(IPTRBK+LTRBK),LABHED)
C     INCREASE POINTER TO TRACK BANK
7877  IPTRBK = IPTRBK + LTRBK
C
980   IDATA(IPPATR+LHEAD) = LOR(LABHED,IDATA(IPPATR+LHEAD))
C
C-- PROMPT SCANNER FOR HIS OPINION AND INFORMATION ON BAD TRACKS
969   CALL TRMOUT(80,'DO YOU THINK THAT THE TRACK ANALYSIS OF THIS EVENT
     $ IS CORRECT ?^')
      CALL DECIDE(IANSW)
      IF(IANSW.EQ.1) GO TO 9999
      KITR = 0
970   CALL TRMOUT(80,'PLEASE ENTER FAULTY TRACK NUMBER;  ENTER 0 TO FINI
     $SH SEQUENCE^')
      ITR = TERNUM(DUM)
      IF(ITR.GE.0.AND.ITR.LE.NTR) GO TO 971
974   CALL TRMOUT(80,'NON-EXISTING TRACK NUMBER ENTERED, TRY AGAIN !^')
      GO TO 970
971   IF(ITR.GT.0) GO TO 972
      IF(KITR.GT.0) GO TO 9999
      CALL TRMOUT(80,'ATTEMPT TO FINISH WITHOUT GIVING FAULTY TRACK NR.,
     $ BACK TO BEGIN AGAIN^')
      GO TO 969
972   KITR = KITR + 1
      IPPATR=IDATA(IPATR)
      IF(KITR.EQ.1) IDATA(IPPATR+LHEAD) = BITON(IDATA(IPPATR+LHEAD),0)
C  MARK THE FAULTY NUMBER
      LO = IPPATR-40
      DO 973  JTR = 1,NTR
      LO = LO + 48
      IF(IQQ.EQ.1) WRITE(JUSCRN,2879) IPPATR,LO,ITR,IDATA(LO+1),IDATA(LO
     $+48)
2879  FORMAT(' IPPATR LO ITR IDLO1 IDLO48 ',4I6,2X,Z8)
      IF(IDATA(LO+1).NE.ITR) GO TO 973
      IDATA(LO+48) = BITON(IDATA(LO+48),0)
      IDATA(LO+48) = LOR(IDATA(LO+48),LAB0)
      GO TO 970
973   CONTINUE
      GO TO 974
C*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
9999  ISTANV = ISTOLD
      LASTVW = LSTOLD
      SXIN = SXINR
      SYIN = SYINR
      SXAX = SXAXR
      SYAX = SYAXR
      FL22 = DSP22
      FL24 = DSP24
      DSPDTL(28) = DSP28
      DSPDTL(26) = DSP26
      DSPDTL(20) = DSP20
      DSPDTL(17) = DSP17
      DSPDTL(14) = DSP14
      DSPDTL(4) = DSP4
      IXBKK(40) = IXBKKR
      CALL SETSCL(LASTVW)
      IXYF(1) = IGPLIM
      IGFP(1) = IGPLM7
      IMCERT = LMCERT
      DSPDTL(10) = REMB1
      DSPDTL(6) = REMEMB
C     IF(ILEAVE.EQ.1) CALL TRMOUT(80,'CHECK YOUR CREATED PATR BANK TO SE
C    $E THAT IT HAS REALLY BEEN CREATED!^')
      IF(ILEAVE.EQ.1) CALL TRMOUT(80,'USE COMMAND WRIT TO WRITE !^')
      RETURN
      END
