*DECK THMDRV
      SUBROUTINE THMDRV(IMPX,IC,JC,KC,XBURN,HX,HY,HZ,CFLUX,POROS,
     > NFU,NFD,NDTOT,SASS,FCOOL,FFUEL,ACOOL,HD,PCH,RGG,RIG,RC,MAXIT1,
     > MAXITL,ERMAXT,SPEED,TINLET,PINLET,FRACPU,ICONDF,NCONDF,KCONDF,
     > UCONDF,ICONDC,NCONDC,KCONDC,UCONDC,IHGAP,KHGAP,IHCONV,KHCONV,
     > WTEFF,IFRCDI,ISUBM,POW,TCOMB,DCOOL,TCOOL,TSURF,HCOOL,VCOOL,
     > PCOOL,TCODIS,TCENT,DLCOOL)
*
*-----------------------------------------------------------------------
*
*Purpose:
* driver of the thermal-hydraulics module.
*
*Copyright:
* Copyright (C) 2012 Ecole Polytechnique de Montreal.
*
*Author(s): A. Hebert
*
*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).
* XBURN   burnup distribution in MWday/tonne.
* HX      X-directed mesh widths.
* HY      Y-directed mesh widths.
* HZ      Z-directed mesh widths.
* CFLUX   critical heat flux in W/m^2.
* POROS   oxyde porosity.
* NFU     number of active fuel rods.
* NFD     number of discretization points in fuel region.
* 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.
* MAXIT1  maximum number of conduction iterations.
* MAXITL  maximum number of center-pellet iterations.
* ERMAXT  convergence criterion.
* SPEED   inlet flow velocity in m/s.
* TINLET  inlet temperature in K.
* PINLET  inlet pressure 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.
*
*Parameters: output
* TCOMB   averaged fuel temperature distribution in K.
* DCOOL   coolant density distribution in g/cc.
* TCOOL   coolant temperature distribution in K.
* TSURF   surface fuel temperature distribution in K.
* HCOOL   coolant enthalpty distribution in J/kg.
* VCOOL   coolant velocity distribution in kg/m^2/s.
* PCOOL   coolant pressure distribution in Pa.
* TCODIS  discretized temperature distribution in each fuel region in K.
* TCENT   center fuel pellet temperature distribution in K.
* DLCOOL  coolant liquid phase density distribution in kg/m^3.
*
*-----------------------------------------------------------------------
*
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER IMPX,IC,JC,KC,NFU,NFD,NDTOT,MAXIT1,MAXITL
      REAL XBURN(IC,JC,KC),HX(IC),HY(JC),HZ(KC),CFLUX,POROS,SASS,
     > FCOOL,FFUEL,ACOOL,HD,PCH,RGG,RIG,RC,ERMAXT,SPEED,TINLET,PINLET,
     > FRACPU,KCONDF(NCONDF+3),KCONDC(NCONDC+1),KHGAP,KHCONV,WTEFF,
     > POW(IC,JC,KC),TCOMB(IC,JC,KC),DCOOL(IC,JC,KC),TCOOL(IC,JC,KC),
     > TSURF(IC,JC,KC),HCOOL(IC,JC,KC),VCOOL(IC,JC,KC),PCOOL(IC,JC,KC),
     > TCODIS(IC,JC,KC,NDTOT),TCENT(IC,JC,KC),DLCOOL(IC,JC,KC)
      CHARACTER UCONDF*12,UCONDC*12
*----
*  LOCAL VARIABLES
*----
      PARAMETER (KMAXO=100,MAXNPO=15)
      PARAMETER(ZMCM=1.0E2,ZKILO=1.0E3)
      REAL TRE11(MAXNPO),ENT(4),FRO(MAXNPO),MFLOW,TLC(KC),VC(KC),SAH(KC)
      CHARACTER HSMG*131
      REAL XS(4),TC0,PHI(KC),PC(KC),TP(KC),HC(KC),RHOL,HGSAT,RGSAT
      REAL XFL(KC),EPS(KC),HINLET,TCLAD(IC,JC,KC),XTH(KC),ENTH(KC),
     > S(KC),AGM(KC)
      DATA XS/-0.861136,-0.339981,0.339981,0.861136/
