*DECK THMTRS
      SUBROUTINE THMTRS(IMPX,IC,JC,KC,LC,XBURN,HX,HY,HZ,DTIME,
     > CFLUX,POROS,NFU,NFD,NDTOT,SASS,FCOOL,FFUEL,ACOOL,HD,PCH,RGG,RIG,
     > RC,MAXITC,MAXIT1,MAXITL,ERMAXT,ERMAXC,TIN0,PIN0,SPDIN,
     > TINLET,POULET,FRACPU,ICONDF,NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,
     > KCONDC,UCONDC,IHGAP,KHGAP,IHCONV,KHCONV,WTEFF,IFRCDI,ISUBM,POW,
     > VELOT0,RHOT0,PREST0,ENTHT0,TEMPT0,TCENT0,DLIQT0,TCOMB,DCOOL,
     > TCOOL,TSURF,VELOT,RHOT,PREST,ENTHT,TEMPT,TCENTT,DLIQT,PINLET)
*
*-----------------------------------------------------------------------
*
*Purpose:
* driver of the transient thermal-hydraulics module for a single time
* iteration
*
*Copyright:
* Copyright (C) 2013 Ecole Polytechnique de Montreal.
*
*Author(s): P. Gallet
*
*Parameters: input
* IMPX    printing index (=0 for no print).
* IC      number of meshes along X direction.
* JC      number of meshes along Y direction.
* KC      number of meshes along Z direction (channel direction).
* LC      number of bundles along the axial (Z) direction.
* XBURN   burnup distribution in MWday/tonne.
* HX      X-directed mesh widths.
* HY      Y-directed mesh widths.
* HZ      Z-directed mesh widths.
* DTIME   time step in s.
* CFLUX   critical heat flux in W/m^2.
* POROS   oxyde porosity.
* NFU     number of active fuel rods in the fuel bundle.
* NFD     number of discretisation points in fuel regions.
* NDTOT   number of total discretization points in the the fuel
*         pellet and the cladding.
* SASS    assembly surface in m^2.
* FCOOL   power density fraction in coolant.
* FFUEL   power density fraction in fuel.
* ACOOL   assembly coolant cross section in m^2.
* HD      hydraulic diameter of one assembly in m.
* PCH     heating perimeter in m.
* RGG     external clad rod radius in m.
* RIG     internal clad rod radius in m.
* RC      fuel pellet radius in m.
* MAXITC  maximum number of flow iterations.
* MAXIT1  maximum number of conduction iterations.
* MAXITL  maximum number of center-pellet iterations.
* ERMAXT  convergence criterion for temperature in fuel pin in K.
* ERMAXC  convergence criterion for coolant parameters (relative error).
* TIN0    inlet coolant temperature at t-1 in K.
* PIN0    inlet coolant pressure at t-1 in Pa.
* SPDIN   inlet flow velocity at t in m/s.
* TINLET  inlet temperature at t in K.
* POULET  outlet pressure at t in Pa.
* FRACPU  plutonium fraction in fuel.
* ICONDF  fuel conductivity flag (0=Stora-Chenebault or COMETHE/
*         1=user-provided polynomial + inverse term).
* NCONDF  degree of user-provided fuel conductivity polynomial.
* KCONDF  polynomial coefficients for fuel conductivity in W/m/K^(k+1)
*         (except for the two last coefficients which belongs to the
*         inverse term).
* UCONDF  required unit of temperature in polynomial for fuel
*         conductivity (KELVIN or CELSIUS).
* ICONDC  clad conductivity flag (0=default/1=user-provided
*         polynomial).
* NCONDC  degree of user-provided clad conductivity polynomial.
* KCONDC  polynomial coefficients for clad conductivity in W/m/K^(k+1).
* UCONDC  required unit of temperature in polynomial for clad
*         conductivity (KELVIN or CELSIUS).
* IHGAP   flag indicating HGAP chosen (0=default/1=user-provided).
* KHGAP   fixed user-provided HGAP value in W/m^2/K.
* IHCONV  flag indicating HCONV chosen (0=default/1=user-provided).
* KHCONV  fixed user-provided HCONV value in W/m^2/K.
* WTEFF   surface temperature's weighting factor in effective fuel
*         temperature.
* IFRCDI  flag indicating if average approximation is forced during
*         fuel conductivity evaluation (0=default/1=average
*         approximation forced).
* ISUBM   subcooling model (0: Bowring model; 1: Saha-Zuber model).
* POW     power distribution in W.
* VELOT0  coolant mass flux distribution in the reactor at t-1 in kg/m^2/s.
* RHOT0   density distribution in the reactor at t-1 in kg/m3.
* PREST0  pressure distribution in the reactor at t-1 in Pa.
* ENTHT0  enthalpy distribution in the reactor at t-1 in J/kg.
* TEMPT0  temperature distribution in the fuel rod at t-1 in K.
* TCENT0  center fuel pellet temperature distribution at t-1 in K.
* DLIQT0  coolant liquid density distribution at t-1 in kg/m^3.
*
*Parameters: output
* TCOMB   averaged fuel temperature distribution in K.
* DCOOL   averaged coolant density distribution in g/cc.
* TCOOL   averaged coolant temperature distribution in K.
* TSURF   surface fuel temperature distribution in K.
* VELOT   coolant mass flux distribution in the reactor at t in kg/m^2/s.
* RHOT    coolant density distribution in the reactor at t in kg/m^3.
* PREST   coolant pressure distribution in the reactor at t in Pa.
* ENTHT   coolant enthalpy distribution in the reactor at t in J/kg.
* TEMPT   temperature distribution in the fuel rod at t in K.
* TCENTT  center fuel pellet temperature distribution at t in K.
* DLIQT   coolant liquid density distribution at t in kg/m^3.
* PINLET  inlet pressure in Pa.
*
*-----------------------------------------------------------------------
*
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER IMPX,IC,JC,KC,LC,NFU,NFD,NDTOT,MAXITC,MAXIT1,MAXITL
      REAL XBURN(IC,JC,KC),HX(IC),HY(JC),HZ(KC),DTIME,CFLUX,POROS,SASS,
     > FCOOL,FFUEL,ACOOL,HD,PCH,RGG,RIG,RC,ERMAXT,ERMAXC,TIN0,
     > PIN0,SPDIN,TINLET,POULET,FRACPU,KCONDF(NCONDF+3),
     > KCONDC(NCONDC+1),KHGAP,KHCONV,WTEFF,POW(IC,JC,KC),
     > VELOT0(IC,JC,KC),RHOT0(IC,JC,KC),PREST0(IC,JC,KC),
     > ENTHT0(IC,JC,KC),TEMPT0(IC,JC,KC,NDTOT),TCENT0(IC,JC,KC),
     > DLIQT0(IC,JC,KC),TCOMB(IC,JC,KC),DCOOL(IC,JC,KC),
     > TCOOL(IC,JC,KC),TSURF(IC,JC,KC),VELOT(IC,JC,KC),RHOT(IC,JC,KC),
     > PREST(IC,JC,KC),ENTHT(IC,JC,KC),TEMPT(IC,JC,KC,NDTOT),
     > TCENTT(IC,JC,KC),DLIQT(IC,JC,KC),PINLET
      CHARACTER UCONDF*12,UCONDC*12
