IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION NE(6),RS(7,6,3),PO(9),RO(7,6,3)
*
      ZM= 91.1867D0
      TQM= 173.8D0
      ALS= 0.119D0
      HM= 100.D0
*
      DO IY=1,6
       NE(IY)= 3
      ENDDO
*
      NEM= 3
*
      DO IC=1,7
       DO IY=1,6
        DO IE= 1,NE(IY)
         IF(IC.LE.4) THEN
          RS(IC,IY,IE)= ZM-IY*0.1D0
         ELSE
          RS(IC,IY,IE)= ZM+IY*0.1D0
         ENDIF
        ENDDO
       ENDDO
      ENDDO
*
      PO(1)= ZM
      PO(2)= 0.249549E+01
      PO(3)= 0.414761E+02
      PO(4)= 0.207435E+02
      PO(5)= 0.207437E+02
      PO(6)= 0.207906E+02
      PO(7)= 0.160835E-01
      PO(8)= 0.160835E-01
      PO(9)= 0.160835E-01
*
      CALL TTHEORY(NE,NEM,RS,ZM,TQM,ALS,HM,PO,RO)
*
      DO IC=1,7
       DO IY=1,6
        DO IE= 1,NE(IY)
         PRINT 1,RS(IC,IY,IE),RO(IC,IY,IE)
        ENDDO
       ENDDO
      ENDDO
*
    1 FORMAT(1X,E20.6,E20.7)
*
      STOP
      END
*
*------------------------------------------------------------------
*
      SUBROUTINE TTHEORY(NE,NEM,RS,ZMT,TQMT,ALST,HMT,PO,RO)
      IMPLICIT REAL*8(A-H,O-Z)
      PARAMETER(NX=210,NY=211,NPO=34,NRO=26*NX,NFIT=7*NY)
*
      CHARACTER*1 OEXT
      CHARACTER*4 OF4
      CHARACTER*6 OF6
*
      COMMON/TFITO/APO(9)
      COMMON/TFIT/FIT(NFIT)
*
      DIMENSION RS(7,6,NEM),PO(9),NE(6),RO(7,6,NEM),ARS(NX)
      DIMENSION OTPPO(NPO),OTPRO(NRO),OTPDRO(5,9,NX)
      DIMENSION SET(NY),AET(NY),SMUT(NY),AMUT(NY),STAUT(NY),
     #          ATAUT(NY),SHADT(NY)
*
      EXTERNAL M01CAF
*
      ZM= ZMT
      TQM= TQMT
      ALS= ALST
      HM= HMT
*
      DO I=1,9
          APO(I)= PO(I)
      ENDDO
*
*-----IC LOOP OVER CHANNELS | 1 = XS(E), 2 = XS(MU), 3 = XS(TAU), 4 = XS(HAD)
*                             5 = AFB(E), 6 = A_FB(MU), 7 = A_FB(TAU)
*
*-----IY LOOP OVER YEARS OF DATA TAKING
*
*-----IE LOOP OVER ENERGY POINTS IN YEAR IY
*
*-----THE TRULY INDEPENDENT SET OF ENERGIES IS SELECTED:
*     RS --> ARS(1,...,NC) WITH ALL ARS DIFFERENT
*
      ARS(1)= RS(1,1,1)
      NC= 1
      DO IC=1,7
       DO IY=1,6
        IF(IC.EQ.1.AND.IY.EQ.1) THEN
         IEMN= 2
        ELSE
         IEMN= 1
        ENDIF
        DO IE= IEMN,NE(IY)
          IK= 0
          DO N=1,NC
           IF(RS(IC,IY,IE).EQ.ARS(N)) THEN
            IK= IK+1
           ELSE
            IK= IK
           ENDIF
          ENDDO
          IF(IK.EQ.0) THEN
           NC= NC+1
           ARS(NC)= RS(IC,IY,IE)
          ENDIF
        ENDDO
       ENDDO
      ENDDO
*
*-----ENERFIES ARE SORTED IN ASCENDING ORDER
*
      IFAIL= 0
      CALL M01CAF(ARS,1,NC,'ASCENDING',IFAIL)
*
      PRINT*,'----------------------------------------------'
      PRINT*,NC
      DO N=1,NC
       PRINT*,ARS(N)
      ENDDO
      PRINT*,'----------------------------------------------'
*
      OEXT= 'E'
      CALL TINIT(NRS,OEXT)
      OF4= 'FITE'
      OF6= 'OMODES'
      CALL TCFLAG(OF6,OF4)
*
      SE= 1.D2
      CALL TOPAZ0(SE,NC,ARS,ZM,TQM,HM,ALS,OTPPO,OTPRO,OTPDRO)
*
      NCT= NC+1
      DO IT=1,7
       DO IF=1,NCT
        K= NCT*(IT-1)+IF
        IF(IT.EQ.1) THEN
         SET(IF)= FIT(K)
        ELSE IF(IT.EQ.2) THEN
         SMUT(IF)= FIT(K)
        ELSE IF(IT.EQ.3) THEN
         STAUT(IF)= FIT(K)
        ELSE IF(IT.EQ.4) THEN
         SHADT(IF)= FIT(K)
        ELSE IF(IT.EQ.5) THEN
         AET(IF)= FIT(K)
        ELSE IF(IT.EQ.6) THEN
         AMUT(IF)= FIT(K)
        ELSE IF(IT.EQ.7) THEN
         ATAUT(IF)= FIT(K)
        ENDIF
       ENDDO
      ENDDO
*
*-----THE REQUESTED RO IS ASSIGNED TO EACH ENERGY
*
      DO I=1,NC
       DO IC=1,7
        DO IY=1,6
         DO IE= 1,NE(IY)
          IF(RS(IC,IY,IE).EQ.ARS(I)) THEN
           IF(IC.EQ.1) THEN
             RO(IC,IY,IE)= SET(I)
           ELSE IF(IC.EQ.2) THEN
             RO(IC,IY,IE)= SMUT(I)
           ELSE IF(IC.EQ.3) THEN
             RO(IC,IY,IE)= STAUT(I)
           ELSE IF(IC.EQ.4) THEN
             RO(IC,IY,IE)= SHADT(I)
           ELSE IF(IC.EQ.5) THEN
             RO(IC,IY,IE)= AET(I)
           ELSE IF(IC.EQ.6) THEN
             RO(IC,IY,IE)= AMUT(I)
           ELSE IF(IC.EQ.7) THEN
             RO(IC,IY,IE)= ATAUT(I)
           ENDIF
          ENDIF
         ENDDO
        ENDDO
       ENDDO
      ENDDO
*
      RETURN
      END