C N. R. BADNELL            PROGRAM ADF04CMP               28/10/19
C
      PROGRAM MAIN
      IMPLICIT REAL*8(A-H,O-Z)
C
C     COMPARE TWO ADF04 FILES AND LOG DETAILS IF THE UPSILON RATIO
C     EXCEEDS THE USER INPUT LIMIT. 
C     THE SECOND FILE CAN HAVE A LARGER CC EXPANSION THAN THE FIRST
C     BUT THE FIRST SET CC LEVELS MUST BE THE SAME. 
C     *CURRENTLY* THERE IS NO TEST TO CHECK-ON THIS!
C     CAN ONLY READ A SINGLE LINE OF T/UPS I.E. MAX NUM TEMPS IS 20.
C     ALSO, .GT. 9999 LEVELS WILL LEAVE NO SPACE BETWEEN INDEXES.
C     SEE E.G. XTRCT_ADF04.F FOR CODING OF MORE GENERAL READS.
C 
      PARAMETER (NTMP=20)
      CHARACTER*5 CHAR1,CHAR2
      CHARACTER*210 CARD1,CARD2,F200,F300
      REAL*8 MANT1(NTMP),MANT2(NTMP)
      DIMENSION IEXP1(NTMP),IEXP2(NTMP),TEMP1(NTMP),TEMP2(NTMP)
      DIMENSION UPS1(NTMP),UPS2(NTMP)
C
      OPEN(1,FILE='adf04_1',STATUS='OLD')
      OPEN(2,FILE='adf04_2',STATUS='OLD')
      OPEN(7,FILE='adf04cmp.out',STATUS='UNKNOWN')
      OPEN(8,FILE='upsout',STATUS='UNKNOWN')
C
      WRITE(*,*)'ENTER MIN RATIO TO BE LOGGED'
      READ(*,*)RATH
      WRITE(*,*)'ENTER LOWER AND UPPER TEMP INDEX, .LE. 0 FOR 1-14'
      READ(*,*)NTMP1,NTMP2
      IF(NTMP1.LE.0)NTMP1=1
      IF(NTMP2.LE.0)NTMP2=14                !CURRENT adasexj DEFAULT
      IF(NTMP2.GT.NTMP)STOP'INCREASE DIMENSION NTMP'
      IF(NTMP2-NTMP1+1.GT.20)STOP'CANNOT COMPARE MORE THAN 20 TEMPS'
C
      READ(1,100)CHAR1
      READ(2,100)CHAR2
 100  FORMAT(A5)
C
      IF(CHAR1.NE.CHAR2)THEN
        WRITE(*,*)'TRYING TO COMPARE INCOMPATIBLE ADF04 FILES: ION'
        WRITE(*,*)CHAR1,CHAR2
        STOP 'TRYING TO COMPARE INCOMPATIBLE ADF04 FILES: ION'
      ENDIF
C
      DO I=1,10000
        READ(1,*)LEV
        IF(LEV.EQ.-1)GO TO 10
        LEV1=LEV
      ENDDO
  10  DO I=1,10000
        READ(2,*)LEV
        IF(LEV.EQ.-1)GO TO 20
        LEV2=LEV
      ENDDO
C
  20  IF(LEV1.GT.LEV2)THEN
        WRITE(*,*)'TRYING TO COMPARE INCOMPATIBLE ADF04 FILES: LEVELS'
        WRITE(*,*)LEV1,LEV2
        STOP 'TRYING TO COMPARE INCOMPATIBLE ADF04 FILES: LEVELS'
      ENDIF
C
      IF(LEV2.LT.1000)THEN
        F200='(F5.2,I5,6X,20(F5.2,I3))'
        F300='(2I4,22(F5.2,I3))'
      ELSE
        F200='(F5.2,I5,8X,20(F5.2,I3))'
        F300='(2I5,22(F5.2,I3))'
      ENDIF
C
      READ(1,F200)DUM,IDUM,(MANT1(I),IEXP1(I),I=1,NTMP2)
      READ(2,F200)DUM,IDUM,(MANT2(I),IEXP2(I),I=1,NTMP2)