*----
*  LOCAL VARIABLES
*----
      PARAMETER(KMAXO=100,MAXNPO=20)
      PARAMETER(ZMCM=1.0E2,ZKILO=1.0E3,PES=9.81)
*     compute the actual length of each channel without reflector
*     regions, NR = number of reflector regions in the axial direction
      INTEGER NR,NHR
      REAL TRE11(MAXNPO),ENT(4),FRO(MAXNPO),MFLXIN,RHOIN0,HINLET,
     > MUIN,DV(IC,JC,KC),DZ,F,PARAM1,PARAM2,PARAM3,LZ,ERRG,ERRP,
     > ERRH,ERR,DELTH,HINI,AV(LC,LC+1),XGLOB(LC),AP(LC,LC+1),
     > AH(LC,LC+1),POWLIN(IC,JC,KC),PHI(IC,JC,KC),PHIL0,RET(IC,JC,LC),
     > MUT(IC,JC,KC),HGAPM(IC,JC,KC),RESV(IC,JC,KC),DZM,RESP(IC,JC,KC),
     > RESH(IC,JC,KC),QFUEL(IC,JC,KC),QCOOL(IC,JC,KC),ERMAX,TC0,
     > HCONV(IC,JC,KC),PARAM11,PARAM12,HC(LC),AGM(LC),PARAM21,PARAM22,
     > PC(LC),TSAT,PHIC(LC),TP(LC),TLC(LC),VC(LC),HZC(LC),F3,XFL(LC),
     > EPS(LC),XTH(LC),TB,RHOL(LC),RHOLSAT,RHOGSAT,HLSAT,HGSAT,
     > TCLAD(IC,JC,KC),MFLXT0(IC,JC,KC),MFLXT(IC,JC,KC),S(KC),ENTH(KC),
     > SAH(KC)
      CHARACTER HSMG*131
      REAL XS(4)
      DATA XS/-0.861136,-0.339981,0.339981,0.861136/
