*DECK THM
      SUBROUTINE THM(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* simplified thermal-hydraulics module.
*
*Copyright:
* Copyright (C) 2012 Ecole Polytechnique de Montreal.
*
*Author(s): A. Hebert
*
*Parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): create or modification type(L_THM);
*         HENTRY(2): modification type(L_MAP);
* 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
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR)  KENTRY(NENTRY)
      CHARACTER    HENTRY(NENTRY)*12
*----
*  LOCAL VARIABLES
*----
      PARAMETER(NSTATE=40,IOUT=6,PI=3.141592654)
      PARAMETER(IMAXO=100,JMAXO=100,KMAXO=100)
      CHARACTER TEXT*40,HSIGN*12,PNAME*12
      INTEGER ISTATE(NSTATE)
      REAL STATE(NSTATE)
      REAL HX(IMAXO), HY(JMAXO), HZ(KMAXO)
      DOUBLE PRECISION DFLOT
      TYPE(C_PTR) IPTHM,IPMAP,JPMAP,KPMAP
      INTEGER, ALLOCATABLE, DIMENSION(:) :: NUM
      REAL, ALLOCATABLE, DIMENSION(:) :: XX,YY,ZZ,BURN,PW,VAL
      REAL, ALLOCATABLE, DIMENSION(:) :: XBURN,POW,TCOMB,DCOOL,TCOOL,
     1 TSURF
*----
*  PARAMETER VALIDATION
*----
      IF(NENTRY.NE.2)CALL XABORT('@THM: 2 PARAMETERS EXPECTED.')
      IPTHM=KENTRY(1)
      IPMAP=KENTRY(2)
      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@THM:'
     1 //' LCM OBJECT EXPECTED AT FIRST LHS.')
      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@THM:'
     1 //' LCM OBJECT EXPECTED AT SECOND LHS.')
      CALL LCMGTC(IPMAP,'SIGNATURE',12,1,HSIGN)
      IF(HSIGN.NE.'L_MAP')THEN
        TEXT=HENTRY(2)
        CALL XABORT('@USPLIT: SIGNATURE OF '//TEXT//' IS '//HSIGN//
     1  '. L_MAP EXPECTED.')
      ENDIF
*----
*  RECOVER L_MAP STATE-VECTOR
*----
      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
      NB=ISTATE(1)
      NCH=ISTATE(2)
      NPARM=ISTATE(8)
*----
*  READ DATA
*----
      IMPX=1
      TIME=0.0
      FPUISS=0.974
      CFLUX=2.0E+6
      SPEED=0.0
      TINLET=0.
      PINLET=0.0
      FRACPU=0.0
      POROS=0.05
      RC=0.0
      RIG=0.0
      RGG=0.0
      RTG=0.0
      SASS=0.0
      NFU=0
      NTG=0
      MAXIT1=50
      MAXIT2=15
      ERMAX=1.0
      NFD=6
      IF(JENTRY(1).EQ.1) THEN
        CALL LCMGET(IPTHM,'STATE-VECTOR',ISTATE)
        NFU=ISTATE(1)
        NTG=ISTATE(2)
        MAXIT1=ISTATE(3)
        MAXIT2=ISTATE(4)
        NFD=ISTATE(5)
        CALL LCMGET(IPTHM,'REAL-PARAM',STATE)
        TIME=STATE(1)
        FPUISS=STATE(2)
        CFLUX=STATE(3)
        SPEED=STATE(4)
        PINLET=STATE(5)
        TINLET=STATE(6)
        FRACPU=STATE(7)
        POROS=STATE(8)
        RC=STATE(9)
        RIG=STATE(10)
        RGG=STATE(11)
        RTG=STATE(12)
        SASS=STATE(13)
        ERMAX=STATE(14)
      ENDIF
   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(ITYP.EQ.10)GO TO 20
      IF(ITYP.NE.3)CALL XABORT('@THM: CHARACTER DATA EXPECTED.')
      IF(TEXT.EQ.'EDIT') THEN
