*DECK INF
      SUBROUTINE INF(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* driver for the dragon information module to recover cle-2000 values
* from the xs libraries (Wimslib, e5wlib, Apollib)
*
*Copyright:
* Copyright (C) 1995 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
*Author(s): R. Roy
*
*Parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
* IENTRY  type of each LCM object or file:
*         =1 LCM memory object; =2 XSM file; =3 sequential binary file;
*         =4 sequential ascii file.
* JENTRY  access of each LCM object or file:
*         =0 the LCM object or file is created;
*         =1 the LCM object or file is open for modifications;
*         =2 the LCM object or file is open in read-only mode.
* KENTRY  LCM object address or file unit number.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
      IMPLICIT NONE
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR)  KENTRY(NENTRY)
      CHARACTER    HENTRY(NENTRY)*12
*----
*  LOCAL VARIABLES
*----
      INTEGER  IOUT
      PARAMETER (IOUT=6)
      CHARACTER TEXT12*12,HNAMIS(3)*8
      CHARACTER TEXT64*64,CFILNA*64
      LOGICAL LTMP,LPUR,LENR,LISO
      INTEGER IPARM,I,IPISO(3),ITYPL
      INTEGER ITYP,NITMA,NOUT,NWRD,NSTP
      INTEGER ITYPE,ILOOP,NBISO,IPRINT
      DOUBLE  PRECISION DFLOTT
      REAL    FLOTT,RBASE(3),AWR(3)
      REAL    TEMPC,TEMPK,PURWGT,PURATM,ENRWGT,ENRATM,TOTMU
      PARAMETER ( NWRD=1, NSTP=1)
      IF( NENTRY.NE.0 )THEN
         CALL XABORT('INF: NO DATA STRUCTURE EXPECTED')
      ENDIF