*----
*  CALCUlATE THE NUMBER OF REFLECTOR REGIONS IN THE AXIAL DIRECTION
*----
      NR=KC-LC
      NHR=NR/2
*----
*  COMPUTE THE INLET FLOW ENTHALPY AND MASS FLUX
*----
         PINLET=PIN0
         CALL THMSAT(PINLET,TSAT)
         IF(TINLET.GT.TSAT) THEN
            WRITE(HSMG,'(27HTHMTRS: INLET TEMPERATURE (,1P,E12.4,
     1      40H K) GREATER THAN SATURATION TEMPERATURE.)') TINLET
            CALL XABORT(HSMG)
         ENDIF
         CALL THMPT(PIN0,TIN0,RHOIN0,R2,R3,R4,R5)
         MFLXIN=SPDIN*RHOIN0
         CALL THMPT(PINLET,TINLET,R2,HINLET,R3,MUIN,R5)
*----
*  LOOP OVER REACTOR CHANNELS
*----
      IF(NDTOT.GT.MAXNPO) CALL XABORT('THMTRS: MAXNPO OVERFLOW')
      DO I=1,IC
      DO J=1,JC
       IF(POW(I,J,(KC+1)/2).GT.0.0) THEN
*----
*  MAIN LOOP ALONG THE 1D CHANNEL.
*----
         DO K=1,LC
*----
*  COMPUTE THE LINEAR POWER, THE VOLUMIC POWER, THE THERMAL EXCHANGE
*  COEFFICIENT OF THE GAP AND THE THERMAL HEAT FLUX ALONG THE CHANNEL
*----
           DV(I,J,K+NHR)=HX(I)*HY(J)*HZ(K+NHR)
*          linear power in W/m.
           POWLIN(I,J,K+NHR)=(POW(I,J,K+NHR)/DV(I,J,K+NHR))*SASS/NFU
*          volumic power in W/m^3.
           QFUEL(I,J,K+NHR)=POW(I,J,K+NHR)*FFUEL/DV(I,J,K+NHR)
           QCOOL(I,J,K+NHR)=POW(I,J,K+NHR)*FCOOL/DV(I,J,K+NHR)
*          thermal exchange coefficient of the gap in W/m^2/K.
           IF(IHGAP.EQ.0) THEN
              CALL THMGAP(POWLIN(I,J,K+NHR),XBURN(I,J,K+NHR),
     >         HGAPM(I,J,K+NHR))
           ELSE IF(IHGAP.EQ.1) THEN
              HGAPM(I,J,K+NHR)=KHGAP
           ENDIF
