                          SUBROUTINE AVERAG
     &                (IN,IO,LINE,MAXLIN,MARK)
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C +                                                                    +
C + MAIN PROGRAMME OF THE AVERAGING PROGRAMME  AVERAG                  +
C +                                                                    +
C + WRITTEN BY EGBERT PERENTHALER MPI-FKF (1978)                       +
C + UPGRADED BY W.F.KUHS ILL (1983) INSTALLED ON MICROVAX APRIL 1987   +
C +                                                                    +
C + (LAST UPDATE  DEZEMBER 1980, APRIL 1987)                           +
C +                                                                    +
C + THIS PROGRAMME PRINTS THE COVER,AND CALLS THE SUBROUTINES          +
C + AVERA1, AVERA2, AND AVERA3                                         +
C +                                                                    +
C + IN CASE OF AN OVERLAY STRUCTURE AVERA1, AVERA2 AND AVERA3 MAY BE   +
C + MAIN PROGRAMMS OF SUBORDERED OVERLAYS                              +
C +                                                                    +
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C---- INPUT VARIABLES
C     ---------------
C
C   - IN        LOGICAL NUMBER OF THE STANDARD INPUT  UNIT
C   - IO        LOGICAL NUMBER OF THE STANDARD OUTPUT UNIT
C   - LINE(11)  AN ARRAY FOR THE NAME OF THE MAN WHO IS RESPONSIBLE FOR
C               THE PROGRAMME SYSTEM PROMETHEUS.
C   - MAXLIN    MAXIMUM NUMBER OF LINES PER PAGE FOR THE PRINTER.
C   - MARK      0/1 FOR NORMAL/SHORT OUTPUT
C
C---- TYPE STATEMENTS
C     ---------------
C
C---- ABSORPTION COEFFICIENT
      REAL MU
C
C---- NUMBER OF THE FIRST SCALE GROUP OF THE INPUT DATA
      INTEGER ASC
C
C---- DIMENSION STATEMENTS
C     -------------------
C
C---- ARRAYS FOR THE REFLECTION DATA
C    - IHKL    HKL-VALUES IN PACKED FORM (ONE INTEGER)
C    - IRHKL   HKL-VALUES TRANSFORMED TO THE ASSYMETRIC UNIT
C    - F       INTENSITIES
C    - SF      STANDARD DEVIATIONS
C    - TBAR    MEAN PATH LENGTH
C    - CKOF    CORRECTION COEFFICIENT (ABSORPTION OR EXTINCTION)
C	       OR PSI-VALUE 
C    - NUMOR   COLL5 NUMBER OF REFLECTION ILL SPECIFIC +++++++
C      (OVERFLOW OF SUBSCRIPT WILL BE TESTED WITH VARIABLE  IDEM
C       INITIALISED BELOW).
C
      DIMENSION IHKL(20000),IRHKL(20000),F(20000),SF(20000),TBAR
     &(20000),CKOF(20000),NUMOR(20000)

C
      DIMENSION LINE(11)
C
C---- COMMON DECLARATIONS
C     -------------------
C
C---- /CONT/   COMMON WITH THE SUBROUTINES AVER1 AND AVER2
C    - LABEL    LABEL FOR THE HKL-CARDS
C    - IOUNIT   LOGICAL NUMBER OF THE OUTPUT UNIT
C    - TITEL    TITEL OF THE RUN
C    - IKART    SWITCH FOR  READ HKL-CARDS OR FOURIER FILE
C    - ISYS     SWITCH FOR  CALCULATE A SYSTEMATIC ERROR
C    - ISST     SWITCH FOR  WHICH ERROR CALCULATION SHOULD BE USED
C    - MODU     SWITCH FOR  PREAVERAGING OF IDENTICAL OR FRIEDEL REFL.
C    - IREJEC   SWITCH FOR  THE USE OF REJECT PARAMETERS
C    - NOR      SWITCH FOR  WHAT TO DO IF ONLY ONE REFL. IS NOT REJECTED
C    - NULL     SWITCH FOR  THE TREATEMENT OF NEGATIVE INTENSITIES
C    - IABS     SWITCH FOR  CONSIDER ABSORPTION COEFFICIENTS
C		IF IABS.LT.0  THEN PSI-VALUE
C    - IPSO     SWITCH FOR  PRESORTING,AVERAGING  YES/NO
C    - ILIST    SWITCH FOR  DIFFERENT FORMS OF OUTPUT
C    - SYSDEV   ESTIMATED SYSTEMATIC ERROR IN PERCENT
C    - REJE     REJECT PARAMETER IN MULTIPLES OF SIGMA
C    - SIGLT    MULTIPLE OF SIGMA FOR MARKING  LESS THANS
C    - OFLOW    OVERALL SCALE FACTOR
C    - ISOR     SWITCH FOR  SORT FOR INCREASING SIN(THETA)/LAMBDA
C    - CELL     CELL PARAMETERS
C
      COMMON /CONT/LABEL(2),IOUNIT,TITEL(18),IKART,ISYS,ISST,MODU,IREJEC
     &,NOR,NULL,IABS,IPSO,ILIST,SYSDEV,REJE,MU,SIGLT,OFLOW,ISOR,CELL(6)