C
      DO I=1,NTMP2
        TEMP1(I)=MANT1(I)*10**IEXP1(I)
        TEMP2(I)=MANT2(I)*10**IEXP2(I)
        IF(TEMP1(I).NE.TEMP2(I))THEN
          WRITE(*,*)'TRYING TO COMPARE INCOMPATIBLE ADF04 FILES: TEMPS'
          WRITE(*,*)TEMP1(I),TEMP2(I)
          STOP 'TRYING TO COMPARE INCOMPATIBLE ADF04 FILES: TEMPS'
        ENDIF
        IF(MANT1(I).EQ.0.0)THEN
          NTEMP=I-1
          GO TO 30
        ENDIF
      ENDDO
      NTEMP=NTMP2
C
  30  BACKSPACE(1)
      READ(1,400)CARD1
      WRITE(7,500)CARD1
      NTMP2=MIN(NTMP2,NTEMP)
C
  40  READ(1,F300)IF1,II1,DUM1,IDUM1,(MANT1(I),IEXP1(I),I=1,NTMP2)
      IF(IF1.GT.LEV1)GO TO 40
      if(if1.lt.ii1)go to 40                      !skip upsilons
c      if(if1.gt.ii1)go to 40                      !skip downsilons
  41  READ(2,F300)IF2,II2,DUM2,IDUM2,(MANT2(I),IEXP2(I),I=1,NTMP2)
      if(if2.lt.ii2)go to 41                      !skip upsilons
c      if(if2.gt.ii2)go to 41                      !skip downsilons
      IF(IF1.EQ.-1)STOP 'LOGGING-INFO IN adf04cmp.out'
      IF(II2.LT.II1)GO TO 41
      IF(IF1.NE.IF2.OR.II1.NE.II2)THEN
        WRITE(*,*)'INDEX MIS-MATCH:'
        WRITE(*,*)IF1,IF2,II1,II2
        STOP 'INDEX MIS-MATCH'
      ENDIF
C
      RH=0.
      DO I=NTMP1,NTMP2
        IM1=NINT(100*MANT1(I))
        IM2=NINT(100*MANT2(I))
        IF(IABS(IM1-IM2).EQ.0)MANT2(I)=MANT1(I)   !=1 SUPPRESS ROUND-OFF
        UPS1(I)=MANT1(I)*10.**IEXP1(I)
        UPS2(I)=MANT2(I)*10.**IEXP2(I)
        UMAX=MAX(UPS1(I),UPS2(I))
        UMIN=MIN(UPS1(I),UPS2(I))
        IF(UMIN.GT.0)THEN
          R=UMAX/UMIN
          IF(R.GT.RH)RH=R
        ELSE
          IF(UMAX.GT.0)THEN
            R=1.D99
          ELSE
            R=1.
          ENDIF
          IF(UPS1(I).EQ.0)UPS1(I)=1.D-30
          IF(UPS2(I).EQ.0)UPS2(I)=1.D-30
        ENDIF
      ENDDO
C
C      WRITE(8,350)IF1,II1,(LOG10(UPS1(I)),LOG10(UPS2(I)),I=NTMP1,NTMP2)
C 350  FORMAT(2I5,40(F9.3))
c      if(if1.le.136.and.ii1.le.10)
      WRITE(8,351)IF1,II1,(UPS1(I),UPS2(I),I=NTMP1,NTMP2)
 351  FORMAT(2I5,40(1PE10.2))
C      WRITE(8,352)IF1,II1,(UPS1(I),UPS2(I)/UPS1(I)-1,I=NTMP1,NTMP2)
C 352  FORMAT(2I5,40(1PE10.2))
C
      IF(RH.GT.RATH)THEN
        BACKSPACE(1)
        BACKSPACE(2)
        READ(1,400)CARD1
        READ(2,400)CARD2
        WRITE(7,500)CARD1,RH
        WRITE(7,500)CARD2,RH
 400    FORMAT(A210)
 500    FORMAT(A210,': ',1PE10.2)
      ENDIF
C
      GO TO 40
C
      END