C   21/02/84 402211403  MEMBER NAME  MUCONW   (JADEMUS)     FORTRAN
C
C-----------------------------------------------------------------------
      SUBROUTINE MUCONW( IFLAG, LUNBOS, LUNJAD, HERR )
C-----------------------------------------------------------------------
C
C LAST CHANGE 15.50 20/02/84 C. BOWDERY   - NO ERROR IF BANKS EXIST
C      CHANGE 11.40 29/06/82 HUGH MCCANN  - ADD /CMUED/ .
C      CHANGE 10.00 28/05/82 HUGH MCCANN  - REDUCE CORE REQUIREMENTS FOR
C                                          PRODUCTION OF UPDATE DATASETS
C NEW VERSION 08.34 12/06/81 HUGH MCCANN  - TO ACCOM NEW JADE SYSTEM.
C NEW VERSION 19.09 26/03/81 CHRIS BOWDERY- CHANGES ARGUMENTS
C
C
C-----------------------------------------------------------------------
C
C OUTPUTS MUON CALIBRATION DATA.
C
C               FULL SET                    IF IFLAG=1
C           CHANGES ONLY (HALF WORDS)       IF IFLAG=0
C      BOS FORMAT OUTPUT                    ON LUNBOS UNLESS SET TO 0 .
C     JADE FORMAT (SINGLE LOGICAL RECORD)   ON LUNJAD UNLESS SET TO 0 .
C
C HERR =  N    IF BOS COULD NOT CREATE BANK N ===> NO OUTPUT ATTEMPTED
C HERR = 20    IF LUNBOS = LUNJAD BUT .NE.0   ===> NO OUTPUT ATTEMPTED
C HERR = -1    WARNING:NO POSITIVE LOGICAL UNIT NO. GIVEN ===> NO OUTPUT
C HERR =  0    NORMAL RETURN
C
C-----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
C
C                            COMMONS.
C
C----------START OF MACRO CMUBCS----------------------------------------
      COMMON /BCS/IDATA(1)
      DIMENSION HDATA(1),ADATA(1)
      EQUIVALENCE (HDATA(1),ADATA(1),IDATA(1))
C----------END OF MACRO CMUBCS------------------------------------------
C
C
C
C
C
C=======================<< MACRO CMUCALIB >>============================
C
C LAST CHANGE  25/09/79  13.20 UHR   HARRISON PROSPER
C
C BANK NAMES, NUMBERS AND LENGTHS
C
C  NAME/NUMBER LENGTH  CONTENTS
C  MUCD   0      16    VERSION NUMBER AND DESCRIPTION.
C  MUOV   0       3    OVERALL JADE UNIT TRANSLATIONS.
C  MFFI   2     370    FIXED FRAME PARAMETERS.
C  MCFI   3     318    FIXED CHAMBER PARAMETERS.
C  MFSU   4     246    'SURVEY' FRAME PARAMETERS.
C  MCSU   5     634    'SURVEY' CHAMBER PARAMETERS.
C  MCEL   6    2220    'ELECTRONIC' CHAMBER PARAMETERS.
C  MCST   7     317    CHAMBER STATUS WORDS.
C  MUFI   8      36    FILTER (ABSORBER BLOCK) PARAMETERS.
C  MUYO   9      10    SIDE, TOP AND BOTTOM YOKE PARAMETERS.
C  MUEN  10      15    YOKE END-PLUG PARAMETERS.
C
C TOTAL LENGTH 4185 WORDS.
C
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
      COMMON /CALIBR/ LARRY(100),MUCAL(4185)
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C
C
C               NVERSN
      DIMENSION DESCRP(15),HOVALL(6)
C                                                    19 WORDS
C
      EQUIVALENCE ( NVERSN,MUCAL(1) ),( DESCRP(1),MUCAL(2) ),
     *            ( HOVALL(1),MUCAL(17) )
C----------------------------------------------------19 WORDS SO FAR
C
C     HMFFIX(740)                                   370 WORDS
      DIMENSION HMFFIX(740)
      EQUIVALENCE ( HMFFIX(1),MUCAL(20) )
      DIMENSION HFACE(82),HSECT(82),HLAYER(82),HNORM(82),HLONG(82),
     *          HTRANS(82),HAC(82),HAL(82),HUNIT(82)
      EQUIVALENCE (HMFFIX(1),NFRAMS),(HMFFIX(3),HFACE(1)),
     *            (HMFFIX(85),HSECT(1)),(HMFFIX(167),HLAYER(1)),
     *            (HMFFIX(249),HNORM(1)),(HMFFIX(331),HLONG(1)),
     *            (HMFFIX(413),HTRANS(1)),(HMFFIX(495),HAC(1)),
     *            (HMFFIX(577),HAL(1)),(HMFFIX(659),HUNIT(1))