C
C---- FORMAT STATEMENTS
C     -----------------
C
   10 FORMAT(36X,
     &60HP R O M E T H E U S  HAS BEEN CALLED FOR  A V E R A G I N G //
     &40X,50H                                                  ///
     &40X,50H SYMMETRICALLY   EQUIVALENT   REFLECTIONS  MAY  BE/
     &40X,50H AVERAGED IN ALL CRYSTAL CLASSES    . N-CARD COLLV/
     &40X,50H RELECTION  FILES ARE RECOGNIZED AND USED AS INPUT/
     &40X,50H DIFFERENT CALCULATIONS OF THE  STANDARD DEVIATION/
     &40X,50H                  MAY  BE CHOSEN.                 //
     &40X,50H                                                  /
     &40X,50H                                                  /
     &40X,50H INFORMATION  ABOUT THIS  PROGRAMME  IS  AVALIABLE/
     &40X, 6H  FROM ,11A4,//////////,
     &35X,10HSUBSTANCE=,15X,12HTEMPERATURE=,15X,8HSPECIAL= )
C
C---- INITIALISE
C     ----------
C
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     VARIABLE  IDIM  TO  CHECK  OVERFLOW  OF  THE  DATA  ARRAYS
C     ATTENTION***   THE DIMENSION OF THE ARRAYS  STACKL AND STACKR  IN
C                    AVERA1 MUST BE AT LEAST (1/6)*IDIM
C
      IDIM = 20000
C
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C---- START OF PROGRAMME
C     ------------------
C
C---- PRINT COVER
C
      IF(MARK.NE.0) GOTO 15
      CALL SPACE(1,5,26,IO,MAXLIN)
      WRITE(IO,10)LINE
      CALL SPACE(2,5,26,IO,MAXLIN)
C
C***********************************************************************
C                           LOAD OVERLAY
C     CALL LLINK("AVER1")
C***********************************************************************
C
C---- CALL THE SUBROUTINE WICH READS AND PRESORTS THE DATA
C
   15 CALL AVERA1(IN,IO,MAXLIN,IDIM,NUMMER,ILT,ISORT,IP,IU,ICV,
     &         IHKL,IRHKL,F,SF,TBAR,CKOF,NUMOR,FINTCU)
C
C***********************************************************************
C                           LOAD OVERLAY
C     CALL LLINK("AVER2")
C***********************************************************************
C
C---- CALL THE SUBROUTINE WHICH AVERAGES THE DATA
C
      CALL AVERA2(IO,MAXLIN,IDIM,NUMMER,ILT,ISORT,IP,IU,ICV,
     &         IHKL,IRHKL,F,SF,TBAR,CKOF,NUMOR,FINTCU)
C
C---- SHOULD THE DATA BE SORTED FOR INCREASING SIN(THETA)/LAMBDA
C
	IF((ISOR.NE.0).AND.(IABS.LT.0))THEN
	   WRITE(IO,*) 'ERROR SORTING ON SIN(THETA)/LAMBDA WITH PSI',
     &		       '-DATA IS NOT POSSIBLE (NO FREE ARRAY) '
	   GOTO 20
	ENDIF  
      IF (ISOR .EQ. 0) GO TO 20
C
C***********************************************************************
C                           LOAD OVERLAY
C     CALL LLINK("AVER3")
C***********************************************************************
C
C---- CALL SUBROUTINE WHICH SORTS THE OUTPUT DATA
C
      CALL AVERA3(IO,IDIM,IHKL,IRHKL,F,SF,TBAR,CKOF,NUMOR,ICV)
C
   20 RETURN
      END
                               BLOCK DATA
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C +                                                                    +
C + SOME DATA WHICH ARE NEEDED IN THE OVERLAYS AVER1, AVER2, AND AVER3 +
C + EGBERT PERENTHALER  MPI-FKF (DEZEMBER 1980)                        +
C +                                                                    +
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C---- COMMON DECLARATION
C     ------------------
C
C---- /BD/  COMMON WITH AVERA1,AVERA2, AND IDENT
C    - ICHAR  SOME STRINGS FOR GENERATION OF PRINTED OUTPUT
C    - IRMT   THE FORMAT FOR DATA OUTPUT ON FILE
C
      CHARACTER*5 IPRFF
      COMMON /BD/ICHAR(18),IRMT(21),IPRFF(2)
C
C---- DATA STATEMENTS
C     ---------------
C
      DATA ICHAR(1)/3HABS/,ICHAR(2)/3HORP/,ICHAR(3)/3HEXT/,ICHAR(4)/3HIN
     &C/,ICHAR(7)/4H    /,ICHAR(8)/4H****/,ICHAR(9)/3HEND/,ICHAR(10)/3HR
     &EJ/,ICHAR(11)/3HONE/,ICHAR(12)/2HLT/,ICHAR(13)/2HSC/,ICHAR(14)/2HG
     &R/,ICHAR(15)/4HFACT/,ICHAR(16)/3HBAD/,ICHAR(17)/3HNOR/,ICHAR(18)/3
     &HHKL/