*----
*  LOOP OVER REACTOR CHANNELS
*----
      IF(NDTOT.GT.MAXNPO) CALL XABORT('THMDRV: MAXNPO OVERFLOW.')
      DO 100 I=1,IC
      DO 100 J=1,JC
      IF(POW(I,J,(KC+1)/2).GT.0.0) THEN
*----
*  COMPUTE THE INLET FLOW ENTHALPY AND VELOCITY
*----
         CALL THMSAT(PINLET,TSAT)
         IF(TINLET.GT.TSAT) THEN
            WRITE(HSMG,'(27HTHMDRV: INLET TEMPERATURE (,1P,E12.4,
     1      40H K) GREATER THAN SATURATION TEMPERATURE.)') TINLET
            CALL XABORT(HSMG)
         ENDIF
         CALL THMPT(PINLET,TINLET,RHOIN,HINLET,R3,R4,R5)
         MFLOW=SPEED*RHOIN
         HMSUP=HINLET
*----
*  INITIALIZE VALUES OF STEAM QUALITIES, VOID FRACTION AND DENSITY
*---
         DO K=1,KC
            EPS(K)=0.0
            XFL(K)=0.0
            XTH(K)=0.0
            SAH(K)=0.0
            PHI(K)=0.0
            S(K)=1.0
         ENDDO
*----
*  MAIN LOOP ALONG THE 1D CHANNEL.
*----
         DO K=1,KC
           IF(POW(I,J,K).EQ.0.0) CYCLE
*----
*  INITIALIZATION OF PINCELL TEMPERATURES
*----
           DO L=1,NDTOT
              TRE11(L)=TCOMB(I,J,K)
           ENDDO
*----
*  COMPUTE THE LINEAR POWER, THE VOLUMIC POWER AND THE THERMAL EXCHANGE
*  COEFFICIENT OF THE GAP
*----
           DV=HX(I)*HY(J)*HZ(K)
*          linear power in W/m
           POWLIN=(POW(I,J,K)/DV)*SASS/NFU
*          volumic power in W/m^3
           QFUEL=POW(I,J,K)*FFUEL/DV
           QCOOL=POW(I,J,K)*FCOOL/DV
*          thermal exchange coefficient of the gap in W/m^2/K.
           IF(IHGAP.EQ.0) THEN
              CALL THMGAP(POWLIN,XBURN(I,J,K),HGAPM)
           ELSE IF(IHGAP.EQ.1) THEN
              HGAPM=KHGAP
           ENDIF
*----
*  COMPUTE THE POWER DENSITY AND HEAT FLOW ALONG THE CHANNEL
*----
*          out-of-clad heat flow in W/m2
           PHI2=0.5*QFUEL*RC*RC/RGG
           IF(PHI2.GT.CFLUX) THEN
              WRITE(HSMG,'(23HTHMDRV: THE HEAT FLUX (,1P,E12.4,5H) IS ,
     >        37HGREATER THAN THE CRITICAL HEAT FLUX (,E12.4,2H).)')
     >        PHI2,CFLUX
              CALL XABORT(HSMG)
           ENDIF
*----
*  COMPUTE FOUR VALUES OF ENTHALPY IN J/KG TO BE USED IN GAUSSIAN
*  INTEGRATION. DELTH1 IS THE ENTHALPY INCREASE IN EACH AXIAL MESH.
*----
           DELTH1=(PCH/ACOOL*PHI2+QCOOL)*HZ(K)/MFLOW
           DO I1=1,4
              POINT=(1.0+XS(I1))/2.0
              ENT(I1)=HMSUP+POINT*DELTH1
           ENDDO
           HMSUP=HMSUP+DELTH1
*----
*  COMPUTE THE VALUE OF THE DENSITY, THE TEMPERATURE IN THE COOLANT
*  AND THE HEAT TRANSFER COEFFICIENT BETWEEN THE COOLANT AND THE CLADDING
*----
           CALL THMH2O(PINLET,MFLOW,EPS(K),ENT,PHI2,HD,IHCONV,KHCONV,
     >     TL,RHO,RHOL,HCONV,TRE11(NDTOT),XTH(K))