C---------------------------------------------------389 WORDS SO FAR
C
C
C     HMCFIX(636)                                   318 WORDS
      DIMENSION HMCFIX(636)
      EQUIVALENCE ( HMCFIX(1),MUCAL(390) )
      DIMENSION HFR(634)
      EQUIVALENCE (HMCFIX(1),NCHAMS),(HMCFIX(3),HFR(1))
C---------------------------------------------------707 WORDS SO FAR
C
C     HMFSUR(492)                                   246 WORDS
      DIMENSION HMFSUR(492)
      EQUIVALENCE ( HMFSUR(1),MUCAL(708) )
      DIMENSION HDIST(82),HANG(82),HCLLO(82),HCLHI(82),HCTLO(82),
     *          HCTHI(82)
      EQUIVALENCE (HMFSUR(1),HDIST(1)),(HMFSUR(83),HANG(1)),
     *            (HMFSUR(165),HCLLO(1)),(HMFSUR(247),HCLHI(1)),
     *            (HMFSUR(329),HCTLO(1)),(HMFSUR(411),HCTHI(1))
C---------------------------------------------------953 WORDS SO FAR
C
C
C     HMCSUR(1268)                                  634 WORDS
      DIMENSION HMCSUR(1268)
      EQUIVALENCE ( HMCSUR(1),MUCAL(954) )
      DIMENSION HD1(634),HCTW(634)
      EQUIVALENCE (HMCSUR(1),HCTW(1)),(HMCSUR(635),HD1(1))
C--------------------------------------------------1587 WORDS SO FAR
C
C
C     HMCELE(4440)                                 2220 WORDS
      DIMENSION HMCELE(4440)
      EQUIVALENCE ( HMCELE(1),MUCAL(1588) )
      DIMENSION HDTP(634),HLTP(634),HLSF(4,634),HVDRFT(634)
      EQUIVALENCE (HMCELE(1),HVDR),(HMCELE(2),HDTP(1)),
     *            (HMCELE(636),HLTP(1)),(HMCELE(1270),HLSF(1,1)),
     *            (HMCELE(3806),HMCEDM),(HMCELE(3807),HVDRFT(1))
C--------------------------------------------------3807 WORDS SO FAR
C
C
C     HMCSTA(634)                                   317 WORDS
      DIMENSION HMCSTA(634)
      EQUIVALENCE ( HMCSTA(1),MUCAL(3808) )
C--------------------------------------------------4124 WORDS SO FAR
C
C
C     HFILDA(72)                                     36 WORDS
      DIMENSION HFILDA(72)
      EQUIVALENCE ( HFILDA(1),MUCAL(4125) )
      INTEGER*2 HBLLO(6),HBLHI(6),HBTLO(6),HBTHI(6),HBNLIM(36)
      INTEGER*4 IFCIND(6)
      INTEGER*2 HFILDA
      EQUIVALENCE (HBLLO(1),HFILDA(1)),(HBLHI(1),HFILDA(7)),
     *            (HBTLO(1),HFILDA(13)),(HBTHI(1),HFILDA(19)),
     *            (HBNLIM(1),HFILDA(25)),(IFCIND(1),HFILDA(61))
C--------------------------------------------------4160 WORDS SO FAR
C
C
C     HYKNMI(4),HYKNMO(4),HYKLDM(4),HYKTDM(4),BYOKE, 10 WORDS
C     IYKIND
      DIMENSION HYKNMI(4),HYKNMO(4),HYKLDM(4),HYKTDM(4)
      INTEGER*2 HYKTDM,HYKLDM,HYKNMI,HYKNMO
      EQUIVALENCE ( HYKNMI(1),MUCAL(4161) ),
     *            ( HYKNMO(1),MUCAL(4163) ),
     *            ( HYKLDM(1),MUCAL(4165) ),
     *            ( HYKTDM(1),MUCAL(4167) ),
     *            ( BYOKE,MUCAL(4169) ),( IYKIND,MUCAL(4170) )