*
      CFILNA=' '
      IPRINT= 1
      ITYPE=  2
      IPARM=  0
      NBISO=  0
      LTMP=.FALSE.
      LPUR=.FALSE.
      LENR=.FALSE.
      LISO=.FALSE.
      NOUT= 1
      ITYPL=0
      ENRWGT = 0.0
   20 CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
      IF( ITYP.NE.3 )CALL XABORT('INFO: CHARACTER DATA EXPECTED.')
      IF( TEXT12.EQ.';' )THEN
         GO TO 40
      ELSEIF( TEXT12.EQ.'EDIT' )THEN
         CALL REDGET(ITYP,IPRINT,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.1 )CALL XABORT('INFO: INTEGER EXPECTED.')
         DO I=1,NENTRY
           WRITE(IOUT,*) HENTRY(I),IENTRY(I),JENTRY(I)
           IF(IENTRY(I).LE.2) CALL LCMLIB(KENTRY(I))
         ENDDO
         GO TO 20
      ELSEIF( TEXT12.EQ.'LIB:' )THEN
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.3 ) CALL XABORT
     >     ('INFO: LIBRARY TYPE NOT SPECIFIED FOLLOWING LIB:')
         IF(TEXT12.EQ.'WIMS'.OR.TEXT12.EQ.'WIMSAECL') THEN
           ITYPL=1
         ELSE IF(TEXT12.EQ.'WIMSD4') THEN
           ITYPL=2
         ELSE IF(TEXT12.EQ.'APLIB1') THEN
           ITYPL=3
         ELSE IF(TEXT12.EQ.'DRAGON') THEN
           ITYPL=4
         ELSE IF(TEXT12.EQ.'MATXS ') THEN
           ITYPL=5
         ELSE IF(TEXT12.EQ.'MATXS2') THEN
           ITYPL=6
         ELSE IF(TEXT12.EQ.'NDAS') THEN
           ITYPL=7
         ELSE
           CALL XABORT('INFO: ILLEGAL LIBRARY TYPE FOLLOWING LIB:')
         ENDIF
          CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.3.OR.TEXT12.NE.'FIL:' )
     >      CALL XABORT('INFO: *FIL:* EXPECTED.')
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT64,DFLOTT)
         IF( ITYP.NE.3 )CALL XABORT('INFO: LIBRARY NAME EXPECTED.')
         CFILNA= TEXT64
         GO TO 20
      ELSEIF( TEXT12.EQ.'TMP:' )THEN
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.2 )
     >      CALL XABORT('INFO: TEMPERATURE EXPECTED.')
         TEMPC = FLOTT
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.3)
     >      CALL XABORT('INFO: *C* OR *K* UNIT EXPECTED.')
         IF( TEXT12.EQ.'K' )THEN
            TEMPK = TEMPC
            TEMPC = TEMPK - 273.16
         ELSEIF( TEXT12.EQ.'C' )THEN
            TEMPK = TEMPC + 273.16
         ELSE
            CALL XABORT('INFO: *C* OR *K* UNIT EXPECTED.')
         ENDIF
         LTMP=.TRUE.
         GO TO 20
      ELSEIF( TEXT12.EQ.'PUR:' )THEN
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.2 )
     >      CALL XABORT('INFO: TEMPERATURE EXPECTED.')
         PURWGT = FLOTT
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.3)CALL XABORT('INFO: *ATM%* OR *WGT%* '
     >                           //'UNIT EXPECTED.')
         IF( TEXT12.EQ.'ATM%' )THEN
            PURATM= PURWGT
            PURWGT= 100.0/(1. + 0.8994866*(100./PURATM - 1.))
         ELSEIF( TEXT12.EQ.'WGT%' )THEN
            PURATM= 100.0/(1. + 1.1117435*(100./PURWGT - 1.))
         ELSE
            CALL XABORT('INFO: *ATM%* OR *WGT%* UNIT EXPECTED.')
         ENDIF
         LPUR=.TRUE.
         GO TO 20
      ELSEIF( TEXT12.EQ.'ENR:' )THEN
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.2 )
     >      CALL XABORT('INFO: ENRICHMENT EXPECTED.')
         ENRWGT = FLOTT
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.3)CALL XABORT('INFO: *ATM%* OR *WGT%* '
     >                           //'UNIT EXPECTED.')
         IF( TEXT12.EQ.'ATM%' )THEN
            ENRATM= ENRWGT
            ENRWGT= 100.0/(1. + 1.01279335*(100./ENRATM - 1.))
         ELSEIF( TEXT12.EQ.'WGT%' )THEN
            ENRATM= 100.0/(1. + 0.98736825*(100./ENRWGT - 1.))
         ELSE
            CALL XABORT('INFO: *ATM%* OR *WGT%* UNIT EXPECTED.')
         ENDIF
         LENR=.TRUE.
         GO TO 20
      ELSEIF( TEXT12.EQ.'ISO:' )THEN
         IF( NBISO.NE.0 )
     >      CALL XABORT('INFO: PREVIOUS ISOTOPES NOT USED.')
         CALL REDGET(ITYP,NBISO,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.1 )
     >      CALL XABORT('INFO: NUMBER OF ISOTOPES EXPECTED.')
         IF( NBISO.LE.0.OR.NBISO.GT.3 )
     >      CALL XABORT('INFO: NB OF ISOTOPES MUST BE BETWEEN 1 AND 3.')
         DO 31 I=1,NBISO
            CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
            IF( ITYP.NE.3)
     >         CALL XABORT('INFO: ISOTOPE NAME EXPECTED.')
            HNAMIS(I)= TEXT12(1:8)
   31    CONTINUE
         IF(ITYPL.EQ.1)THEN
            CALL INFWIM(CFILNA,IPRINT,NBISO,HNAMIS,AWR)
         ELSE IF(ITYPL.EQ.2)THEN
            CALL INFWD4(CFILNA,IPRINT,NBISO,HNAMIS,AWR)
         ELSE IF(ITYPL.EQ.3)THEN
            CALL INFAPL(CFILNA,IPRINT,NBISO,HNAMIS,AWR)
         ELSE IF(ITYPL.EQ.4)THEN
            CALL INFDRA(CFILNA,IPRINT,NBISO,HNAMIS,AWR)
         ELSE IF(ITYPL.EQ.5)THEN
            CALL INFTR1(CFILNA,IPRINT,NBISO,HNAMIS,AWR)
         ELSE IF(ITYPL.EQ.6)THEN
            CALL INFTR2(CFILNA,IPRINT,NBISO,HNAMIS,AWR)
         ELSE IF(ITYPL.EQ.7)THEN
            CALL INFNDA(CFILNA,IPRINT,NBISO,HNAMIS,AWR)
         ENDIF
         GO TO 20
      ELSEIF( TEXT12.EQ.'CALC' )THEN
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.3 )CALL XABORT('INFO: *DENS* EXPECTED.')
         IF( TEXT12.EQ.'DENS' ) THEN
            CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
            IF(ITYP.NE.3) CALL XABORT('INFO: *WATER* EXPECTED.')
            IF( TEXT12.EQ.'WATER' ) THEN
               IF( .NOT.LTMP )
     >            CALL XABORT('INFO: NO TEMPERATURE GIVEN.')
               IF( .NOT.LPUR )
     >            CALL XABORT('INFO: NO PURITY      GIVEN.')
               CALL INFWAT(TEMPC,PURWGT,RBASE(1))
               NOUT= 1
            ELSE
               CALL XABORT('INFO: *WATER* EXPECTED.')
            ENDIF
         ELSEIF(TEXT12.EQ.'WGT%')THEN
            CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
            IF( ITYP.NE.3)
     >         CALL XABORT('INFO: *D2O* OR *UO2* EXPECTED.')
            IF( NBISO.NE.3 )
     >         CALL XABORT('INFO: NB OF ISOTOPES MUST BE 3.')
            IPISO(1)= 0
            IPISO(2)= 0
            IPISO(3)= 0
            IF( TEXT12.EQ.'UO2' )THEN
               IF( .NOT.LENR )
     >            CALL XABORT('INFO: NO ENRICHMENT  GIVEN.')
               DO 32 I=1,NBISO
                  IF( 15.8.LT.AWR(I).AND.AWR(I).LT.16.2 )THEN
                     IPISO(1)= I
                  ELSEIF( 234.8.LT.AWR(I).AND.AWR(I).LT.235.2 )THEN
                     IPISO(2)= I
                  ELSEIF( 237.8.LT.AWR(I).AND.AWR(I).LT.238.2 )THEN
                     IPISO(3)= I
                  ELSE
                     CALL XABORT('INFO: NOT A U5,U8 OR O ISOTOPE.')
                  ENDIF
   32          CONTINUE
               IF( IPISO(1)*IPISO(2)*IPISO(3).EQ.0 )
     >            CALL XABORT('INFO: MISSING ONE OF TH2,U3 OR O.')
               RBASE(IPISO(2))=       ENRWGT
               RBASE(IPISO(3))= 100.- ENRWGT
               RBASE(IPISO(1))= 2.*AWR(IPISO(1))*
     > (RBASE(IPISO(2))/AWR(IPISO(2))+ RBASE(IPISO(3))/AWR(IPISO(3)))
               TOTMU=  RBASE(IPISO(1))+RBASE(IPISO(2))+RBASE(IPISO(3))
               RBASE(IPISO(1))= 100.*RBASE(IPISO(1))/TOTMU
               RBASE(IPISO(2))= 100.*RBASE(IPISO(2))/TOTMU
               RBASE(IPISO(3))= 100.*RBASE(IPISO(3))/TOTMU
             ELSEIF( TEXT12.EQ.'THO2' )THEN
               IF( .NOT.LENR )
     >            CALL XABORT('INFO: NO ENRICHMENT  GIVEN.')
               DO 325 I=1,NBISO
                  IF( 15.8.LT.AWR(I).AND.AWR(I).LT.16.2 )THEN
                     IPISO(1)= I
                  ELSEIF( 232.8.LT.AWR(I).AND.AWR(I).LT.233.2 )THEN
                     IPISO(2)= I
                  ELSEIF( 231.8.LT.AWR(I).AND.AWR(I).LT.232.2 )THEN
                     IPISO(3)= I
                  ELSE
                     CALL XABORT('INFO: NOT A TH2,U3 OR O ISOTOPE.')
                  ENDIF
  325          CONTINUE
               IF( IPISO(1)*IPISO(2)*IPISO(3).EQ.0 )
     >            CALL XABORT('INFO: MISSING ONE OF TH2,U3 OR O.')
               RBASE(IPISO(2))=       ENRWGT
               RBASE(IPISO(3))= 100.- ENRWGT
               RBASE(IPISO(1))= 2.*AWR(IPISO(1))*
     > (RBASE(IPISO(2))/AWR(IPISO(2))+ RBASE(IPISO(3))/AWR(IPISO(3)))
               TOTMU=  RBASE(IPISO(1))+RBASE(IPISO(2))+RBASE(IPISO(3))
               RBASE(IPISO(1))= 100.*RBASE(IPISO(1))/TOTMU
               RBASE(IPISO(2))= 100.*RBASE(IPISO(2))/TOTMU
               RBASE(IPISO(3))= 100.*RBASE(IPISO(3))/TOTMU
           ELSEIF( TEXT12.EQ.'D2O')THEN
               IF( .NOT.LPUR )
     >            CALL XABORT('INFO: NO PURITY      GIVEN.')
               DO 33 I=1,NBISO
                  IF( 15.8.LT.AWR(I).AND.AWR(I).LT.16.2 )THEN
                     IPISO(1)= I
                  ELSEIF( 0.8.LT.AWR(I).AND.AWR(I).LT.1.2 )THEN
                     IPISO(2)= I
                  ELSEIF( 1.8.LT.AWR(I).AND.AWR(I).LT.2.2 )THEN
                     IPISO(3)= I
                  ELSE
                     CALL XABORT('INFO: NOT A H1,D2 OR O ISOTOPE.')
                  ENDIF
   33          CONTINUE
               IF( IPISO(1)*IPISO(2)*IPISO(3).EQ.0 )
     >            CALL XABORT('INFO: MISSING ONE OF H1,D2 OR O.')
               RBASE(IPISO(2))= (100.-PURWGT)*2.*AWR(IPISO(2))/
     >                         (2.*AWR(IPISO(2))+AWR(IPISO(1)))
               RBASE(IPISO(3))=       PURWGT *2.*AWR(IPISO(3))/
     >                         (2.*AWR(IPISO(3))+AWR(IPISO(1)))
               RBASE(IPISO(1))= 100.-(RBASE(IPISO(2))+RBASE(IPISO(3)))
            ELSE
               CALL XABORT('INFO: *D2O* OR *UO2* EXPECTED.')
            ENDIF
            NOUT= NBISO
            NBISO= 0
         ELSE
            CALL XABORT('INFO: *DENS* OR *WGT%* EXPECTED.')
         ENDIF
      ELSEIF( TEXT12.EQ.'GET' )THEN
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.3 )CALL XABORT('INFO: *MASS* EXPECTED.')
         IF( TEXT12.EQ.'MASS' ) THEN
            IF( NBISO.EQ.0 )
     >         CALL XABORT('INFO: ISOTOPE LIST NOT SPECIFIED.')
            NOUT= NBISO
            NBISO= 0
            DO 39 ILOOP= 1, NOUT, NSTP
               RBASE(ILOOP)= AWR(ILOOP)
   39       CONTINUE
         ELSE
            CALL XABORT('INFO: *MASS* EXPECTED.')
         ENDIF
      ELSE
         CALL XABORT('INFO: '//TEXT12//' IS AN INVALID KEYWORD.')
      ENDIF
*----
*  PUT PARMS IN CLE-2000 REAL VARIABLES (WRITE MODE).
*----
      DO 35 ILOOP= 1, NOUT, NSTP
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.-ITYPE )THEN
            CALL XABORT('INF: INVALID TYPE FOR OUTPUT VALUE')
         ELSEIF( IPRINT.GT.0 )THEN
            WRITE(IOUT,6000) TEXT12,RBASE(ILOOP)
         ENDIF
         CALL REDPUT(ITYPE,NITMA,RBASE(ILOOP),TEXT12,DFLOTT)
   35 CONTINUE
      GO TO 20
   40 CONTINUE
      RETURN
*
 6000 FORMAT(' INF: ',A12,' <- ',1P,E15.7)
      END