*----
*  STEADY-STATE SOLUTION OF THE CONDUCTION EQUATIONS IN A FUEL PIN.
*----
           DO K1=1,NFD-1
              FRO(K1)=REAL(K1)
           ENDDO
           RO00=0.0
           DTINV=0.0
           TC0=0.0
           ALPHA=1.0
           CALL THMRES(NFD,NDTOT,MAXIT1,MAXITL,ERMAXT,DTINV,RC,RIG,
     >     RGG,HCONV,HGAPM,RO00,TL,FRO,QFUEL,XBURN(I,J,K),
     >     POROS,FRACPU,ICONDF,NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,
     >     KCONDC,UCONDC,IFRCDI,ALPHA,TRE11,TC0)
*----
*  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)=(1.0-WTEFF)*TC0+WTEFF*TRE11(NFD)
           TCENT(I,J,K)=TC0
           TSURF(I,J,K)=TRE11(NFD)
           TCLAD(I,J,K)=TRE11(NDTOT)
           TCOOL(I,J,K)=TL
           DLCOOL(I,J,K)=RHOL
           HCOOL(I,J,K)=HMSUP
           PCOOL(I,J,K)=PINLET
           PHI(K)=PHI2
           HC(K)=HCONV
           PC(K)=PINLET
           TP(K)=TCLAD(I,J,K)
           TLC(K)=TCOOL(I,J,K)
           XFL(K)=0.0
           EPS(K)=0.0
           VC(K)=MFLOW/DLCOOL(I,J,K)
           ENTH(K)=HCOOL(I,J,K)
           SAH(K)=154.0*PHI2/MFLOW ! Saha-Zuber correlation
           AGM(K)=MFLOW ! constant flow rate
           DO K2=1,NDTOT
             TCODIS(I,J,K,K2)=TRE11(K2)
           ENDDO
         ENDDO
*----
*  CHECK IF SUBCOOLED BOILING IS REACHED IN THE CHANNEL 
*----
*        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(KC,HZ,VC,PC,PHI,TP,TLC,HC,S,XFL,EPS)
         ELSE IF(ISUBM.EQ.1) THEN
*          Saha-Zuber subcooling model
           CALL THMJLC(KC,AGM,ENTH,SAH,ACOOL,PC,S,XFL,EPS)
         ELSE
           CALL XABORT('THMDRV: UNKNOWN SUBCOOLING MODEL.')
         ENDIF
*        compute new values of densities and velocities over channel
         DO K=1,KC
           IF(EPS(K).GT.0.0) THEN
             CALL THMSAT(PINLET,TSAT)
             CALL THMTX(TSAT,1.0,RGSAT,HGSAT)
             DCOOL(I,J,K)=DLCOOL(I,J,K)*(1.0-EPS(K))+EPS(K)*RGSAT
           ELSE
             DCOOL(I,J,K)=DLCOOL(I,J,K)
           ENDIF
           VCOOL(I,J,K)=MFLOW/DCOOL(I,J,K)
           DCOOL(I,J,K)=DCOOL(I,J,K)/ZKILO
         ENDDO
*----
*  PRINT THE OUTLET THERMOHYDRAULICAL PARAMETERS
*----
         IF(IMPX.GT.2) THEN
           WRITE(6,'(/16H THMDRV: CHANNEL,2I6/1X,27(1H-))') I,J
           WRITE(6,200) 'TCOMB',(TCOMB(I,J,K),K=1,KC)
           WRITE(6,200) 'TSURF',(TSURF(I,J,K),K=1,KC)
           WRITE(6,200) 'DCOOL',(DCOOL(I,J,K),K=1,KC)
           WRITE(6,200) 'TCOOL',(TCOOL(I,J,K),K=1,KC)
           WRITE(6,200) 'PCOOL',(PCOOL(I,J,K),K=1,KC)
           WRITE(6,200) 'HCOOL',(HCOOL(I,J,K),K=1,KC)
           WRITE(6,200) 'POWER',(POW  (I,J,K),K=1,KC)
           WRITE(6,200) 'VOID ',(EPS  (K),    K=1,KC)
           WRITE(6,200) 'QUAL ',(XFL  (K),    K=1,KC)
           WRITE(6,200) 'SLIP ',(S    (K),    K=1,KC)
         ENDIF
      ENDIF
  100 CONTINUE
      RETURN
*
  200 FORMAT(/1X,A5,1P,10E12.4/(6X,10E12.4))
      END