C--------------------------------------------------4170 WORDS SO FAR
C
C
C    IZEII,IZEIO,IREP1,IREP2,IREP3,IREP4,IXYEP5,     15 WORDS
C    IZOEP1,IZOEP2,IZOEP3,IZOEP4,IZOEP5,CAEP2,
C    IEPIND,IEPSCT
C
      EQUIVALENCE ( IZEII,MUCAL(4171) ),( IZEIO,MUCAL(4172) ),
     *            ( IREP1,MUCAL(4173) ),( IREP2,MUCAL(4174) ),
     *            ( IREP3,MUCAL(4175) ),( IREP4,MUCAL(4176) ),
     *            ( IXYEP5,MUCAL(4177) ),( IZOEP1,MUCAL(4178) ),
     *            ( IZOEP2,MUCAL(4179) ),( IZOEP3,MUCAL(4180) ),
     *            ( IZOEP4,MUCAL(4181) ),( IZOEP5,MUCAL(4182) ),
     *            ( CAEP2,MUCAL(4183) ),( IEPIND,MUCAL(4184) ),
     *            ( IEPSCT,MUCAL(4185) )
C--------------------------------------------------4185 WORDS SO FAR
C
C=======================<< MACRO CMUCALIB >>============================
C
C
C
C
C
C   28/05/82 206291132  MEMBER NAME  CMUEDWRK (JADEMUS)     FORTRAN
C   27/05/82 205271447  MEMBER NAME  CMUEDWRK (S)           FORTRAN
C   17/06/81 106170953  MEMBER NAME  CMUED    (JADEMUS1)    FORTRAN
C   12/06/81 106151117  MEMBER NAME  CMUED    (S)           FORTRAN
C
C LAST CHANGE 11.20 29/06/82 HUGH MCCANN  - FIX BUG..PUT NCHAN IN/CMUED/
C      CHANGE 10.00 28/05/82 HUGH MCCANN  - REDUCE CORE REQUIREMENTS FOR
C                                          PRODUCTION OF UPDATE DATASETS
C
      COMMON /CWORK/KTIME,HUPDAT(8370),HLOC(8370),IALPH,NHMUCA
C       N.B.  SEE  ALSO  CMUED.
C
C  THIS FITS IN WITHIN THE MAXIMUM SIZE OF CWORK....PATREC CWORK
C  IS APPROX 40 KBYTES.
C
      DIMENSION HMUCAL(8370)
      EQUIVALENCE (HMUCAL(1),MUCAL(1))
C  KTIME IS THE TIME AT WHICH THIS SET OF EDITS IS TO BE IMPLEMENTED
C         ( IN SECONDS FROM THE START OF 1979 VIA KTMCON)
C  HUPDAT IS AN ARRAY CONTAINING THESE NEW VALUES  (HUPDAT(I),I=1,NCHAN)
C  HLOC   IS AN ARRAY CONTAINING THEIR HALF-WORD ADDRESSES IN THE MUCAL
C         PART OF THE JADE CALIBRATION COMMON.
C  IALPH  IS THE NUMERICAL INDEX (1-20) OF THE ALPHABETIC IDENTIFIER OF
C         CURRENT MUCONE EDIT (ONLY USED DURING MUCONE OPERATIONS) .
C  NHMUCA IS THE HMUCAL LOCATION OF THE HMUCAL WORD WHICH IS CURRENTLY
C         BEING CHANGED ( ONLY USED DURING MUCONE OPERATIONS ).
C   29/06/82 206291130  MEMBER NAME  CMUED    (JADEMUS)     FORTRAN
C             11.20 29/06/82 HUGH MCCANN
      COMMON /CMUED/NCHAN
C  NCHAN IS THE NO. OF I*2 WORDS WHICH ARE CHANGED BY THE CURRENT EDITS.
C    THIS APPROACH IS ADOPTED IN ORDER TO AVOID INITIALISING LOCATIONS
C  IN /CWORK/ .
C
      DIMENSION IHED(9)
      DIMENSION NAME(12) , NUMBER(12) , LENGTH(12)
C
C                            DATA INITIALISATION STATEMENTS.
C
      DATA NBANKS /   12   /
      DATA MUNAME / 'MUCA' /
      DATA NAME/'MUCO','MUCD','MUOV','MFFI','MCFI','MFSU',
     +          'MCSU','MCEL','MCST','MUFI','MUYO','MUEN'/
      DATA NUMBER/  1, 0,0,  2,  3,  4,  5,   6,  7, 8, 9,10 /
      DATA LENGTH/100,16,3,370,318,246,634,2220,317,36,10,15 /
      DATA IHED(2)/0/,IHED(3)/0/,IHED(4)/0/,IHED(5)/0/,IHED(8)/0/,
     *     IHED(9)/0/
C
C------------------  C O D E  ------------------------------------------
C
      IHED(1)=MUNAME
      IHED(6)=KTIME
      IHED(7)=IFLAG