C
      DATA IRMT/4H(A3,,1H4,4HX,A4,4H,A2,,4H3I3,,3H3X,,4H2I3,,1HF,1H9,1H.
     &,1H0,1H ,1H,,4HF9.5,2H,F,1H5,1H.,1H0,1H ,1H ,4H   )/
      DATA IPRFF(1)/'NUMOR'/,IPRFF(2)/'     '/
C
      END
                         FUNCTION IPACK
     &                      (H,K,L)
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C +                                                                    +
C + SUBROUTINE TO STORE THREE INTEGER VALUES ON ONE INTEGER VALIABLE.  +
C + (THE ABSOLUTE VALUE OF EACH VALUE MUST BE LESS THAN 100).          +
C + TAKEN FROM A PROGRAMM OF L.W. FINGER                               +
C +                                                                    +
C + THIS PROGRAMME IS CALLED BY THE SUBROUTINES AVERA1, AVERA2, IDENT, +
C + AND AVERA3                                                         +
C +                                                                    +
C + THIS PROGRAMME DO NOT CALL ANY OTHER SUBROUTINE.                   +
C +                                                                    +
C + IN CASE OF AN OVERLAY STRUCTURE IT IS PART OF THE OVERLAY AVERA    +
C +                                                                    +
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C---- TYPE STATEMENTS
C     ---------------
C
      INTEGER H
C
      IPACK = (L * 256 + K) * 256 + H + 6579300
C
      RETURN
      END
                           SUBROUTINE DEPAK
     &                       (IHKL,H,K,L)
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C +                                                                    +
C + INVERSE PROCEDURE OF THE  FUNCTION IPACK.                          +
C +                                                                    +
C + DESCRIPTION SEE FUNCTION IPACK.                                    +
C +                                                                    +
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C---- TYPE STATEMENTS
C     ---------------
C
      INTEGER H
C
      K = IHKL / 256
      H = IHKL - K * 256 - 100
      L = K / 256
      K = K - L * 256 - 100
      L = L - 100
C
      RETURN
      END
                          SUBROUTINE ZUVIEL
     &                      (IO,IMAX,I)
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C +                                                                    +
C + SUBROUTINE TO PRINT OUT THE ERROR MESSAGE AND TO STOP THE          +
C + EXECUTION OF THE CALLING PROGRAMME WHEN OVERFOLW OF THE SUBSCRIPT  +
C + OF AN ARRAY OCCURS.                                                +
C + WRITTEN BY EGBERT PERENTHALER MPI-FKF (1979)                       +
C +                                                                    +
C + (LAST UPDATE DEZEMBER 1980)                                        +
C +                                                                    +
C + THIS PROGRAMM IS CALLED BY THE SUBROUTINES AVERA1, AVERA2, AND     +
C + IDENT.                                                             +
C +                                                                    +
C + THIS PROGRAMME DO NOT CALL ANY OTHER SUBROUTINE.                   +
C +                                                                    +
C + IN CASE OF AN OVERLAY STRUCTURE IT IS PART OF THE OVERLAY AVERAG.  +
C +                                                                    +
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C---- INPUT VARIABLES
C     ---------------
C
C   - IMAX   DIMENSION OF THE ARRAY FOR WHICH AN OVERFOLW HAS HAPPENED
C   - I      NUMBER OF THE ERROR MESSAGE TO BE WRITTEN.
C
      GO TO (9,20,40,80),I
    9 WRITE(IO,10)IMAX
   10 FORMAT (8(/),1X,26HYOU WANT TO READ MORE THAN,I6,12HREFLECTIONS./1
     &H0)
      GO TO 60
   20 WRITE(IO,30)IMAX
   30 FORMAT(8(/),1X,38HYOU HAVE MEASURED A GROUP OF MORE THAN,I5,
     &37HSYMMETRICALLY EQUIVALENT REFLECTIONS./1H0)
      GO TO 60
   40 WRITE(IO,50)IMAX
   50 FORMAT(8(/),1X,47HWHEN PREAVERAGING IDENTICAL OR FRIEDEL REFLECTI,
     &32HONS OR BOTH THERE WERE MORE THAN,I4,29HREFLECTIONS WITHIN ONE G
     &GROUP /1H0)
   60 WRITE(IO,70)
   70 FORMAT(1X,78HTHE CHANGES WHICH ARE NECESSARY IN THIS CASE ARE DESC
     &RIBED IN THE USER MANUAL.)
      GO TO 100
   80 WRITE(IO,90)
   90 FORMAT(1X,82HTHERE ARE MORE SCALE GROUPS ON YOUR HKL-CARDS THAN SC
     &ALE FACTORS ON THE SCAL CARD.)
  100 STOP
      END