*       READ PRINTING INDEX
        CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR EDIT EXPECTED.')
      ELSE IF(TEXT.EQ.'TIME') THEN
        CALL REDGET(ITYP,NITMA,TIME,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR TIME EXPECTED.')
      ELSE IF(TEXT.EQ.'FPUISS') THEN
*       Coolant power factor
        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(ITYP.EQ.2) THEN
           FPUISS=FLOT
        ELSE
           CALL XABORT('@THM: REAL FOR FPUISS EXPECTED.')
        ENDIF
      ELSE IF(TEXT.EQ.'CRITFL') THEN
*       Critical heat flux (W/m^2)
        CALL REDGET(ITYP,NITMA,CFLUX,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR CFLUX EXPECTED.')
      ELSE IF(TEXT.EQ.'CWSECT') THEN
*       Core coolant section (m^2)
        CALL REDGET(ITYP,NITMA,CWSECT,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR CWSECT EXPECTED.')
*       Coolant flow (m^3/h)
        CALL REDGET(ITYP,NITMA,FLOW,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR FLOW EXPECTED.')
        SPEED=FLOW/(3600.0*CWSECT)
      ELSE IF(TEXT.EQ.'SPEED') THEN
*       Coolant velocity (m/s)
        CALL REDGET(ITYP,NITMA,SPEED,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR SPEED EXPECTED.')
      ELSE IF(TEXT.EQ.'INLET') THEN
*       The PINLET and TINLET information is used to compute initial
*       enthalpy and water density.
*       Inlet pressure (Pa)
        CALL REDGET(ITYP,NITMA,PINLET,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR PINLET EXPECTED.')
*       Inlet temperature (K)
        CALL REDGET(ITYP,NITMA,TINLET,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR TINLET EXPECTED.')
      ELSE IF(TEXT.EQ.'PUFR') THEN
*       Plutonium mass enrichment
        CALL REDGET(ITYP,NITMA,FRACPU,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR PUFR EXPECTED.')
      ELSE IF(TEXT.EQ.'POROS') THEN
*       Oxyde porosity
        CALL REDGET(ITYP,NITMA,POROS,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR POROS EXPECTED.')
      ELSE IF(TEXT.EQ.'RADIUS') THEN
*       Fuel pellet radius (m)
        CALL REDGET(ITYP,NITMA,RC,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RC EXPECTED.')
*       Internal clad rod radius (m)
        CALL REDGET(ITYP,NITMA,RIG,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RIG EXPECTED.')
*       External clad rod radius (m)
        CALL REDGET(ITYP,NITMA,RGG,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RGG EXPECTED.')
*       Guide tube radius (m)
        CALL REDGET(ITYP,NITMA,RTG,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RTG EXPECTED.')
      ELSE IF(TEXT.EQ.'ASSMB') THEN
*       Assembly surface (m^2)
        CALL REDGET(ITYP,NITMA,SASS,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR SASS EXPECTED.')
*       Number of active fuel rods
        CALL REDGET(ITYP,NFU,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR NFU EXPECTED.')
*       Number of guide tubes
        CALL REDGET(ITYP,NTG,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR NTG EXPECTED.')
      ELSE IF(TEXT.EQ.'CONV') THEN
*       Number of conduction iterations
        CALL REDGET(ITYP,MAXIT1,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR MAXIT1 EXPECTED.')
*       Number of center-pellet iterations
        CALL REDGET(ITYP,MAXIT2,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR MAXIT2 EXPECTED.')
*       Temperature maximum error (K)
        CALL REDGET(ITYP,NITMA,ERMAX,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@THM: REAL FOR ERMAX EXPECTED.')
      ELSE IF(TEXT.EQ.'RODMESH') THEN
*       Number of discretisation points in fuel
        CALL REDGET(ITYP,NFD,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR NFD EXPECTED.')
      ELSE IF(TEXT.EQ.'SET-PARAM') THEN
*       Reset a global parameter
        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.3)CALL XABORT('@THM: CHARACTER NAME EXPECTED.')
        CALL REDGET(ITYP,NITMA,VALUE,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR VALUE EXPECTED.')
        JPMAP=LCMGID(IPMAP,'PARAM')
        DO 15 IPAR=1,NPARM
        KPMAP=LCMGIL(JPMAP,IPAR)
        CALL LCMGTC(KPMAP,'P-NAME',12,1,PNAME)
        CALL LCMGET(KPMAP,'P-TYPE',ITYPE)
        IF(ITYPE.EQ.1) THEN
          IF(PNAME.EQ.TEXT) THEN
            CALL LCMPUT(KPMAP,'P-VALUE',1,2,VALUE)
            IF(IMPX.GT.0) WRITE(6,200) PNAME,VALUE
            GO TO 10
          ELSE
            GO TO 15
          ENDIF
        ELSE IF(ITYPE.EQ.2) THEN
          CALL XABORT('@THM: CANNOT RESET LOCAL PARAMETER: '//TEXT)
        ENDIF
   15   CONTINUE
        CALL XABORT('@THM: GLOBAL PARAMETER NAME NOT FOUND: '//TEXT)
      ELSE IF(TEXT.EQ.';') THEN
        GO TO 20
      ELSE
        CALL XABORT('@THM: INVALID KEYWORD: '//TEXT//'.')
      ENDIF
      GO TO 10
*----
*  TEST DATA INPUT
*----
   20 IF(SPEED.EQ.0.0) CALL XABORT('@THM: ZERO COOLANT SPEED.')
      IF(TINLET.EQ.0.0) CALL XABORT('@THM: ZERO INLET TEMPERATURE.')
      IF(PINLET.EQ.0.0) CALL XABORT('@THM: ZERO INLET PRESSURE.')
      IF(RC.EQ.0.0) CALL XABORT('@THM: ZERO FUEL PELLET RADIUS.')
      IF(RIG.EQ.0.0) CALL XABORT('@THM: ZERO INTERNAL CLAD ROD RADIUS.')
      IF(RGG.EQ.0.0) CALL XABORT('@THM: ZERO EXTERNAL CLAD ROD RADIUS.')
      IF(SASS.EQ.0.0) CALL XABORT('@THM: ZERO ASSEMBLY SURFACE.')
      IF(NFU.EQ.0) CALL XABORT('@THM: NO FUEL RODS.')
*----
*  RECOVER GEOMAP STATE-VECTOR
*----
      JPMAP=LCMGID(IPMAP,'GEOMAP')
      CALL LCMGET(JPMAP,'STATE-VECTOR',ISTATE)
      IF(ISTATE(1).NE.7) CALL XABORT('@THM:'
     1 //' 3-D CARTESIAN GEOMETRY EXPECTED.')
      NX=ISTATE(3)
      NY=ISTATE(4)
      NZ=ISTATE(5)
      NEL=ISTATE(6)
      IF(NX.GT.IMAXO) CALL XABORT('@THM: NX OVERFLOW.')
      IF(NY.GT.JMAXO) CALL XABORT('@THM: NY OVERFLOW.')
      IF(NZ.GT.KMAXO) CALL XABORT('@THM: NZ OVERFLOW.')
*----
*  COMPUTE HYDRAULICS CONSTANTS
*  RC:      fuel pellet radius in m
*  RTG:     guide tube radius in m
*  ACOOL:   coolant cross section per assembly in m^2
*  RAPCOOL: assembly over coolant volumic ratio
*  RAPFUEL: assembly over fuel volumic ratio
*  FCOOL:   power density fraction in coolant.
*  FFUEL:   power density fraction in fuel.
*  PCH:     heating perimeter in m
*  PM:      perimeter in contact with flow in m
*  HD:      hydraulic diameter of one assembly in m
*  SPEED:   inlet flow velocity in m/s
*----
      ACOOL=SASS-NFU*PI*RGG*RGG-NTG*PI*RTG*RTG
      RAPCOOL=SASS/ACOOL
      RAPFUEL=SASS/(NFU*PI*RC*RC)
      FCOOL=(1.0-FPUISS)*RAPCOOL
      FFUEL=FPUISS*RAPFUEL
      PCH=NFU*2.0*PI*RGG
      PM=PCH+NTG*2.0*PI*RTG
      HD=4.0*ACOOL/PM
*----
*  RECOVER REACTOR MESH IN METER
*----
      ALLOCATE(XX(NX+1),YY(NY+1),ZZ(NZ+1))
      CALL LCMGET(JPMAP,'MESHX',XX)
      CALL LCMGET(JPMAP,'MESHY',YY)
      CALL LCMGET(JPMAP,'MESHZ',ZZ)
      DO 30 I=1,NX
   30 HX(I)=(XX(I+1)-XX(I))/100.0
      DO 40 I=1,NY
   40 HY(I)=(YY(I+1)-YY(I))/100.0
      DO 50 I=1,NZ
   50 HZ(I)=(ZZ(I+1)-ZZ(I))/100.0
      DEALLOCATE(ZZ,YY,XX)
*----
*  RECOVER LOCAL PARAMETER INFORMATION FROM L_MAP OBJECT
*----
      ALLOCATE(NUM(NEL),BURN(NCH*NB),PW(NCH*NB))
      CALL LCMGET(IPMAP,'BMIX',NUM)
      CALL LCMGET(IPMAP,'BURN-INST',BURN)
      CALL LCMGET(IPMAP,'BUND-PW',PW)
      IF(IMPX.GT.2) THEN
        PTOT=0.0
        DO I=1,NCH*NB
          PTOT=PTOT+PW(I)
        ENDDO
        WRITE(6,*) 'THM: total power=',PTOT*1.0E3,' W'
      ENDIF
*----
*  REBUILD LOCAL PARAMETER INFORMATION FOR THM:
*----
      IC=NX
      JC=NY
      KC=NZ
      ALLOCATE(XBURN(IC*JC*KC),POW(IC*JC*KC))
      CALL XDRSET(XBURN,IC*JC*KC,0.0)
      CALL XDRSET(POW,IC*JC*KC,0.0)
      ICH=0
      DO 70 IY=1,NY
      DO 70 IX=1,NX
      IEL=(IY-1)*NX+IX
      DO 55 IZ=1,NZ
      IF(NUM((IZ-1)*NX*NY+IEL).NE.0) GO TO 56
   55 CONTINUE
      GO TO 70
   56 ICH=ICH+1
      IB=0
      DO 60 IZ=1,NZ
      IF(NUM((IZ-1)*NX*NY+IEL).EQ.0) GO TO 60
      IB=IB+1
      IMA=(IB-1)*NCH+ICH
      ITH=(IZ-1)*IC*JC+(IY-1)*IC+IX
      XBURN(ITH)=BURN(IMA)
      POW(ITH)=PW(IMA)*1.0E3
   60 CONTINUE
      IF(IB.NE.NB) CALL XABORT('@THM: INVALID NUMBER OF BUNDLES.')
   70 CONTINUE
      IF(ICH.NE.NCH) CALL XABORT('@THM: INVALID NUMBER OF CHANNELS.')
      DEALLOCATE(PW,BURN)
*----
*  CALL DRIVER
*----
      ALLOCATE(TCOMB(IC*JC*KC),DCOOL(IC*JC*KC),TCOOL(IC*JC*KC),
     1 TSURF(IC*JC*KC))
      CALL XDRSET(TCOMB,IC*JC*KC,0.0)
      CALL XDRSET(DCOOL,IC*JC*KC,0.0)
      CALL XDRSET(TCOOL,IC*JC*KC,0.0)
      CALL XDRSET(TSURF,IC*JC*KC,0.0)
      CALL THMDRV(IMPX,IC,JC,KC,XBURN,HX,HY,HZ,TIME,CFLUX,POROS,
     > NFU,NFD,SASS,FCOOL,FFUEL,ACOOL,HD,PCH,RGG,RIG,RC,MAXIT1,
     > MAXIT2,ERMAX,SPEED,TINLET,PINLET,FRACPU,POW,TCOMB,DCOOL,
     > TCOOL,TSURF)
*----
*  RECOVER LOCAL PARAMETER INFORMATION COMPUTED BY THMDRV
*----
      ERRA1=0.0
      ERRA2=0.0
      ERRA3=0.0
      ERRBB=0.0
      ZMINA1=1.0E10
      ZMINA2=1.0E10
      ZMINA3=1.0E10
      ZMINBB=1.0E10
      ZMAXA1=0.0
      ZMAXA2=0.0
      ZMAXA3=0.0
      ZMAXBB=0.0
      JPMAP=LCMGID(IPMAP,'PARAM')
      DO 150 IPAR=1,NPARM
      KPMAP=LCMGIL(JPMAP,IPAR)
      CALL LCMGTC(KPMAP,'P-NAME',12,1,PNAME)
      IF((PNAME.EQ.'T-FUEL').OR.(PNAME.EQ.'D-COOL').OR.
     1   (PNAME.EQ.'T-COOL').OR.(PNAME.EQ.'T-SURF')) THEN
        CALL LCMGET(KPMAP,'P-TYPE',ITYPE)
        ALLOCATE(VAL(NCH*NB))
        IF(ITYPE.EQ.1) THEN
          IF(IMPX.GT.0) WRITE(6,210) 'GLOBAL',PNAME
          CALL LCMGET(KPMAP,'P-VALUE',FLOT)
          DO 100 ICH=1,NCH
          DO 100 IB=1,NB
          IMA=(IB-1)*NCH+ICH
  100     VAL(IMA)=FLOT
        ELSE IF(ITYPE.EQ.2) THEN
          IF(IMPX.GT.0) WRITE(6,210) 'LOCAL',PNAME
          CALL LCMGET(KPMAP,'P-VALUE',VAL)
        ENDIF
        ICH=0
        DO 140 IY=1,NY
        DO 140 IX=1,NX
        IEL=(IY-1)*NX+IX
        DO 110 IZ=1,NZ
        IF(NUM((IZ-1)*NX*NY+IEL).NE.0) GO TO 120
  110   CONTINUE
        GO TO 140
  120   ICH=ICH+1
        IB=0
        DO 130 IZ=1,NZ
        IF(NUM((IZ-1)*NX*NY+IEL).EQ.0) GO TO 130
        IB=IB+1
        IMA=(IB-1)*NCH+ICH
        ITH=(IZ-1)*IC*JC+(IY-1)*IC+IX
        IF(PNAME.EQ.'T-FUEL') THEN
          ERRA1=MAX(ERRA1,ABS(VAL(IMA)-TCOMB(ITH)))
          ZMINA1=MIN(ZMINA1,TCOMB(ITH))
          ZMAXA1=MAX(ZMAXA1,TCOMB(ITH))
          VAL(IMA)=TCOMB(ITH)
        ELSE IF(PNAME.EQ.'D-COOL') THEN
          ERRA2=MAX(ERRA2,ABS(VAL(IMA)-DCOOL(ITH)))
          ZMINA2=MIN(ZMINA2,DCOOL(ITH))
          ZMAXA2=MAX(ZMAXA2,DCOOL(ITH))
          VAL(IMA)=DCOOL(ITH)
        ELSE IF(PNAME.EQ.'T-COOL') THEN
          ERRA3=MAX(ERRA3,ABS(VAL(IMA)-TCOOL(ITH)))
          ZMINA3=MIN(ZMINA3,TCOOL(ITH))
          ZMAXA3=MAX(ZMAXA3,TCOOL(ITH))
          VAL(IMA)=TCOOL(ITH)
        ELSE IF(PNAME.EQ.'T-SURF') THEN
          ERRBB=MAX(ERRBB,ABS(VAL(IMA)-TSURF(ITH)))
          ZMINBB=MIN(ZMINBB,TSURF(ITH))
          ZMAXBB=MAX(ZMAXBB,TSURF(ITH))
          VAL(IMA)=TSURF(ITH)
        ELSE
          CALL XABORT('@THM: INVALID PARAMETER TYPE: '// PNAME//'.')
        ENDIF
  130   CONTINUE
  140   CONTINUE
        ITYPE=2
        CALL LCMPUT(KPMAP,'P-TYPE',1,1,ITYPE)
        CALL LCMPUT(KPMAP,'P-VALUE',NCH*NB,2,VAL)
        DEALLOCATE(VAL)
      ENDIF
  150 CONTINUE
      CALL LCMPUT(IPTHM,'ERROR-T-FUEL',1,2,ERRA1)
      CALL LCMPUT(IPTHM,'ERROR-D-COOL',1,2,ERRA2)
      CALL LCMPUT(IPTHM,'ERROR-T-COOL',1,2,ERRA3)
      IF(ZMAXBB.NE.0.0) CALL LCMPUT(IPTHM,'ERROR-T-SURF',1,2,ERRBB)
      IF(IMPX.GT.0) THEN
        WRITE(6,220) 'FUEL TEMPERATURE',ERRA1,'C',ZMINA1,'C',ZMAXA1,'C'
        WRITE(6,220) 'COOLANT DENSITY',ERRA2,'G/CC',ZMINA2,'G/CC',
     1  ZMAXA2,'G/CC'
        WRITE(6,220) 'COOLANT TEMPERATURE',ERRA3,'C',ZMINA3,'C',ZMAXA3,
     1  'C'
        IF(ZMAXBB.NE.0.0) WRITE(6,220) 'FUEL SURFACE TEMPERATURE',ERRBB,
     1  'C',ZMINBB,'C',ZMAXBB,'C'
      ENDIF
*----
*  RELEASE MEMORY
*----
      DEALLOCATE(TCOMB,DCOOL,TCOOL,TSURF,NUM,POW,XBURN)
*----
*  STATE-VECTOR FOR THM
*----
      HSIGN='L_THM'
      CALL LCMPTC(IPTHM,'SIGNATURE',12,1,HSIGN)
      CALL XDISET(ISTATE,NSTATE,0)
      ISTATE(1)=NFU
      ISTATE(2)=NTG
      ISTATE(3)=MAXIT1
      ISTATE(4)=MAXIT2
      ISTATE(5)=NFD
      CALL LCMPUT(IPTHM,'STATE-VECTOR',NSTATE,1,ISTATE)
      CALL XDRSET(STATE,NSTATE,0.0)
      STATE(1)=TIME
      STATE(2)=FPUISS
      STATE(3)=CFLUX
      STATE(4)=SPEED
      STATE(5)=PINLET
      STATE(6)=TINLET
      STATE(7)=FRACPU
      STATE(8)=POROS
      STATE(9)=RC
      STATE(10)=RIG
      STATE(11)=RGG
      STATE(12)=RTG
      STATE(13)=SASS
      STATE(14)=ERMAX
      CALL LCMPUT(IPTHM,'REAL-PARAM',NSTATE,2,STATE)
      IF(IMPX.GT.0) THEN
         WRITE(6,230) (ISTATE(ITC),ITC=1,5)
         WRITE(6,240) (STATE(ITC),ITC=1,14)
      ENDIF
      IF(IMPX.GT.2) CALL LCMLIB(IPTHM)
      RETURN
*
  200 FORMAT(/27H THM: SET GLOBAL PARAMETER ,A,2H =,1P E12.4)
  210 FORMAT(/14H THM: RECOVER ,A,13H PARAMETER = ,A,1H.)
  220 FORMAT(/15H THM: ERROR ON ,A,2H =,F9.3,1X,A,13H  MIN VALUE =,
     1 F9.3,1X,A,13H  MAX VALUE =,F9.3,1X,A)
  230 FORMAT(/
     1 14H STATE VECTOR:/
     2 7H NFU   ,I9,31H   (NUMBER OF ACTIVE FUEL RODS)/
     3 7H NTG   ,I9,32H   (NUMBER OF RODS WITHOUT FUEL)/
     4 7H MAXIT1,I9,36H   (NUMBER OF CONDUCTION ITERATIONS)/
     5 7H MAXIT2,I9,39H   (NUMBER OF CENTER-PELLET ITERATIONS)/
     6 7H NFD   ,I9,27H   (NUMBER OF RADIAL ZONES))
  240 FORMAT(/
     1 12H REAL PARAM:,1P/
     2 7H TIME  ,E12.4,14H   (TIME IN S)/
     2 7H FPUISS,E12.4,25H   (COOLANT POWER FACTOR)/
     2 7H CFLUX ,E12.4,32H   (CRITICAL HEAT FLUX IN W/M^2)/
     2 7H SPEED ,E12.4,28H   (COOLANT VELOCITY IN M/S)/
     2 7H PINLET,E12.4,33H   (INLET COOLANT PRESSURE IN PA)/
     2 7H TINLET,E12.4,35H   (INLET COOLANT TEMPERATURE IN K)/
     2 7H FRACPU,E12.4,30H   (PLUTONIUM MASS ENRICHMENT)/
     2 7H POROS ,E12.4,19H   (OXYDE POROSITY)/
     2 7H RC    ,E12.4,28H   (FUEL PELLET RADIUS IN M)/
     2 7H RIG   ,E12.4,34H   (INTERNAL CLAD ROD RADIUS IN M)/
     2 7H RGG   ,E12.4,34H   (EXTERNAL CLAD ROD RADIUS IN M)/
     2 7H RTG   ,E12.4,27H   (GUIDE TUBE RADIUS IN M)/
     2 7H SASS  ,E12.4,28H   (ASSEMBLY SURFACE IN M^2)/
     2 7H ERMAX ,E12.4,35H   (TEMPERATURE MAXIMUM ERROR IN K))
      END
