program compact_hx
  implicit none
  integer :: i,stype
  double precision :: Re_Dh,Dh,sigma,alpha_d,Atot,Lf
  double precision :: Thi,Tci,Ch,Cc,Pr_h,Pr_c
  double precision :: j,ff,h_air,Nu,Cmin,Cmax,Cr,NTU,eps,Q
  double precision :: Res,js,fs,Nus
  read(*,*) stype; read(*,*) Re_Dh; read(*,*) Dh
  read(*,*) sigma; read(*,*) alpha_d; read(*,*) Atot
  read(*,*) Lf; read(*,*) Thi; read(*,*) Tci
  read(*,*) Ch; read(*,*) Cc; read(*,*) Pr_h; read(*,*) Pr_c
  if(stype==1) then; j=0.233d0*Re_Dh**(-0.48d0); ff=0.292d0*Re_Dh**(-0.25d0); endif
  if(stype==2) then; j=0.249d0*Re_Dh**(-0.42d0); ff=0.583d0*Re_Dh**(-0.28d0); endif
  if(stype==3) then; j=0.652d0*Re_Dh**(-0.54d0); ff=1.12d0*Re_Dh**(-0.36d0); endif
  if(stype==4) then; j=0.394d0*Re_Dh**(-0.49d0); ff=0.564d0*Re_Dh**(-0.29d0); endif
  Nu=j*Re_Dh*Pr_c**(1d0/3d0)
  h_air=Nu*0.026d0/Dh
  if(Ch<Cc) then; Cmin=Ch; Cmax=Cc; else; Cmin=Cc; Cmax=Ch; endif
  Cr=Cmin/Cmax
  NTU=h_air*Atot/Cmin
  eps=1d0-exp(NTU**0.78d0*Cr/(-1d0)*(exp(-Cr*NTU**0.22d0)-1d0))
  if(eps>1d0) eps=1d0; if(eps<0d0) eps=0d0
  Q=eps*Cmin*(Thi-Tci)
  write(*,'(A)') '============================================'
  write(*,'(A)') '  COMPACT HEAT EXCHANGER (KAYS & LONDON)'
  write(*,'(A)') '============================================'
  write(*,'(A)') ''
  write(*,'(A)') '--- INPUTS ---'
  if(stype==1) write(*,'(A)') '  Surface                 = Plain fin'
  if(stype==2) write(*,'(A)') '  Surface                 = Louvered fin'
  if(stype==3) write(*,'(A)') '  Surface                 = Offset strip fin'
  if(stype==4) write(*,'(A)') '  Surface                 = Wavy fin'
  write(*,'(A,F10.1)')    '  Re_Dh                   = ',Re_Dh
  write(*,'(A,F10.6,A)') '  Dh                      = ',Dh,' m'
  write(*,'(A,F10.4)')    '  sigma (Ac/Afr)          = ',sigma
  write(*,'(A,F10.1,A)') '  Surface density alpha   = ',alpha_d,' m2/m3'
  write(*,'(A,F10.2,A)') '  Total surface A         = ',Atot,' m2'
  write(*,'(A,F10.4,A)') '  Flow length L           = ',Lf,' m'
  write(*,'(A,F10.2,A)') '  T_hot_in                = ',Thi,' C'
  write(*,'(A,F10.2,A)') '  T_cold_in               = ',Tci,' C'
  write(*,'(A)') ''
  write(*,'(A)') '--- j AND f FACTORS ---'
  write(*,'(A,ES12.4)')  '  Colburn j-factor        = ',j
  write(*,'(A,ES12.4)')  '  Fanning f-factor        = ',ff
  write(*,'(A,F10.4)')    '  j/f ratio               = ',j/ff
  write(*,'(A,F10.2)')    '  Nusselt Nu              = ',Nu
  write(*,'(A,F10.2,A)') '  h_air                   = ',h_air,' W/m2K'
  write(*,'(A)') ''
  write(*,'(A)') '--- THERMAL RESULTS ---'
  write(*,'(A,F10.4)')    '  Cr                      = ',Cr
  write(*,'(A,F10.4)')    '  NTU                     = ',NTU
  write(*,'(A,F10.4)')    '  Effectiveness           = ',eps
  write(*,'(A,F12.2,A)') '  Heat transfer Q         = ',Q,' W'
  write(*,'(A,F10.2,A)') '  T_hot_out               = ',Thi-Q/Ch,' C'
  write(*,'(A,F10.2,A)') '  T_cold_out              = ',Tci+Q/Cc,' C'
  write(*,'(A)') ''
  write(*,'(A)') '--- Re SWEEP (j & f factors) ---'
  write(*,'(A)') '  Re        j          f          j/f       Nu'
  write(*,'(A)') '  --------------------------------------------------'
  do i=1,25
    Res=100d0*10d0**(2d0*dble(i-1)/24d0)
    if(stype==1) then; js=0.233d0*Res**(-0.48d0); fs=0.292d0*Res**(-0.25d0); endif
    if(stype==2) then; js=0.249d0*Res**(-0.42d0); fs=0.583d0*Res**(-0.28d0); endif
    if(stype==3) then; js=0.652d0*Res**(-0.54d0); fs=1.12d0*Res**(-0.36d0); endif
    if(stype==4) then; js=0.394d0*Res**(-0.49d0); fs=0.564d0*Res**(-0.29d0); endif
    Nus=js*Res*Pr_c**(1d0/3d0)
    write(*,'(2X,F8.0,2X,ES10.3,2X,ES10.3,2X,F8.4,2X,F8.2)') Res,js,fs,js/fs,Nus
  enddo
  write(*,'(A)') ''
  write(*,'(A)') '--- CORRELATIONS ---'
  write(*,'(A)') '  Plain fin:    j=0.233*Re^-0.48  f=0.292*Re^-0.25'
  write(*,'(A)') '  Louvered:     j=0.249*Re^-0.42  f=0.583*Re^-0.28'
  write(*,'(A)') '  Offset strip: j=0.652*Re^-0.54  f=1.12*Re^-0.36 (Manglik-Bergles)'
  write(*,'(A)') '  Wavy fin:     j=0.394*Re^-0.49  f=0.564*Re^-0.29'
  write(*,'(A)') '  Cross-flow unmixed: eps=1-exp((NTU^0.78/Cr)(exp(-Cr*NTU^0.22)-1))'
  write(*,'(A)') '  Ref: Kays & London, Compact Heat Exchangers (1984)'
  write(*,'(A)') '       Manglik & Bergles, J Heat Transf (1995)'
end program compact_hx