*DECK INFWD4
      SUBROUTINE INFWD4(CFILNA,IPRINT,NBISO,HNAMIS,AWRISO)
C
C------------------------------  INFWD4  ------------------------------
C
C   TO RECOVER MASS FOR ISOTOPES OF WIMS-D4 TYPE LIBRARIES
C
C   INPUT
C     CFILNA : WIMS FILE NAME                       C*64
C     IPRINT : PRINT FLAG                           I
C     NBISO  : NUMBER OF ISOTOPES                   I
C     HNAMIS : ISOTOPE NAMES                        C(NBISO)*8
C   OUTPUT
C     AWRISO : ISOTOPE WEIGHTS                      R(NBISO)
C   WIMS-D4 LIBRARY PARAMETERS
C     IUTYPE : TYPE OF FILE = 2 (BINARY)            I
C     LRIND  : LENGHT RECORD ON DA FILE = 0         I
C     IACTO  : OPEN ACTION = 2 (READ ONLY)          I
C     IACTC  : CLOSE ACTION = 2 (KEEP)              I
C     MAXISO : MAX. NB. ISOTOPE = 246               I
C     LPZ    : LENGTH OF WIMS PARAMETER ARRAY = 8   I
C     NSETP1 : NUMBER OF P1 SCATTERING SETS = 4     I
C     NPZ    : LIST OF MAIN PARAMETERS              I(LPZ)
C     IWISO  : ID OF ISOTOPE                        I(MAXISO)
C     ID     : ISOTOPIC ID                          I
C     IZ     : ISOTOPIC CHARGE                      I(MAXISO)
C     NF     : NUMBER FISSION                       I(MAXISO)
C     NT     : NUMBER TEMPERATURE                   I(MAXISO)
C     NR     : NUMBER RESONANCE                     I(MAXISO)
C     AWR    : ATOMIC MASS (AMU)                    R(MAXISO)
C
C------------------------------  INFWD4  ------------------------------
C
      IMPLICIT   NONE
      INTEGER    IOUT,IPRINT,NBISO,KDROPN,KDRCLS
      PARAMETER (IOUT=6)
      CHARACTER  CFILNA*64,HNAMIS(NBISO)*8
      REAL       AWRISO(NBISO)
      EXTERNAL   KDROPN,KDRCLS
C----
C  MEMORY ALLOCATION PARAMETERS
C----
      INTEGER      IBASE(1)
      REAL         RBASE(1)
      COMMON       RBASE
      EQUIVALENCE (RBASE(1),IBASE(1))
C----
C  WIMS-D4 LIBRARY PARAMETERS
C----
      INTEGER      IUNIT,IUTYPE,IACTO,IACTC,LRIND,MAXISO,LPZ
      PARAMETER   (IUTYPE=2,IACTO=2,IACTC=1,LRIND=0,MAXISO=246,LPZ=8)
      CHARACTER    CWISO(MAXISO)*8
      INTEGER      NPZ(LPZ),IWISO(MAXISO),NEL,NGROUP,IEL,IELRT,JEL,
     >             IDIEL,IZ,NFIEL,NTMP,NRIEL,IDUM,IERR,IT,JSO,
     >             ISORD(MAXISO)
      REAL         AWR,RDUM
      IF(CFILNA.EQ.' ' )THEN
        CALL XABORT('INFWD4: WIMS LIBRARY HAS NOT BEEN SET')
      ENDIF