*          thermal heat flux in W/m^2
           PHI(I,J,K+NHR)=0.5*QFUEL(I,J,K+NHR)*RC*RC/RGG
           IF(PHI(I,J,K+NHR).GT.CFLUX) THEN
              WRITE(HSMG,'(23HTHMTRS: THE HEAT FLUX (,1P,E12.4,5H) IS,
     >        37HGREATER THAN THE CRITICAL HEAT FLUX (,E12.4,2H).)')
     >        PHI(I,J,K+NHR),CFLUX
              CALL XABORT(HSMG)
           ENDIF
*----
*  INITIALIZATION OF THE THERMO-HYDRAULICAL PROPERTIES OF THE FLUID
*----
           RHOT(I,J,K+NHR)=RHOT0(I,J,K+NHR)
           MUT(I,J,K+NHR)=MUIN
           VELOT(I,J,K+NHR)=VELOT0(I,J,K+NHR)
           MFLXT(I,J,K+NHR)=RHOT(I,J,K+NHR)*VELOT(I,J,K+NHR)
           PREST(I,J,K+NHR)=PREST0(I,J,K+NHR)
           ENTHT(I,J,K+NHR)=ENTHT0(I,J,K+NHR)
           DLIQT(I,J,K+NHR)=DLIQT0(I,J,K+NHR)
         ENDDO
       ENDIF
      ENDDO
      ENDDO
