C N. R. BADNELL            PROGRAM ADF04MRGR               28/10/19
C
      PROGRAM MAIN                                   
      IMPLICIT REAL*8(A-H,O-Z)
C
C     *REPLACES* THE RADIATIVE DATA IN ONE ADF04_1 FILE (E.G. R-MATRIX)
C     WITH THAT FROM A SECOND ADF04_2 FILE (E.G. AUTOSTRUCTURE), 
C     WHICH IS MORE COMPREHENSIVE. COMMENTED-OUT IS THE OPTION TO
C     *COMBINE* THE RADIATIVE DATA ON THE TWO FILES E.G. EK+M1 WITH M2.
C     ONLY RUDIMENTARY COMPATIBILITY CHECKS ARE MADE VIZ.
C     NUCLEAR CHARGE, RESIDUAL CHARGE, NUMBER OF LEVELS.
C     ***NOT*** COMPARED ARE CONFIGS, WEIGHTS OR ENERGIES.
C     HOWEVER, IF THE LEVEL ORDERING IN FILE 2 DIFFERS FROM FILE 1
C     THE LEVEL INDEX IN FILE 2 CAN BE CHANGED BY THE USER TO ITS
C     VALUE IN FILE 1. THE RATES ARE MAPPED ACCORDINGLY, INCLUDING
C     ADJUSTMENT OF STATISTICAL WEIGHTING IF THE RELATIVE ORDER OF
C     TWO LEVELS IN FILE 2 IS REVERSED FROM THAT IN FILE 1.
C     *** THIS IS REALLY TO HANDLE "SMALL" STRUCTURE DIFFERENCES 
C     BETWEEN THE TWO FILES THAT CAN RESULT IN CLOSELY SPACED LEVELS
C     BEING ORDERED DIFFERENTLY. IT IS *NOT* MEANT TO BE USED TO
C     IMPOSE A "BETTER" STRUCTURE FROM FILE 2 ON FILE 1, AS THE
C     ENERGIES AND COLLISION DATA IN FILE 1 ARE NOT ALTERED.
C 
      PARAMETER (NTMP=22)
      PARAMETER (NLEV=1000)
C
      PARAMETER (DZERO=0.0)
      PARAMETER (DONE=1.0)
      PARAMETER (DTEN=10.0)
C
      CHARACTER*5 CHAR1,CHAR2
      CHARACTER*210 CARD1,CARD2,F200,F300,F350
C
      REAL*8 MANT1(NTMP+1),MANT2(NLEV,NLEV)
C
      CHARACTER CMANT1(NTMP+2)*5,CEXP1(NTMP+2)*3
C
      DIMENSION IEXP1(NTMP+1),IEXP2(NLEV,NLEV)
      DIMENSION W2(NLEV),JORIG(NLEV)
C
      OPEN(1,FILE='adf04_1',STATUS='OLD')
      OPEN(2,FILE='adf04_2',STATUS='OLD')
C      OPEN(7,FILE='adf04mrgr.out',STATUS='UNKNOWN')
      OPEN(8,FILE='adf04_r',STATUS='UNKNOWN')
      OPEN(9,STATUS='SCRATCH')
C
      NTMP1=0
C
c      WRITE(*,*)'ENTER NO. OF TEMPS IN adf04_1, <= 0 FOR DEFAULT (14):'
c      READ(*,*)NTMP1
C
      IF(NTMP1.LE.0)NTMP1=14
      IF(NTMP1.GT.NTMP)THEN
        WRITE(*,*) 'INCREASE DIMENSION NTMP TO: ',NTMP1
        STOP 'INCREASE DIMENSION NTMP'
      ENDIF
      IF(NTMP1.GT.22.)STOP'CANNOT MERGE MORE THAN 22 TEMPS!'
C
      READ(1,100)CHAR1,NZED1,NELC1
      READ(2,100)CHAR2,NZED2,NELC2
C
      IF(NZED1.NE.NZED2.OR.NELC1.NE.NELC2)THEN
        WRITE(*,*)'***ERROR, TRYING TO MERGE INCOMPATIBLE ADF04 FILES:'
        WRITE(*,*)'NZ1,NE1,NZ2,NE2='
        WRITE(*,*)NZED1,NELC1,NZED2,NELC2
        STOP'SAYONARA'
      ENDIF
C
      BACKSPACE(1)
      READ(1,400)CARD1
      WRITE(8,400)CARD1
C
      LEV1=0
      DO I=1,10000
        READ(1,*)LEV
        BACKSPACE(1)
        READ(1,400)CARD1
        WRITE(8,400)CARD1
        IF(LEV.EQ.-1)GO TO 10
        LEV1=LEV1+1
      ENDDO
  10  LEV2=0
      DO I=1,10000
        READ(2,450)LEV,W
        IF(LEV.EQ.-1)GO TO 20
        W2(I)=W+W+DONE
        JORIG(LEV)=I
        LEV2=LEV2+1
      ENDDO