C----
C  OPEN WIMS-D4 LIBRARY
C  READ GENERAL DIMENSIONING
C----
      IUNIT=KDROPN(CFILNA,IACTO,IUTYPE,LRIND)
      IF(IUNIT.LE.0) CALL XABORT(
     > 'INFWD4: WIMS-D4 LIBRARY CANNOT BE OPENED FOR MIXS :'//CFILNA)
      READ(IUNIT) (NPZ(IT),IT=1,LPZ)
      NEL=NPZ(1)
      NGROUP=NPZ(2)
      IF(NEL.GT.MAXISO) THEN
        WRITE(IOUT,9000) MAXISO,NEL
        CALL XABORT('INFWD4: INVALID NUMBER OF ISOTOPES')
      ENDIF
      IF(NBISO.GT.MAXISO) THEN
        WRITE(IOUT,9001) NBISO,NEL
        CALL XABORT('INFWD4: INVALID NUMBER OF ISOTOPES')
      ENDIF
C----
C  READ ISOTOPE ID NUMBER AND CREATE EQUIVALENT ISOTOPE NAME
C  SCAN TO ASSOCIATE WIMS ISOTOPE NUMBER WITH DRAGON ISOTOPE NUMBER
C  VERIFY IF ALL ISOTOPES REQUIRED ARE PRESENT
C----
      READ(IUNIT) (IWISO(IEL),IEL=1,NEL)
      DO 100 IEL=1,NEL
        CWISO(IEL)='        '
        IF     (IWISO(IEL).LT.10) THEN
          WRITE(CWISO(IEL),'(I1)') IWISO(IEL)
        ELSE IF(IWISO(IEL).LT.100) THEN
          WRITE(CWISO(IEL),'(I2)') IWISO(IEL)
        ELSE IF(IWISO(IEL).LT.1000) THEN
          WRITE(CWISO(IEL),'(I3)') IWISO(IEL)
        ELSE IF(IWISO(IEL).LT.10000) THEN
          WRITE(CWISO(IEL),'(I4)') IWISO(IEL)
        ELSE IF(IWISO(IEL).LT.100000) THEN
          WRITE(CWISO(IEL),'(I5)') IWISO(IEL)
        ELSE IF(IWISO(IEL).LT.1000000) THEN
          WRITE(CWISO(IEL),'(I6)') IWISO(IEL)
        ELSE IF(IWISO(IEL).LT.10000000) THEN
          WRITE(CWISO(IEL),'(I7)') IWISO(IEL)
        ELSE IF(IWISO(IEL).LT.100000000) THEN
          WRITE(CWISO(IEL),'(I8)') IWISO(IEL)
        ENDIF
        DO 101 JSO=1,NBISO
          IF(HNAMIS(JSO).EQ.CWISO(IEL)) THEN
            ISORD(JSO)=IEL
          ENDIF
 101    CONTINUE
 100  CONTINUE
      IF(IPRINT.GE.100) THEN
        WRITE(IOUT,6000) (CWISO(IEL),IEL=1,NEL)
      ENDIF
      DO 102 JSO=1,NBISO
        IF(ISORD(JSO).EQ.0) THEN
          WRITE(IOUT,9002) HNAMIS(JSO),CFILNA
          CALL XABORT('INFWD4: MISSING ISOTOPE')
        ENDIF
 102  CONTINUE
C----
C  SKIP GROUP STRUCTURE, FISSION SPECTRUM, DEPLETION CHAIN
C  AND END RECORD
C----
      READ(IUNIT) RDUM
      READ(IUNIT) RDUM
      DO 110 IEL=1,NEL
        READ(IUNIT) IDUM
 110  CONTINUE
      READ(IUNIT) RDUM
      DO 120 IELRT=1,NEL
        READ(IUNIT) IDIEL,AWR,IZ,NFIEL,NTMP,NRIEL
C----
C  LOCATE ISOTOPE IN LIST OF LIBRARY ISOTOPES IN THE CASE
C  WHERE LIBRARY IS NOT COMPLETE OR THE ORDER OF ISOTOPE
C  STORED IS DIFFERENT FROM THAT OF THE ISOTOPE NAMES
C----
        IEL=0
        DO 121 JEL=1,NEL
          IF(IDIEL.EQ.IWISO(JEL)) THEN
            IEL=JEL
            GO TO 125
          ENDIF
 121    CONTINUE
        CALL XABORT('INFWD4: WIMSD4 LIBRARY INCOMPLETE')
 125    CONTINUE
C----
C   SCAN TO SEE IF ISOTOPE IS REQUIRED AND GET WEIGHTS.
C----
        DO 150 JSO=1,NBISO
          IF(ISORD(JSO).EQ.IEL) THEN
             AWRISO(JSO)=AWR
             GO TO 155
          ENDIF
 150    CONTINUE
 155    CONTINUE
C----
C  OTHER RECORDS FOR THIS ISOTOPE
C----
        READ(IUNIT) RDUM
        IF(NFIEL.GT.1) THEN
          READ(IUNIT) RDUM
        ENDIF
        READ(IUNIT) IDUM
        IF(NTMP.GT.0) THEN
          READ(IUNIT) RDUM
          DO 140 IT=1,NTMP
            READ(IUNIT) RDUM
            IF(NFIEL.GT.1) THEN
              READ(IUNIT) RDUM
            ENDIF
            READ(IUNIT) IDUM
 140      CONTINUE
        ENDIF
        READ(IUNIT) RDUM
 120  CONTINUE
      IERR=KDRCLS(IUNIT,IACTC)
      IF(IERR.LT.0) CALL XABORT(
     > 'INFWD4: Impossible to close WIMS-D4 library '//CFILNA)
C----
C  RETURN
C----
      RETURN
C----
C  FORMAT
C----
 9000 FORMAT(/' MAXIMUM NUMBER OF ISOTOPE SPECIFIED :',I10/
     >        ' NUMBER OF ISOTOPE IN LIBRARY        :',I10)
 9001 FORMAT(/' NUMBER OF ISOTOPE TO TREAT   :',I10/
     >        ' NUMBER OF ISOTOPE IN LIBRARY :',I10)
 9002 FORMAT(/' INFWD4: MATERIAL/ISOTOPE ',A64,
     >        ' IS MISSING ON WIMS-D4 FILE ',A8)
 6000 FORMAT(1X,'ISOTOPES ON LIBRARY'/6(4X,A8))
      END