*----
*  ITERATIVE PROCEDURE FOR EACH CHANNEL
*----
      DO I=1,IC
      DO J=1,JC
         IF(POW(I,J,(KC+1)/2).GT.0.0) THEN
            DO K=1,LC
               PC(K)=0.0
               XFL(K)=0.0
               EPS(K)=0.0
               XTH(K)=0.0
               AGM(K)=0.0
               XGLOB(K)=0.0
               S(K)=1.0
            ENDDO
            ITERC=0
   10       ITERC=ITERC+1
            IF(ITERC.GT.MAXITC) THEN
               CALL XABORT('THMTRS: CONVERGENCE FAILURE IN FLOW
     > CALCULATION.')
            ENDIF
*          initialization of all matrixes
           DO K=1,LC
              DO K1=1,(LC+1)
                 AV(K,K1)=0.0
                 AP(K,K1)=0.0
                 AH(K,K1)=0.0
              ENDDO
           ENDDO
*----
*  MASS VECTOR CALCULATION WITH MASS CONSERVATION EQUATION
*----
*           DO K=2,LC
*              DZ=HZ(K+NHR)
*              AV(K,K-1)=-RHOT0(I,J,K-1+NHR)
*              AV(K,K)=RHOT0(I,J,K+NHR)
*              AV(K,LC+1)=(RHOT0(I,J,K+NHR)-RHOT(I,J,K+NHR))/DTIME*DZ
*           ENDDO
*           DZ=HZ(1+NHR)
*           AV(1,1)=RHOT0(I,J,1+NHR)
*           AV(1,LC+1)=MFLXIN+(RHOT0(I,J,1+NHR)-RHOT(I,J,1+NHR))/DTIME
*     >     *DZ
*          resolution of the matrix linear system
*           CALL ALSB(LC,1,AV,IER,LC)
*           IF(IER.NE.0) CALL XABORT('THMTRS: AV SINGULAR MATRIX.')
           DO K=1,LC
*              AGM(K)=AV(K,LC+1)*RHOT0(I,J,K+NHR)
*             compute the values of the velocity by assuming that mass
*             flux is constant along the channel
              AV(K,LC+1)=MFLXIN/RHOT0(I,J,K+NHR)
              AGM(K)=MFLXIN
*
              MFLXT0(I,J,K+NHR)=VELOT0(I,J,K+NHR)*RHOT0(I,J,K+NHR)
           ENDDO
*----
*  MOMENTUM VECTOR CALCULATION WITH MOMENTUM CONSERVATION EQUATION
*----
           DO K=1,LC
              RET(I,J,K)=AGM(K)*(1-XGLOB(K))*HD/MUT(I,J,K+NHR)
           ENDDO
           DO K=2,(LC-1)
              AP(K,K)=-1.0
              AP(K,K+1)=+1.0
              DZ=HZ(K+NHR)
              DZM=(HZ(K+NHR)+HZ(K+1+NHR))/2.0
              PARAM1=(AGM(K)-MFLXT0(I,J,K+NHR))/DTIME*DZM
              PARAM21=AGM(K)**2.0/RHOT0(I,J,K+NHR)
              PARAM22=AGM(K-1)**2.0/RHOT0(I,J,K-1+NHR)
              PARAM2=(PARAM21-PARAM22)*DZM/DZ
              CALL THMFRI(RET(I,J,K),F)
              IF(XGLOB(K).GT.0.0) THEN
                 CALL THMPLO(PREST(I,J,K+NHR),XGLOB(K),PHIL0)
              ELSE
                 PHIL0=1.0
              ENDIF
              PARAM31=RHOT0(I,J,K+NHR)*PES
              PARAM32=0.5*F*AGM(K)**2.0/HD/DLIQT0(I,J,K+NHR)*PHIL0
              PARAM3=(PARAM31+PARAM32)*DZM
              AP(K,LC+1)=-PARAM1-PARAM2-PARAM3
           ENDDO
           AP(1,1)=-1.0
           AP(1,2)=+1.0
           DZ=HZ(1+NHR)
           DZM=(HZ(1+NHR)+HZ(2+NHR))/2.0
           PARAM1=(AGM(1)-MFLXT0(I,J,1+NHR))/DTIME*DZM
           PARAM21=AGM(1)**2.0/RHOT0(I,J,1+NHR)
           PARAM22=MFLXIN**2.0/RHOIN0
           PARAM2=(PARAM21-PARAM22)/DZ*DZM
           CALL THMFRI(RET(I,J,1),F)
           IF(XGLOB(1).GT.0.0) THEN
              CALL THMPLO(PREST(I,J,1+NHR),XGLOB(1),PHIL0)
           ELSE
              PHIL0=1.0
           ENDIF
           PARAM31=RHOT0(I,J,1+NHR)*PES
           PARAM32=0.5*F*AGM(1)**2.0/HD/DLIQT0(I,J,1+NHR)*PHIL0
           PARAM3=(PARAM31+PARAM32)*DZM
           AP(1,LC+1)=-PARAM1-PARAM2-PARAM3
*
           AP(LC,LC)=-1.0
           DZ=HZ(LC+NHR)
           DZM=HZ(LC+NHR)/2.0
           PARAM1=(AGM(LC)-MFLXT0(I,J,LC+NHR))/DTIME*DZM
           PARAM21=AGM(LC)**2.0/RHOT0(I,J,LC+NHR)
           PARAM22=AGM(LC-1)**2.0/RHOT0(I,J,LC+NHR-1)
           PARAM2=(PARAM21-PARAM22)*DZM/DZ+POULET
           CALL THMFRI(RET(I,J,LC),F)
           IF(XGLOB(LC).GT.0.0) THEN
              CALL THMPLO(PREST(I,J,LC+NHR),XGLOB(LC),PHIL0)
           ELSE
              PHIL0=1.0
           ENDIF
           PARAM31=RHOT0(I,J,LC+NHR)*PES
           PARAM32=0.5*F*AGM(LC)**2.0/HD/DLIQT0(I,J,LC+NHR)*PHIL0
           PARAM3=(PARAM31+PARAM32)*DZM
           AP(LC,LC+1)=-PARAM1-PARAM2-PARAM3
*          resolution of the matrix linear system
           CALL ALSB(LC,1,AP,IER,LC)
           IF(IER.NE.0) CALL XABORT('THMTRS: AP SINGULAR MATRIX')
*----
*  ENTHALPY VECTOR CALCULATION WITH ENERGY CONSERVATION EQUATION
*----
           DO K=2,LC
              LZ=0.0
              DO I2=1,K
                 LZ=LZ+HZ(I2+NHR)
              ENDDO
              DZ=HZ(K+NHR)
              AH(K,K)=RHOT0(I,J,K+NHR)/DTIME*DZ+AGM(K)
              AH(K,K-1)=-AGM(K-1)
              PARAM11=AGM(K)**3.0/(2.0*RHOT0(I,J,K+NHR)**2.0)
     >        +PES*LZ*AGM(K)
              PARAM12=AGM(K-1)**3.0/(2.0*RHOT0(I,J,K-1+NHR)**2.0)
     >        +PES*(LZ-HZ(K+NHR))*AGM(K-1)
              PARAM1=PARAM11-PARAM12
              PARAM21=AGM(K)**2.0/(2.0*RHOT0(I,J,K+NHR))-AP(K,LC+1)
              PARAM22=MFLXT0(I,J,K+NHR)**2.0/(2.0*RHOT0(I,J,K+NHR))
     >        -PREST0(I,J,K+NHR)+RHOT0(I,J,K+NHR)*ENTHT0(I,J,K+NHR)
              PARAM2=(PARAM21-PARAM22)*DZ/DTIME
              PARAM3=(PHI(I,J,K+NHR)*PCH/ACOOL+QCOOL(I,J,K+NHR))*DZ
              AH(K,LC+1)=-PARAM1-PARAM2+PARAM3
           ENDDO
           DZ=HZ(1+NHR)
           LZ=HZ(1+NHR)
           AH(1,1)=RHOT0(I,J,1+NHR)/DTIME*DZ+AGM(1)
           PARAM11=AGM(1)**3.0/(2.0*RHOT0(I,J,1+NHR)**2.0)+PES*LZ
     >     *AGM(1)
           PARAM12=MFLXIN**3.0/(2.0*RHOIN0**2.0)
           PARAM1=PARAM11-PARAM12-MFLXIN*HINLET
           PARAM21=AGM(1)**2.0/(2.0*RHOT0(I,J,1+NHR))-AP(1,LC+1)
           PARAM22=MFLXT0(I,J,1+NHR)**2.0/(2.0*RHOT0(I,J,1+NHR))
     >     -PREST0(I,J,1+NHR)+RHOT0(I,J,1+NHR)*ENTHT0(I,J,1+NHR)
           PARAM2=(PARAM21-PARAM22)*DZ/DTIME
           PARAM3=(PHI(I,J,1+NHR)*PCH/ACOOL+QCOOL(I,J,1+NHR))*DZ
           AH(1,LC+1)=-PARAM1-PARAM2+PARAM3
*          resolution of the matrix linear system
           CALL ALSB(LC,1,AH,IER,LC)
           IF(IER.NE.0) CALL XABORT('THMTRS: AH SINGULAR MATRIX')
           DO K=1,LC
              RESV(I,J,K+NHR)=AV(K,LC+1)
              RESP(I,J,K+NHR)=AP(K,LC+1)
              RESH(I,J,K+NHR)=AH(K,LC+1)
           ENDDO
           DO L=1,NHR
              RESV(I,J,L)=0.0
              RESP(I,J,L)=0.0
              RESH(I,J,L)=0.0
              RESV(I,J,KC-L+1)=0.0
              RESP(I,J,KC-L+1)=0.0
              RESH(I,J,KC-L+1)=0.0
           ENDDO  
*----
*  CALCULATION OF THE OUTER CLADDING TEMPERATURE AND THE TEMPERATURE
*  DISTRIBUTION IN THE FUEL.
*----
        HINI=HINLET
        DO K=1,LC
*----
*  INITIALIZATION OF PINCELL TEMPERATURES
*----
           DO L=1,NDTOT
              TRE11(L)=TEMPT0(I,J,K+NHR,L)
           ENDDO
*----
*  COMPUTE FOUR VALUES OF ENTHALPY IN J/KG TO BE USED IN GAUSSIAN
*  INTEGRATION. DELTH IS THE ENTHALPY INCREASE IN EACH AXIAL MESH.
*----
           IF (K.EQ.1) THEN
               DELTH=ENTHT(I,J,K+NHR)-HINLET
           ELSE
               DELTH=ENTHT(I,J,K+NHR)-ENTHT(I,J,K+NHR-1)
           ENDIF
           PC(K)=RESP(I,J,K+NHR)
           DO I1=1,4
              POINT=(1.0+XS(I1))/2.0
              ENT(I1)=HINI+POINT*DELTH
           ENDDO
           HINI=HINI+DELTH
*----
*  COMPUTE THE COOLANT TEMPERATURE AND THE OUTER CLADDING TEMPERATURE
*----
           CALL THMH2O(PC(K),AGM(K),EPS(K),ENT,PHI(I,J,K+NHR),HD,
     >     IHCONV,KHCONV,TL,RHO,DLIQT(I,J,K+NHR),HCONV(I,J,K+NHR),
     >     TRE11(NDTOT),XTH(K))
*----
*  TRANSIENT SOLUTION OF THE CONDUCTION EQUATIONS IN A FUEL PIN.
*----
           DO K1=1,NFD-1
              FRO(K1)=REAL(K1)
           ENDDO
           RO00=0.0
           DTINV=1.0/DTIME
           ALPHA=1.0
           TC0=TCENT0(I,J,K+NHR)
           CALL THMRES(NFD,NDTOT,MAXIT1,MAXITL,ERMAXT,DTINV,RC,RIG,
     >          RGG,HCONV(I,J,K+NHR),HGAPM(I,J,K+NHR),RO00,TL,FRO,
     >          QFUEL(I,J,K+NHR),XBURN(I,J,K+NHR),POROS,FRACPU,
     >          ICONDF,NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,KCONDC,
     >          UCONDC,IFRCDI,ALPHA,TRE11,TC0)
           DO L=1,NDTOT
              TEMPT(I,J,K+NHR,L)=TRE11(L)
           ENDDO
*----
*  RECOVER MESHWISE TEMPERATURES AND FLUID DENSITY. BY DEFAULT, USE THE
*  ROWLANDS FORMULA TO COMPUTE THE EFFECTIVE FUEL TEMPERATURE, OTHERWISE
*  USE USER-SPECIFIED WEIGHTING FACTOR.
*----
           TCOMB(I,J,K+NHR)=(1.0-WTEFF)*TC0+WTEFF*TRE11(NFD)
           TCOOL(I,J,K+NHR)=TL
           TCENTT(I,J,K+NHR)=TC0
           TSURF(I,J,K+NHR)=TRE11(NFD)
           TCLAD(I,J,K+NHR)=TRE11(NDTOT)
        ENDDO
*----
*  CALCULATE THE VOID FRACTION COEFFICIENT AND THE STEAM QUALITY
*----
          DO K=1,LC
             HZC(K)=HZ(K+NHR)
             VC(K)=RESV(I,J,K+NHR)
             PHIC(K)=PHI(I,J,K+NHR)
             TP(K)=TCLAD(I,J,K+NHR)
             TLC(K)=TCOOL(I,J,K+NHR)
             HC(K)=HCONV(I,J,K+NHR)
             ENTH(K)=ENTHT(I,J,K+NHR)    
             SAH(K)=154.0*PHI(I,J,K+NHR)/AGM(K) ! Saha-Zuber correlation
          ENDDO
*         compute the distribution of void fraction and steam flow
*         quality along the channel
          IF(ISUBM.EQ.0) THEN
*           Jens-Lottes correlation and Bowring's model
            CALL THMJLB(LC,HZC,VC,PC,PHIC,TP,TLC,HC,S,XFL,EPS)
          ELSE IF(ISUBM.EQ.1) THEN
*           Saha-Zuber subcooling model
            CALL THMJLC(LC,AGM,ENTH,SAH,ACOOL,PC,S,XFL,EPS)
          ELSE
            CALL XABORT('THMTRS: UNKNOWN SUBCOOLING MODEL.')
          ENDIF
*----
*  CONVERGENCE TEST FOR THE ENTHALPY, PRESSURE DENSITY AND
*  MASS FLUX CALCULATION.
*----
          ERMAX=ERMAXC
          ERRG=0.0
          ERRP=0.0
          ERRH=0.0
          ERR=0.0
          ERX=0.0
          DO K=1,LC
            EPS(K)=0.0
            CALL THMSAT(PC(K),TSAT)
            TB=TSAT-0.1
            CALL THMTX(TSAT,0.0,RHOLSAT,HLSAT)
            CALL THMTX(TSAT,1.0,RHOGSAT,HGSAT)
            IF((XTH(K).GE.XFL(K)).AND.(XTH(K).GE.0.0)) THEN
               XGLOB(K)=XTH(K)
               F3=S(K)*RHOGSAT*(1-XTH(K))/(RHOLSAT*XTH(K))
               EPS(K)=1/(1+F3)
            ELSEIF((XFL(K).GT.XTH(K)).AND.(XFL(K).GT.1.0E-06)) THEN
               XGLOB(K)=XFL(K)
               F3=S(K)*RHOGSAT*(1-XFL(K))/(RHOL(K)*XFL(K))
               EPS(K)=1/(1+F3)
            ELSE
               XGLOB(K)=0.0
               EPS(K)=0.0
            ENDIF
            IF(EPS(K).GT.1.0E-06) THEN
                 DCOOL(I,J,K+NHR)=EPS(K)*RHOGSAT+(1-EPS(K))
     >           *DLIQT(I,J,K+NHR)
            ELSE
                 DCOOL(I,J,K+NHR)=DLIQT(I,J,K+NHR)
            ENDIF
            IF(TLC(K).LT.TB) THEN
               CALL THMPT(PC(K),TLC(K),R11,H11,K11,MUT(I,J,K+NHR),C11)
            ELSE
               CALL THMPT(PC(K),TB,R11,H11,K11,MUT(I,J,K+NHR),C11)
            ENDIF
            ERRG=MAX(ERRG,ABS(MFLXT(I,J,K+NHR)-AGM(K))/MFLXT(I,J,K+NHR))
            ERRP=MAX(ERRP,ABS(PREST(I,J,K+NHR)-RESP(I,J,K+NHR))
     >      /PREST(I,J,K+NHR))
            ERRH=MAX(ERRH,ABS(ENTHT(I,J,K+NHR)-RESH(I,J,K+NHR))
     >      /ENTHT(I,J,K+NHR))
            PREST(I,J,K+NHR)=RESP(I,J,K+NHR)
            VELOT(I,J,K+NHR)=RESV(I,J,K+NHR)
            ENTHT(I,J,K+NHR)=RESH(I,J,K+NHR)
            RHOT(I,J,K+NHR)=DCOOL(I,J,K+NHR)
            MFLXT(I,J,K+NHR)=AGM(K)
          ENDDO
          ERR=MAX(ERRG,ERRP,ERRH)
          PINLET=RESP(I,J,1+NHR)+(RESP(I,J,1+NHR)-RESP(I,J,2+NHR))
          CALL THMPT(PINLET,TINLET,R2,HINLET,R3,R4,R5)
          IF((ERR.LT.ERMAX).AND.(ITERC.GT.1)) THEN
            GO TO 30
          ELSE
            GO TO 10
          ENDIF
*----
*  PRINT THE OUTLET THERMOHYDRAULICAL PARAMETERS
*----
   30      DO K=1,LC
              DCOOL(I,J,K+NHR)=DCOOL(I,J,K+NHR)/ZKILO
           ENDDO   
           IF(IMPX.GT.2) THEN
             WRITE(6,'(/16H THMTRS: CHANNEL,2I6/1X,27(1H-))') I,J
             WRITE(6,200) 'TCOMB',(TCOMB(I,J,K+NHR),K=1,LC)
             WRITE(6,200) 'TSURF',(TSURF(I,J,K+NHR),K=1,LC)
             WRITE(6,200) 'TCOOL',(TCOOL(I,J,K+NHR),K=1,LC)
             WRITE(6,200) 'DCOOL',(DCOOL(I,J,K+NHR),K=1,LC)
           ENDIF
        ENDIF
      ENDDO
      ENDDO
      RETURN
  200 FORMAT(/1X,A5,1P,10E12.4/(6X,10E12.4))
      END
