C   23/05/79 C9052301   MEMBER NAME  PARCHN1  (JADEGS)      FORTRAN
      SUBROUTINE PARCHN
      IMPLICIT INTEGER*2 (H)
C--
C--      ALLOWS SCANNER TO CHANGE MONTE CARLO PARAMETERS.
C--
      LOGICAL FREE
#include "cgraph.for"
#include "cbin.for"
#include "clbpgm.for"
      COMMON/CWORK/HWORK(40),IANSW
      DIMENSION ICBIN(19),ACBIN(19),AFREE(4)
      EQUIVALENCE (ICBIN(1),TIME(1))
      EQUIVALENCE (ACBIN(1),TIME(1))
      DATA AFREE1/'FREE'/
      DATA AFREE2/'    '/
      DATA AFREE3/'FROZ'/
      DATA AFREE4/'EN  '/
*** PMF 17/11/99: add variables needed for emulation of DESYLIB routine 'CORE'  
      CHARACTER cHWORK*80
      EQUIVALENCE (cHWORK,HWORK(1))
*** PMF(end)
      AFREE(1)=AFREE1
      AFREE(2)=AFREE2
      AFREE(3)=AFREE3
      AFREE(4)=AFREE4
C---
C---     SET FLAG TELLING MONTE CARLO READ TO LOOK AT CBIN CONTENTS.
C---
      IREADM=2
      CALL TRMOUT(80,'M.C. PARAMETER CHANGE ROUTINE.^')
    1 CONTINUE
      LOOP=0
      CALL TRMOUT(80,'PLEASE ENTER INDEX OF PARAMETER TO BE CHANGED.^')
      CALL TRMOUT(80,'ZERO OR RETURN GIVES INDEX KEY.^')
      CALL TRMOUT(80,'MINUS ONE GIVES ALL CURRENT VALUES.^')
      CALL TRMOUT(80,'100 PLUS THE INDEX FREES THE PARAMETER SO THAT^')
      CALL TRMOUT(80,'WHEN CONSTANTS RECORDS ARE ENCOUNTERED THEY SET^')
      CALL TRMOUT(80,'THE PARAMETER.^')
      CALL TRMOUT(80,'200 FREES ALL PARAMETERS.^')
    4 CONTINUE
      INDEX=TERNUM(DUMMY)
      IF(INDEX.NE.200) GO TO 15
      IREADM=1
      DO 16 I=1,19
      FREEZE(I)=.FALSE.
   16 CONTINUE
      CALL TRMOUT(80,'ALL PARAMETERS FREED.^')
      RETURN
   15 CONTINUE
      FREE=.FALSE.
      IF(INDEX.GT.100) FREE=.TRUE.
      IF(FREE) INDEX=INDEX-100
      IF((INDEX.GE.1).AND.(INDEX.LE.23)) GO TO 5
      IF(INDEX.EQ. 0) GO TO 2
      IF(INDEX.EQ.-1) GO TO 6
      CALL TRMOUT(80,'ILLEGAL INDEX. PLEASE ENTER AGAIN.^')
      GO TO 4
    6 CONTINUE
      LOOP=1
      INDEX=1
      GO TO 5
    2 CONTINUE
      CALL TRMOUT(80,' 1 -  6  TIME ARRAY^')
      CALL TRMOUT(80,'      7  ZOF^')
      CALL TRMOUT(80,'      8  ZRS^')
      CALL TRMOUT(80,'      9  ZL^')
      CALL TRMOUT(80,'     10  ZSC^')
      CALL TRMOUT(80,'11 - 13  EPSI ARRAY^')
      CALL TRMOUT(80,'14 - 16  DOUB ARRAY^')
      CALL TRMOUT(80,'17 - 19  IRN ARRAY^')
      CALL TRMOUT(80,'     20  ENTIRE TIME ARRAY^')
      CALL TRMOUT(80,'     21  ENTIRE EPSI ARRAY^')
      CALL TRMOUT(80,'     22  ENTIRE DOUB ARRAY^')
      CALL TRMOUT(80,'     23  ENTIRE IRN ARRAY^')
  101 FORMAT('PARAMETER TIME(1). CURRENT VALUE=',F12.4,'  ',2A4)
  102 FORMAT('PARAMETER TIME(2). CURRENT VALUE=',F12.4,'  ',2A4)
  103 FORMAT('PARAMETER TIME(3). CURRENT VALUE=',F12.4,'  ',2A4)
  104 FORMAT('PARAMETER TIME(4). CURRENT VALUE=',F12.4,'  ',2A4)
  105 FORMAT('PARAMETER TIME(5). CURRENT VALUE=',F12.4,'  ',2A4)
  106 FORMAT('PARAMETER TIME(6). CURRENT VALUE=',F12.4,'  ',2A4)
  107 FORMAT('PARAMETER     ZOF. CURRENT VALUE=',F12.4,'  ',2A4)
  108 FORMAT('PARAMETER     ZRS. CURRENT VALUE=',F12.4,'  ',2A4)
  109 FORMAT('PARAMETER      ZL. CURRENT VALUE=',F12.4,'  ',2A4)
  110 FORMAT('PARAMETER     ZSC. CURRENT VALUE=',F12.4,'  ',2A4)
  111 FORMAT('PARAMETER EPSI(1). CURRENT VALUE=',F12.4,'  ',2A4)
  112 FORMAT('PARAMETER EPSI(2). CURRENT VALUE=',F12.4,'  ',2A4)
  113 FORMAT('PARAMETER EPSI(3). CURRENT VALUE=',F12.4,'  ',2A4)
  114 FORMAT('PARAMETER DOUB(1). CURRENT VALUE=',F12.4,'  ',2A4)
  115 FORMAT('PARAMETER DOUB(2). CURRENT VALUE=',F12.4,'  ',2A4)
  116 FORMAT('PARAMETER DOUB(3). CURRENT VALUE=',F12.4,'  ',2A4)
  117 FORMAT('PARAMETER  IRN(1). CURRENT VALUE=',I12,  '  ',2A4)
  118 FORMAT('PARAMETER  IRN(2). CURRENT VALUE=',I12,  '  ',2A4)
  119 FORMAT('PARAMETER  IRN(3). CURRENT VALUE=',I12,  '  ',2A4)
  120 FORMAT('ARRAY        TIME. ALL VALUES=   ',F12.4,'  ',2A4)
  121 FORMAT('ARRAY        EPSI. ALL VALUES=   ',F12.4,'  ',2A4)
  122 FORMAT('ARRAY        DOUB. ALL VALUES=   ',F12.4,'  ',2A4)
  123 FORMAT('ARRAY         IRN. ALL VALUES=   ',I12,  '  ',2A4)
      CALL TRMOUT(80,'PLEASE ENTER INDEX YOU WISH.^')
      GO TO 4
    5 CONTINUE
      CALL CORE(HWORK,80)
      JNDEX=INDEX
      IF(INDEX.EQ.20) JNDEX=1
      IF(INDEX.EQ.21) JNDEX=11
      IF(INDEX.EQ.22) JNDEX=14
      IF(INDEX.EQ.23) JNDEX=17
      L1=1
      IF(FREEZE(JNDEX)) L1=3
      L2=L1+1
      IF(INDEX.EQ. 1) WRITE(cHWORK,101) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ. 2) WRITE(cHWORK,102) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ. 3) WRITE(cHWORK,103) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ. 4) WRITE(cHWORK,104) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ. 5) WRITE(cHWORK,105) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ. 6) WRITE(cHWORK,106) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ. 7) WRITE(cHWORK,107) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ. 8) WRITE(cHWORK,108) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ. 9) WRITE(cHWORK,109) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.10) WRITE(cHWORK,110) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.11) WRITE(cHWORK,111) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.12) WRITE(cHWORK,112) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.13) WRITE(cHWORK,113) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.14) WRITE(cHWORK,114) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.15) WRITE(cHWORK,115) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.16) WRITE(cHWORK,116) ACBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.17) WRITE(cHWORK,117) ICBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.18) WRITE(cHWORK,118) ICBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.19) WRITE(cHWORK,119) ICBIN(INDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.20) WRITE(cHWORK,120) ACBIN(JNDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.21) WRITE(cHWORK,121) ACBIN(JNDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.22) WRITE(cHWORK,122) ACBIN(JNDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      IF(INDEX.EQ.23) WRITE(cHWORK,123) ICBIN(JNDEX),(AFREE(L),L=L1,L2)! PMF 17/11/99: UNIT=JUSCRN changed to cHWORK
      CALL TRMOUT(55,HWORK)
      INDEX=INDEX+LOOP
      IF((LOOP.EQ.1).AND.(INDEX.LE.19)) GO TO 5
      IF(LOOP.EQ.1) GO TO 1
      IF(.NOT.FREE) CALL TRMOUT(80,'DO YOU WISH TO CHANGE THIS?^')
      IF(FREE) CALL TRMOUT(80,'DO YOU WISH TO FREE THIS?^')
      CALL DECIDE(IANSW)
      IF(IANSW.EQ.2) GO TO 3
      IF(.NOT.FREE) CALL TRMOUT(80,'ENTER NEW VALUE.^')
      IF(.NOT.FREE) TVAL=TERNUM(DUMMY)
      IF((.NOT.FREE).AND.(INDEX.LE.16)) ACBIN(INDEX)=TVAL
      IF(INDEX.LE.16) FREEZE(INDEX)=.NOT.FREE
      IF((.NOT.FREE).AND.(INDEX.GE.17).AND.(INDEX.LE.19))
     1ICBIN(INDEX)=TVAL
      IF(INDEX.LE.19) GO TO 5
      JNDEX=INDEX-20
      GO TO (8,10,12),JNDEX
      DO 9 IJK=1,6
      IF(.NOT.FREE) TIME(IJK)=TVAL
      FREEZE(IJK)=.NOT.FREE
    9 CONTINUE
      GO TO 5
    8 CONTINUE
      DO 11 IJK=1,3
      IF(.NOT.FREE) EPSI(IJK)=TVAL
      FREEZE(10+IJK)=.NOT.FREE
   11 CONTINUE
      GO TO 5
   10 CONTINUE
      DO 13 IJK=1,3
      IF(.NOT.FREE) DOUB(IJK)=TVAL
      FREEZE(13+IJK)=.NOT.FREE
   13 CONTINUE
      GO TO 5
   12 CONTINUE
      DO 14 IJK=1,3
      IF(.NOT.FREE) IRN(IJK)=TVAL
      FREEZE(16+IJK)=.NOT.FREE
   14 CONTINUE
      GO TO 5
    3 CONTINUE
      CALL TRMOUT(80,'DO YOU WISH TO CHANGE ANOTHER PARAMETER?^')
      CALL DECIDE(IANSW)
      IF(IANSW.EQ.1) GO TO 1
C---
C---     BACKSPACE INPUT FILE AND CALL "RDMTCO" AND THE ENTRY "JDJETC"
C---     FOR THE SAME EVENT.
C---
      BACKSPACE NDDINN
      CALL RDMTCO('SE')
      CALL RDJETC
      RETURN
      END