C
  20  IF(LEV1.GT.LEV2)THEN
        WRITE(*,*)'TRYING TO MERGE INCOMPATIBLE ADF04 FILES: LEVELS'
        WRITE(*,*)LEV1,LEV2
        STOP 'TRYING TO COMPARE INCOMPATIBLE ADF04 FILES: LEVELS'
      ENDIF
C
      IF(LEV2.GT.NLEV)THEN
        WRITE(*,*)'TOO MANY LEVELS, INCREASE NLEV TO: ',LEV2
        STOP 'TOO MANY LEVELS'
      ENDIF
C
      IF(LEV2.LT.1000)THEN
        F200='(F5.2,I5,6X,20(F5.2,I3))'
        F300='(2I4,F5.2,I3,23(A5,A3))'
        F350='(2I4,24(A5,A3))'
      ELSE
        F200='(F5.2,I5,8X,20(F5.2,I3))'
        F300='(2I5,F5.2,I3,23(A5,A3))'
        F350='(2I5,24(A5,A3))'
      ENDIF
C
      READ(1,F200)DUM,IDUM,(MANT1(I),IEXP1(I),I=1,NTMP1)
      READ(2,*)
C
      DO I=1,NTMP1
        IF(MANT1(I).EQ.DZERO)THEN
          NTEMP=I-1
          GO TO 30
        ENDIF
      ENDDO
      NTEMP=NTMP1
C
  30  BACKSPACE(1)
      READ(1,400)CARD1
      WRITE(8,400)CARD1
      NTMP1=MIN(NTMP1,NTEMP)
C
      DO J=1,LEV2
        DO I=1,LEV2
          MANT2(J,I)=DZERO
          IEXP2(J,I)=DZERO
        ENDDO
      ENDDO
C
  35  READ(2,F300)IF2,II2,DUM2,IDUM2
      IF(IF2.GT.LEV2)GO TO 35
      IF(IF2.EQ.-1)GO TO 40
      MANT2(IF2,II2)=DUM2
      IEXP2(IF2,II2)=IDUM2
      MANT2(II2,IF2)=DUM2
      IEXP2(II2,IF2)=IDUM2
      GO TO 35
C
  40  READ(1,F300)IF1,II1,DUM1,IDUM1,(CMANT1(I),CEXP1(I),I=2,NTMP1+2)
      IF(IF1.GT.LEV1)GO TO 40
      IF(IF1.EQ.-1)GO TO 50
      T1=DUM1*DTEN**IDUM1
C
      II2=JORIG(II1)
      IF2=JORIG(IF1)
      IF(MANT2(IF2,II2).NE.0.0D0)THEN
        IF((IF2-II2)*(IF1-II1).LT.0)THEN
          W=W2(MAX0(II2,IF2))/W2(MIN0(II2,IF2))
        ELSE
          W=1.0D0
        ENDIF
        T2=W*MANT2(IF2,II2)*DTEN**IEXP2(IF2,II2)
C
        IF(T2.LT.T1/DTEN)WRITE(*,500)IF1,II1,T1,T2     !REPLACE
        T1=T2                    !REPLACE
COM        IF(T2.LT.T1*DTEN)WRITE(*,501)IF1,II1,T1,T2  !COMBINE
COM        T1=T1+T2              !COMBINE
C
      ENDIF
C
      REWIND(9)
      WRITE(9,250)T1
      REWIND(9)
      READ(9,260)CMANT1(1),CEXP1(1)
C
      WRITE(8,F350)IF1,II1,(CMANT1(I),CEXP1(I),I=1,NTMP1+2)
      GO TO 40
C
  50  BACKSPACE(1)
  55  READ(1,400,END=60)CARD1
      WRITE(8,400)CARD1
      GO TO 55
C
  60  CONTINUE
C
      WRITE(*,*)'NORMAL END, MERGED FILE: adf04_r'
C
 100  FORMAT(A5,2I10)
C 200  FORMAT(F5.2,I5,6X,23(F5.2,I3))
 250  FORMAT(24(1PE9.2))
 260  FORMAT(24(A5,1X,A3))
C 300  FORMAT(2I4,F5.2,I3,23(A5,A3))
C 350  FORMAT(2I4,24(A5,A3))
 400  FORMAT(A210)
 450  FORMAT(I5,24X,F4.1)
 500  FORMAT('***WARNING ON TRANSITION',I5,'-',I4,
     X' REPLACING RATE',1PE9.2,' BY RATE',E9.2)
 501  FORMAT('***WARNING ON TRANSITION',I5,'-',I4,
     X' COMBINING RATE',1PE9.2,' AND RATE',E9.2)
C
      END