C
C                            OUTPUT ENTRY MESSAGE THEN CHECK IF
C                            LUNBOS = LUNJAD. IF SO OUTPUT ERROR
C                            MESSAGE AND RETURN UNLESS BOTH 0 .
C
      CALL MUMESS('MUCONW',0,'CALLED TO OUTPUT MUON CALIBRATION.^')
      IF(LUNBOS.NE.LUNJAD) GO TO 3
      IF(LUNBOS.EQ.0) GO TO 99
C
        CALL MUERRY('MUCONW',LUNBOS,'=LOGICAL UNIT NO.  OF BOTH JADE AND
     + BOS DATASETS. NEITHER WRITTEN.^')
      HERR=20
      RETURN
C
C                            CREATE BANKS IF NOT ALREADY EXISTING,
C                            THAT IS, ALLOW IER = 1.
C
 3    HERR=0
      DO  1  I = 1,NBANKS
        CALL CCRE(IP,NAME(I),NUMBER(I),LENGTH(I),IER)
        IF( IER .GE. 2 ) GO TO 98
        IF(I.EQ.2)  CALL UCOPY(NVERSN,IDATA(IP+1),LENGTH(I))
        IF(I.EQ.3)  CALL UCOPY(HOVALL,IDATA(IP+1),LENGTH(I))
        IF(I.EQ.4)  CALL UCOPY(HMFFIX,IDATA(IP+1),LENGTH(I))
        IF(I.EQ.5)  CALL UCOPY(HMCFIX,IDATA(IP+1),LENGTH(I))
        IF(I.EQ.6)  CALL UCOPY(HMFSUR,IDATA(IP+1),LENGTH(I))
        IF(I.EQ.7)  CALL UCOPY(HMCSUR,IDATA(IP+1),LENGTH(I))
        IF(I.EQ.8)  CALL UCOPY(HMCELE,IDATA(IP+1),LENGTH(I))
        IF(I.EQ.9)  CALL UCOPY(HMCSTA,IDATA(IP+1),LENGTH(I))
        IF(I.EQ.10) CALL UCOPY(HFILDA,IDATA(IP+1),LENGTH(I))
        IF(I.EQ.11) CALL UCOPY(HYKNMI,IDATA(IP+1),LENGTH(I))
        IF(I.EQ.12) CALL UCOPY(IZEII ,IDATA(IP+1),LENGTH(I))
  1   CONTINUE
C
C-----------------------------------------------------------------------
C
C                  OUTPUT BANKS.
C
C             IF LOGICAL UNIT NUMBER LUNBOS > 0 , OUTPUT BOS DATASET
C
      IF(LUNBOS.LE.0)GO TO 2
        CALL BMLT(NBANKS,NAME)
        CALL BWRITE(LUNBOS)
        CALL BDLG
        CALL MUMESS('MUCONW',LUNBOS,'=LOGICAL UNIT NO. OF BOS OUTPUT^')
C
C                            IF LOGICAL  UNIT  NUMBER  LUNJAD  >  0  ,
C                            OUTPUT A SINGLE  RECORD  OF  LENGTH  4194
C                            WORDS FOR THE JADE SYSTEM (STEFFEN)
C
 2    IF( LUNJAD .LE. 0 ) GO TO 99
      IF( IFLAG  .EQ. 0 ) GO TO 22
      NLONG = 4194
      WRITE(LUNJAD) NLONG, (IHED(I),I=1,9), (MUCAL(I),I=1,4185)
      CALL MUMESS('MUCONW',LUNJAD,'=LOGICAL UNIT NO. OF JADE OUTPUT^')
      GO TO 99
C
 22   NLONG = NCHAN + 9
      WRITE(LUNJAD) NLONG, (IHED(I),I=1,9),
     +              (HLOC(I),HUPDAT(I),I=1,NCHAN)
C
C++++++++ DEBUGGING :
C
      DO 26 I=1,NCHAN
        WRITE(6,66)HLOC(I),HUPDAT(I)
   66   FORMAT('0  LOCATION / NEW VALUE : ',2I5)
   26 CONTINUE
C
C++++++++
C
      CALL MUMESS('MUCONW',LUNJAD,'=LOGICAL UNIT NO. OF JADE OUTPUT^')
      GO TO 99
C
C                            ERROR CONDITIONS. HERR = NUMBER  OF  BANK
C                            CAUSING THE ERROR.
C
  98  CALL MUERRY('MUCONW',I,'INSUFFICIENT SPACE FOR BANK CREATION.^')
      HERR=I
C
 99   IF( LUNBOS .GT. 0 .OR. LUNJAD .GT. 0 ) RETURN
C
      CALL MUMESS('MUCONW',0,'NO OUTPUT PRODUCED AS NO POSITIVE LOGICAL
     +UNIT NUMBERS GIVEN^')
      HERR=-1
      RETURN
      END
