module write_littler

use logging

implicit none

  contains

subroutine write_obs(p,z,t,td,spd,dir,u,v,rh,thick, &
  p_qc,z_qc,t_qc,td_qc,spd_qc,dir_qc,u_qc,v_qc,rh_qc,thick_qc, &
  slp , ter , xlat , xlon , timechar , kx , &
  string1 , string2 , string3 , string4 , bogus , iseq_num , &
  iunit, outfile, append )
  ! TODO: add fields in the header format as arguments
  ! write observations in LITTLE_R format for WRF data assimilation
  ! in: - data variables &* strings to write in LITTLE_R format
  ! otu: - output file in LITTLE_R format
  !implicit none
  integer :: kx, k, iunit
  real,dimension(kx),intent(in) :: p,z,t,td,spd,dir,u,v,rh,thick, slp
  real, intent(in) :: xlon, xlat, ter
  integer,dimension(kx),intent(in) :: p_qc,z_qc,t_qc,td_qc,spd_qc
  integer, dimension(kx), intent(in) :: dir_qc,u_qc,v_qc,rh_qc,thick_qc
  character(len=30), intent(in) :: outfile
  integer :: iseq_num
  character(len=14) :: timechar
  character *20 date_char
  character *40 string1, string2 , string3 , string4
  character *84  rpt_format
  character *22  meas_format
  character *14  end_format
  logical bogus
  logical, intent(inout) :: append
  rpt_format =  ' ( 2f20.5 , 2a40 , ' &
                  // ' 2a40 , 1f20.5 , 5i10 , 3L10 , ' &
                  // ' 2i10 , a20 ,  13( f13.5 , i7 ) ) '
  meas_format =  ' ( 10( f13.5 , i7 ) ) '
  end_format = ' ( 3 ( i7 ) ) '

  ! open output file and set append to true
  if (append .eqv. .false.) then
    open (unit=iunit,file=outfile,action="write")
    append = .true.
  end if

  ! write header record
  WRITE ( UNIT = iunit , ERR = 19 , FMT = rpt_format ) &
    xlat,xlon, string1 , string2 , &
    string3 , string4 , ter, kx*6, 0,0,iseq_num,0, &
    .true.,bogus,.false., &
    -888888, -888888, timechar , &
    slp(1),0, -888888., 0, -888888.,0, -888888.,0, -888888.,0, &
    -888888.,0, &
    -888888.,0, -888888.,0, -888888.,0, -888888.,0, &
    -888888.,0, &
    -888888.,0, -888888.,0

  do k = 1 , kx
    WRITE ( UNIT = iunit , ERR = 19 , FMT = meas_format ) &
               p(k), p_qc(k), ter, z_qc(k), t(k), t_qc(k), td(k), td_qc(k), &
               spd(k), spd_qc(k), dir(k), dir_qc(k), u(k), u_qc(k), &
               v(k), v_qc(k), rh(k), rh_qc(k), thick(k), thick_qc(k)
  end do
      ! write ending record
      WRITE ( UNIT = iunit , ERR = 19 , FMT = meas_format ) &
      -777777.,0, -777777.,0,float(kx),0, &
      -888888.,0, -888888.,0, -888888.,0, &
      -888888.,0, -888888.,0, -888888.,0, &
      -888888.,0
      WRITE ( UNIT = iunit , ERR = 19 , FMT = end_format )  kx, 0, 0
      return
19    continue
      print *,'troubles writing a sounding'
      stop 19

    end subroutine write_obs

subroutine get_default_littler(dpressure, dheight, dtemperature, ddew_point, &
  dwindspeed, ddirection, du, dv, drh, dthickness, dpsfc, dmslp, dpressure_qc, &
  dheight_qc, dtemperature_qc, ddew_point_qc, dwindspeed_qc, ddirection_qc, du_qc, &
  dv_qc, drh_qc, dthickness_qc, kx)
  ! set default values for LITTLE_R format
  ! -888888.:  measurement not available
  ! _qc = 0: no quality control
  integer, intent(in) :: kx
  real, dimension(kx), intent(out) :: dpressure, dheight, dtemperature, ddew_point
  real, dimension(kx), intent(out) :: dwindspeed, ddirection, du, dv, drh, dthickness
  real, dimension(kx), intent(out) :: dpsfc, dmslp
  integer, dimension(kx), intent(out) :: dpressure_qc, dheight_qc, dtemperature_qc
  integer, dimension(kx), intent(out) ::  ddew_point_qc, dwindspeed_qc, ddirection_qc, du_qc
  integer, dimension(kx), intent(out) :: dv_qc, drh_qc, dthickness_qc
  integer :: k

  do k=1,kx
    dpressure(k) = -888888.
    dheight(k) = -888888.
    dtemperature(k) = -888888.
    ddew_point(k) = -888888.
    dwindspeed(k) = -888888.
    ddirection(k) = -888888.
    du(k) = -888888.
    dv(k) = -888888.
    drh(k) = -888888.
    dthickness(k) = -888888.
    dpressure_qc(k) = 0
    dpsfc(k) = -888888.
    dmslp(k) = -888888.
    dheight_qc(k) = 0
    dtemperature_qc(k) = 0
    ddew_point_qc(k) = 0
    dwindspeed_qc(k) = 0
    ddirection_qc(k) = 0
    du_qc(k) = 0
    dv_qc(k) = 0
    drh_qc(k) = 0
    dthickness_qc(k) = 0
  end do

end subroutine get_default_littler

subroutine time_to_littler_date(time, timeunits, time_littler, startindex, &
  countnum, startdate, enddate)
  ! convert time to LITTLE_R time format
  ! in:   - time: time array
  !       - timeunits: units of time of time array
  !       - startdate,enddate: string in form YYYY-MM-DD
  ! out:  - time_littler: time in LITTLE_R format
  !       - startindex: index of startdate
  !       - countnum: number of timesteps between startdate and enddate
  use f_udunits_2
  real(c_double) :: tt
  real,dimension(:),intent(in) :: time
  character(len=100), intent(in) :: timeunits
  character(len=8), intent(in) :: startdate, enddate
  character(len=14), dimension(:), intent(out) :: time_littler
  integer(kind=8), dimension(:), allocatable :: time_littler_int
  integer, intent(out) :: startindex, countnum
  integer :: endindex
  real(c_double) :: resolution
  type(cv_converter_ptr) :: time_cvt0, time_cvt
  type(ut_system_ptr) :: sys
  type(ut_unit_ptr) :: sec0, unit1, time_base0, time_base
  integer :: charset
  integer hour,minute,year,month,day
  real(c_double) :: second, converted_time
  real *8, parameter :: ZERO = 0.0
  character(len=99) :: char_a,char_b,char_c,char_d,char_e,char_f
  integer :: ii, ss

  charset = UT_ASCII
  sys = f_ut_read_xml("")
  sec0 = f_ut_parse(sys,"second",charset)
  unit1 = f_ut_parse(sys,timeunits,charset)
  time_base0 = f_ut_offset_by_time(sec0,f_ut_encode_time(2001,01,01,00,00,ZERO))
  time_cvt0 = f_ut_get_converter(unit1,time_base0)
  year=0 ; month=0; day=0 ; hour=0 ; minute=0 ; second=0.0
  resolution = -999.999
  ! loop over all timesteps
  allocate (time_littler_int(size(time)))
  do ii=1,size(time)
    tt = time(ii)
    converted_time = f_cv_convert_double(time_cvt0,tt)
    call f_ut_decode_time(converted_time,year,month,day,hour,minute, &
                          second, resolution)
    time_littler(ii) = dateint(year,month,day,hour,minute,int(second))
    time_littler_int(ii) = str2num(time_littler(ii))
  end do
  ! calculate startindex and endindex
  startindex = minloc(time_littler_int, dim=1, mask=(time_littler_int>=str2num(startdate)*1e6))
  !endindex = minloc(time_littler_int, dim=1, mask=(time_littler_int>=str2num(enddate)))
  endindex = maxloc(time_littler_int, dim=1, mask=(time_littler_int>=str2num(enddate)*1e6))
  ! calculate countnum
  countnum = endindex - startindex + 1
end subroutine time_to_littler_date

character(len=14) function dateint(year,month,day,hour,minute,second)
  ! convert integers of hour, minute, year, month, day, second
  ! into character string of YYYYMMDDhhmmss
  ! return character string
  character(len=99) :: char_a,char_b,char_c,char_d,char_e,char_f
  integer, intent(in) :: hour,minute,year,month,day, second

  ! convert integer to character strings, add leading 0 if needed
  write(char_a,fmt=*) year
  write(char_b,'(I0.2)')  month
  write(char_c,'(I0.2)')  day
  write(char_d, '(I0.2)')  hour
  write(char_e, '(I0.2)')  minute
  write(char_f, '(I0.2)')  second
  ! concatenate character strings
  dateint = trim(adjustl(char_a))//trim(adjustl(char_b))// &
    trim(adjustl(char_c))//trim(adjustl(char_d))// &
    trim(adjustl(char_e))//trim(adjustl(char_f))

  return
end function dateint

integer(kind=8) function str2num(str)
  ! convert string to integer
  character(len=*), intent(in) :: str
  !read (str, '(g12.5)') str2num
  read(str, *)  str2num
  return
end function str2num

subroutine write_obs_littler(pressure,height,temperature,dew_point,windspeed, &
  direction,uwind,vwind,humidity,thickness,mslp, &
  p_qc,z_qc,t_qc,td_qc,spd_qc,dir_qc,u_qc,v_qc,rh_qc,thick_qc, &
  ter , lat , lon , variable_mapping, kx, bogus, iseq_num, time_littler, &
  fill_value, outfile, append )
  !
  ! description subroutine here
  !
  logical, intent(inout) :: append
  integer, intent(in) :: kx
  real,dimension(kx) :: p,z,t,td,spd,dir,u,v,rh,thick,slp
  integer,dimension(kx) :: p_qc,z_qc,t_qc,td_qc,spd_qc
  real, intent(in) :: ter
  integer, dimension(kx) :: dir_qc,u_qc,v_qc,rh_qc,thick_qc
  real, dimension(kx) :: dpressure, dheight, dtemperature, ddew_point, dmslp
  real, dimension(kx) ::  dwindspeed, ddirection, du, dv, drh, dthickness, dpsfc
  integer, dimension(kx) :: dpressure_qc, dheight_qc, dtemperature_qc
  integer, dimension(kx) ::  ddew_point_qc, dwindspeed_qc, ddirection_qc, du_qc
  integer, dimension(kx) :: dv_qc, drh_qc, dthickness_qc
  REAL, intent(in) :: lon, lat
  character(len=30), dimension(:), intent(in):: variable_mapping
  character(len=30), intent(in):: outfile
  real, intent(in) :: fill_value
  logical bogus
  integer :: idx
  integer, intent(in) :: iseq_num
  character(len=14), dimension(:), intent(in) :: time_littler
  REAL,DIMENSION(:), intent(in) :: humidity, height, windspeed
  REAL,DIMENSION(:), intent(in) :: temperature, dew_point
  REAL,DIMENSION(:), intent(in) :: pressure, direction, thickness
  REAL,DIMENSION(:), intent(in) :: uwind, vwind, mslp

  call get_default_littler(dpressure, dheight, dtemperature, ddew_point, &
  dwindspeed, ddirection, du, dv, drh, dthickness,dpsfc,dmslp,dpressure_qc, &
  dheight_qc, dtemperature_qc, ddew_point_qc, dwindspeed_qc, &
  ddirection_qc, du_qc, dv_qc, drh_qc, dthickness_qc, kx)
  ! put this in a subroutine or function
  do idx=1,size(time_littler)
    ! set input data, fall back to default values
    ! add: allow for multiple levels
    if (ANY(variable_mapping=="pressure" ) .AND. &
      (pressure(idx) /= fill_value)) then
      if ((pressure(idx) > 90000) .AND. (pressure(idx) < 110000)) then
        p = pressure(idx)
      else if ((pressure(idx) > 9000) .AND. (pressure(idx) < 11000)) then
        p = 10 * pressure(idx)
      else if ((pressure(idx) > 900) .AND. (pressure(idx) < 1100)) then
        p = 100 * pressure(idx)
      else if ((pressure(idx) > 90) .AND. (pressure(idx) < 110)) then
        p = 1000 * pressure(idx)
      else
        p = dpressure
      end if
    else
      p = dpressure
    end if
    if (ANY(variable_mapping=="height" ) .AND. &
      (height(idx) /= fill_value)) then
      z = height(idx) ! either p or z must be defined
    else
      z = dheight
    endif
    if (ANY(variable_mapping=="temperature" ) .AND. &
    ((temperature(idx) /= fill_value) .AND. (temperature(idx) /= -888888))) then
      if (temperature(idx)>101) then
        ! assuming temperature is in Kelvin already
        t = temperature(idx)
      else
        ! assuming temperature is in Celcius
        t = temperature(idx) + 273.15 ! convert to K
      end if
    else
      t = dtemperature
    end if
    if (ANY(variable_mapping=="dew_point" ) .AND. &
      ((dew_point(idx) /= fill_value) .AND. (dew_point(idx) /= -888888))) then
      if (dew_point(idx)>101) then
        ! dew point temperature is already in Kelvin
        td = dew_point(idx)
      else
        ! assuming dew point temperature is in Celcius
        td = dew_point(idx) + 273.15
      end if
    else
      td = ddew_point
    end if
    if (ANY(variable_mapping=="windspeed" ) .AND. &
      (spd(idx) /= fill_value)) then
      spd = windspeed(idx)
    else
      spd = dwindspeed
    end if
    if (ANY(variable_mapping=="direction") .AND. &
      (direction(idx) /= fill_value)) then
      dir = direction(idx)
    else
      dir = ddirection
    end if
    if (ANY(variable_mapping=="uwind" ) .AND. &
      (uwind(idx) /= fill_value)) then
      u = uwind(idx)
    else
      u = du
    end if
    if (ANY(variable_mapping=="vwind" ) .AND. &
      (vwind(idx) /= fill_value)) then
      v = vwind(idx)
    else
      v = dv
    end if
    if (ANY(variable_mapping=="humidity" ) .AND. &
      (humidity(idx) /= fill_value)) then
      rh = humidity(idx)
    else
      rh = drh
    end if
    if (ANY(variable_mapping=="thickness") .AND. &
      (thickness(idx) /= fill_value)) then
      thick = thickness(idx)
    else
      thick = dthickness
    end if
    if (ANY(variable_mapping=="mslp" ) .AND. &
      ((mslp(idx) /= fill_value) .AND. mslp(idx) > 9000)) then
      slp = mslp(idx)
    else
      slp = dmslp
    end if
    p_qc = dpressure_qc
    z_qc = dheight_qc
    t_qc = dtemperature_qc
    td_qc = ddew_point_qc
    spd_qc = dwindspeed_qc
    dir_qc = ddirection_qc
    u_qc = du_qc
    v_qc = dv_qc
    rh_qc = drh_qc
    thick_qc = dthickness_qc
    if ( kx == 1 ) then ! surface variables
      call write_obs(p,z,t,td,spd,dir,u,v,rh,thick, &
        p_qc,z_qc,t_qc,td_qc,spd_qc,dir_qc,u_qc,v_qc,rh_qc,thick_qc, &
        slp, ter, lat, lon, time_littler(idx), kx, &
        '99001  Maybe more site info             ', &
        'SURFACE DATA FROM ??????????? SOURCE    ', &
        'FM-12 SYNOP                             ', &
        '                                        ', &
        bogus , iseq_num , 2, outfile, append )
    else ! vertical profile
      call write_obs(p,z,t,td,spd,dir,u,v,rh,thick, &
        p_qc,z_qc,t_qc,td_qc,spd_qc,dir_qc,u_qc,v_qc,rh_qc,thick_qc, &
        slp, ter, lat, lon, time_littler(idx), kx, &
        '99001  Maybe more site info             ', &
        'SOUNDINGS FROM ????????? SOURCE         ', &
        'FM-35 TEMP                              ', &
        '                                        ', &
        bogus , iseq_num , 2, outfile, append )
    endif
  end do

end subroutine write_obs_littler

end module write_littler


C    @(#)komp_txt2.f	20.3 2/13/96
        integer function komp_txt2 (ix, jx)
        implicit none
        integer ix, jx
c
c       This function sorts text2 by blocks and by network
c       data:
c
c       "A", "I", and "B+XQR$LET"
c
        common /difference/ numtxt1, array1, text1, numtxt2, array2,
     &                      text2, numchg, change

        integer MAXTEXT, MAXCHG
        parameter (MAXTEXT = 10000)
        parameter (MAXCHG = 4000)

        character text1(MAXTEXT)*120, text2(MAXTEXT)*120,
     &            change(MAXCHG)*120
        integer array1(MAXTEXT), numtxt1, array2(MAXTEXT), numtxt2,
     &          numchg

        integer type1, type2, sec1, sec2, junk, ic, jc, kompr
        real base1, base2

        komp_txt2 = 0
        if (ix .eq. jx) go to 1040

        ic = array2(ix)
        jc = array2(jx)

        type1 = index ('AIB+XQR$LET',text2(ic)(1:1))
        if (type1 .eq. 7 .and. text2(ic)(2:2) .eq. 'Z') then
           type1 = type1 + 1
        endif
        type2 = index ('AIB+XQR$LET',text2(jc)(1:1))
        if (type2 .eq. 7 .and. text2(jc)(2:2) .eq. 'Z') then
           type2 = type2 + 1
        endif
        komp_txt2 = min0 (type1, 3) - min0 (type2, 3)

        if (komp_txt2 .ne. 0) go to 1040

        if (text2(ic)(1:1) .eq. 'A') then

           komp_txt2 = kompr (text2(ic)(4:13),text2(jc)(4:13),junk)

           if (komp_txt2 .eq. 0) then
              komp_txt2 = kompr (text2(ic)(2:2),text2(jc)(2:2),junk)
           endif

        else if (text2(ic)(1:1) .eq. 'I') then

           komp_txt2 = kompr(text2(ic)(4:13),text2(jc)(4:13),junk)

           if (komp_txt2.eq.0) then
              komp_txt2 = kompr(text2(ic)(15:24),text2(jc)(15:24),junk)
           endif

        else if (index ('B+XQLRET', text2(ic)(1:1)) .ne. 0) then

           komp_txt2 = kompr (text2(ic)(7:14), text2(jc)(7:14), junk)

           if (komp_txt2 .eq. 0) then
              read (text2(ic)(15:19),610) base1
  610         format (bz, f4.0)
              read (text2(jc)(15:19),610) base2
              komp_txt2 = 100.0*(base1 - base2)
           endif

           if (komp_txt2 .eq. 0) then
              type1 = index ('B+XQR$LET', text2(ic)(1:1))
              if (type1 .eq. 5 .and. text2(ic)(2:2) .eq. 'Z') then
                 type1 = type1 + 1
              endif
              type2 = index ('B+XQR$LET', text2(jc)(1:1))
              if (type2 .eq. 5 .and. text2(jc)(2:2) .eq. 'Z') then
                 type2 = type2 + 1
              endif

              komp_txt2 = min0 (type1, 5) - min0 (type2, 5)

              if (komp_txt2 .ne. 0) go to 1040

              if (text2(ic)(1:1) .eq. 'B') then

              else if (text2(ic)(1:1) .eq. '+') then

                 komp_txt2 = kompr (text2(ic)(2:2), text2(jc)(2:2),
     &                           junk)
                 if (komp_txt2 .eq. 0) then
                    komp_txt2 = kompr (text2(ic)(4:6),
     &                              text2(jc)(4:6), junk)
                    if (komp_txt2 .eq. 0) then
                       komp_txt2 = kompr (text2(ic)(19:20),
     &                                 text2(jc)(19:20), junk)
                    endif
                 endif

              else if (text2(ic)(1:1) .eq. 'X') then

              else if (text2(ic)(1:1) .eq. 'Q') then

                 komp_txt2 = index ('PXN', text2(ic)(2:2)) -
     &                    index ('PXN', text2(jc)(2:2))

              else if (index ('LRET', text2(ic)(1:1)) .ne. 0) then

                 komp_txt2 = kompr (text2(ic)(20:27),
     &                             text2(jc)(20:27), junk)
                 if (komp_txt2 .eq. 0) then
                    read (text2(ic)(28:31),610) base1
                    read (text2(jc)(28:31),610) base2
                    komp_txt2 = 100.0 * (base1 - base2)
                    if (komp_txt2 .eq. 0) then
c
c                      Compare "R" with non-"R"
c
                       komp_txt2 = min0 (type1,2) - min0 (type2,2)
                       if (komp_txt2 .eq. 0) then
                           komp_txt2 = kompr (text2(ic)(32:32),
     &                                     text2(jc)(32:32), junk)
                           if (komp_txt2 .eq. 0) then
                              read (text2(ic)(33:33),1010) sec1
 1010                         format (bz, i2)
                              read (text2(jc)(33:33),1010) sec2
                              komp_txt2 = sec1 - sec2
                              if (komp_txt2 .eq. 0) then
                                  komp_txt2 = type1 - type2
                              endif
                          endif
                       endif
                    endif
                 endif
              endif
           endif
        endif

 1040   continue
        return
        end


*
*     -----------------------------------------------------------------
*      F R M A 0 3
*     -----------------------------------------------------------------
*
*      JT7 = 18 -- 23                                              *
*
      SUBROUTINE FRMA03(J1,J2,ISKA)
      DIMENSION IS18A(27),IS18B(5),IS19A(27),IS19B(8),IS20(58),
     :IS21(58),IS22A(36),IS22B(14),IS23A(32),IS23B(8)
*
      DATA IS18A/-125,2*0,-525,0,-225,5*0,-200,-325,3*0,672,63,2*0,
     :175,5*0,315/
      DATA IS18B/-72,-108,0,-264,-396/
      DATA IS19A/15,-3360,0,5103,0,27,-6048,0,-5832,-21384,0,-17496,
     :39,-8736,3*0,-4725,2*0,4725,4*0,-24192,8505/
      DATA IS19B/8100,2*0,29700,2*0,-6480,-23760/
      DATA IS20/1355200,605000,-950400,0,1164240,322560,144000,
     :-1544400,-914760,249480,2*0,-1426880,-637000,4*0,-58800,-846720,
     :348480,1351680,43560,48000,-1655808,0,82944,2196480,10368,78000,
     :-65520,3*0,-752640,1152480,-393120,0,-813120,-73920,0,221760,0,
     :-960960,-10164,2772,0,113190,-270270,1471470,-255255,-231231,
     :-366912,-489216,-45864,749112,45864,1559376/
      DATA IS21/-1101100,314600,-1737450,2*0,1638000,-468000,1069200,
     :2*0,2182950,0,-171500,49000,6*0,283140,-617760,0,-171990,2*0,
     :-421200,380160,0,105840,-555660,388080,48510,-1309770,-1375920,
     :-171990,833490,2*0,-2162160,2*0,776160,166320,2*0,216090,-270270,
     :187110,20790,176715,-826875,44100,2116800,0,264600,-1555848,
     :269892/
      DATA IS22A/1960200,950400,0,-1164240,0,466560,1544400,-914760,
     :249480,3*0,-2063880,4*0,-1714608,-846720,2*0,-392040,1399680,4*0,
     :-93312,2274480,-65520,4*0,-1905120,-393120/
      DATA IS22B/-823284,224532,0,-187110,-270270,-2432430,-255255,
     :-231231,2*0,412776,-1238328,45864,1559376/
      DATA IS23A/-1003275,3*0,465696,-539,2*0,-27225,-105600,2*0,
     :-47040,0,16875,-411840,3*0,-254800,2*0,-35280,2*0,-548856,10164,
     :92400,1081080,-20020,-344960,166320/
      DATA IS23B/-28665,-611520,4*0,470400,499800/
*
      IF(J1.EQ.18) THEN
        IF(J2.LT.121) RETURN
        IF(J2.LT.148) THEN
          I2=J2-120
          ISKA=IS18A(I2)
        ELSEIF(J2.LT.163) THEN
          IF(J2.LT.158) RETURN
          I2=J2-157
          ISKA=IS18B(I2)
        ELSEIF(J2.EQ.173) THEN
          ISKA=455
        ENDIF
      ELSEIF(J1.EQ.19) THEN
        IF(J2.LT.121) RETURN
        IF(J2.LT.148) THEN
          I2=J2-120
          ISKA=IS19A(I2)
        ELSEIF(J2.LT.167) THEN
          IF(J2.LT.159) RETURN
          I2=J2-158
          ISKA=IS19B(I2)
        ELSEIF(J2.EQ.173) THEN
          ISKA=12285
        ENDIF
      ELSEIF(J1.EQ.20) THEN
        IF(J2.LT.121) RETURN
        IF(J2.GT.178) RETURN
        I2=J2-120
        ISKA=IS20(I2)
      ELSEIF(J1.EQ.21) THEN
        IF(J2.LT.121) RETURN
        IF(J2.GT.178) RETURN
        I2=J2-120
        ISKA=IS21(I2)
      ELSEIF(J1.EQ.22) THEN
        IF(J2.LT.122) RETURN
        IF(J2.LT.158) THEN
          I2=J2-121
          ISKA=IS22A(I2)
        ELSEIF(J2.LT.179) THEN
          IF(J2.LT.165) RETURN
          I2=J2-164
          ISKA=IS22B(I2)
        ENDIF
      ELSEIF(J1.EQ.23) THEN
        IF(J2.EQ.121) THEN
          ISKA=-952875
        ELSEIF(J2.EQ.124) THEN
          ISKA=363825
        ELSEIF(J2.EQ.126) THEN
          ISKA=590625
        ELSEIF(J2.LT.165) THEN
          IF(J2.LT.133) RETURN
          I2=J2-132
          ISKA=IS23A(I2)
        ELSEIF(J2.LT.181) THEN
          IF(J2.LT.173) RETURN
          I2=J2-172
          ISKA=IS23B(I2)
        ENDIF
      ENDIF
      RETURN
      END


          subroutine flcB50(Tin,ilaw,flimbx,flimby)
c
c   UPDATE June 17, 2002
c
c   Change the variable x1array to xonarr
c   Change the variable x2array to xtwarr
c   Change the variable x3array to xtharr
c   Change the variable y3array to ytharr
c
          implicit double precision (a-h,o-z)
c
          dimension tarray(61),xonarr(61),xtwarr(61),
     $     xtharr(61),
     $     y2array(61),ytharr(61)
c
          data tarray/ 3500., 3750., 4000., 4250., 4500., 4750., 5000.,
     %      5250., 5500., 5750., 6000., 6250., 6500., 6750., 7000., 7250., 7500.,
     %      7750., 8000., 8250., 8500., 8750., 9000., 9250., 9500., 9750.,10000.,
     %     10500.,11000.,11500.,12000.,12500.,13000.,14000.,15000.,16000.,17000.,
     %     18000.,19000.,20000.,21000.,22000.,23000.,24000.,25000.,26000.,27000.,
     %     28000.,29000.,30000.,31000.,32000.,33000.,34000.,35000.,37500.,40000.,
     $     42500.,45000.,47500.,50000./
c
          data xonarr/ 0.630, 0.611, 0.680, 0.824, 0.912, 0.899, 0.861,
     %      0.819, 0.778, 0.739, 0.701, 0.668, 0.637, 0.611, 0.589, 0.568, 0.549,
     %      0.532, 0.518, 0.543, 0.526, 0.519, 0.532, 0.513, 0.496, 0.483, 0.471,
     %      0.451, 0.434, 0.418, 0.404, 0.391, 0.379, 0.358, 0.342, 0.329, 0.318,
     %      0.310, 0.302, 0.296, 0.290, 0.284, 0.278, 0.272, 0.266, 0.260, 0.255,
     %      0.251, 0.247, 0.244, 0.239, 0.234, 0.228, 0.220, 0.212, 0.192, 0.179,
     $      0.173, 0.169, 0.166, 0.164/
c
          data xtwarr/ 0.857, 0.825, 0.822, 0.828, 0.835, 0.843, 0.848,
     %      0.849, 0.846, 0.839, 0.829, 0.817, 0.804, 0.793, 0.783, 0.774, 0.766,
     %      0.760, 0.757, 0.790, 0.778, 0.760, 0.739, 0.725, 0.712, 0.701, 0.692,
     %      0.674, 0.658, 0.642, 0.626, 0.610, 0.594, 0.565, 0.541, 0.521, 0.505,
     %      0.491, 0.480, 0.470, 0.461, 0.453, 0.446, 0.440, 0.433, 0.426, 0.419,
     %      0.412, 0.407, 0.403, 0.398, 0.392, 0.385, 0.377, 0.368, 0.343, 0.323,
     $      0.314, 0.311, 0.309, 0.307/
c
          data y2array/ 0.341, 0.321, 0.213, 0.006,-0.117,-0.084,-0.019,
     %      0.045, 0.102, 0.149, 0.191, 0.224, 0.251, 0.272, 0.291, 0.308, 0.325,
     %      0.342, 0.359, 0.371, 0.379, 0.362, 0.311, 0.318, 0.324, 0.328, 0.331,
     %      0.334, 0.336, 0.335, 0.333, 0.329, 0.323, 0.311, 0.299, 0.289, 0.279,
     %      0.272, 0.266, 0.261, 0.257, 0.254, 0.252, 0.251, 0.250, 0.248, 0.245,
     %      0.242, 0.240, 0.239, 0.238, 0.236, 0.235, 0.234, 0.234, 0.227, 0.216,
     $      0.212, 0.213, 0.214, 0.216/
c
          data xtharr/ 0.118, 0.129, 0.360, 0.815, 1.088, 1.025, 0.890,
     %      0.752, 0.625, 0.515, 0.414, 0.332, 0.260, 0.203, 0.152, 0.107, 0.061,
     %      0.019,-0.021,-0.014,-0.043,-0.024, 0.066, 0.035, 0.010,-0.009,-0.025,
     %     -0.050,-0.069,-0.085,-0.095,-0.102,-0.106,-0.109,-0.107,-0.104,-0.101,
     %     -0.098,-0.096,-0.095,-0.095,-0.097,-0.100,-0.104,-0.108,-0.111,-0.113,
     %     -0.113,-0.113,-0.114,-0.117,-0.120,-0.125,-0.131,-0.138,-0.148,-0.146,
     $     -0.146,-0.150,-0.154,-0.160/
c
          data ytharr/ 0.853, 0.803, 0.532, 0.015,-0.292,-0.209,-0.048,
     %      0.112, 0.255, 0.373, 0.479, 0.559, 0.628, 0.681, 0.728, 0.770, 0.813,
     %      0.856, 0.898, 0.928, 0.948, 0.905, 0.777, 0.796, 0.810, 0.819, 0.827,
     %      0.836, 0.839, 0.838, 0.832, 0.822, 0.808, 0.778, 0.748, 0.721, 0.698,
     %      0.680, 0.665, 0.652, 0.642, 0.635, 0.630, 0.627, 0.624, 0.619, 0.613,
     %      0.606, 0.600, 0.597, 0.594, 0.590, 0.588, 0.586, 0.584, 0.567, 0.541,
     $      0.531, 0.532, 0.534, 0.539/
c
          N=61
c
          if(Tin.le.tarray(1))then
            if(ilaw.le.1)then
              flimbx=xonarr(1)
              flimby=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(1)
              flimby=y2array(1)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(1)
              flimby=ytharr(1)
              return
            endif
          endif
c
          if(Tin.ge.tarray(N))then
            if(ilaw.le.1)then
              flimbx=xonarr(N)
              flimbx=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(N)
              flimbx=y2array(N)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(N)
              flimbx=ytharr(N)
              return
            endif
          endif
c
c   Find out where Tin is located in the tabulated temperature array.
c
          call locate(tarray,N,Tin,index)
c
          if(ilaw.le.1)then
            slope=(xonarr(index)-xonarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xonarr(index)
            flimby=0.0
            return
          endif
c
          if(ilaw.eq.2)then
            slope=(xtwarr(index)-xtwarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtwarr(index)
            slope=(y2array(index)-y2array(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+y2array(index)
            return
          endif
c
          if(ilaw.ge.3)then
            slope=(xtharr(index)-xtharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtharr(index)
            slope=(ytharr(index)-ytharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+ytharr(index)
            return
          endif
c
          return
          end
c
c   ***********************
c
          subroutine flcH50(Tin,ilaw,flimbx,flimby)
c
c
c
          implicit double precision (a-h,o-z)
c
          dimension tarray(61),xonarr(61),xtwarr(61),
     $     xtharr(61),
     $     y2array(61),ytharr(61)
c
          data tarray/ 3500., 3750., 4000., 4250., 4500., 4750., 5000.,
     %      5250., 5500., 5750., 6000., 6250., 6500., 6750., 7000., 7250., 7500.,
     %      7750., 8000., 8250., 8500., 8750., 9000., 9250., 9500., 9750.,10000.,
     %     10500.,11000.,11500.,12000.,12500.,13000.,14000.,15000.,16000.,17000.,
     %     18000.,19000.,20000.,21000.,22000.,23000.,24000.,25000.,26000.,27000.,
     %     28000.,29000.,30000.,31000.,32000.,33000.,34000.,35000.,37500.,40000.,
     $     42500.,45000.,47500.,50000./
c
          data xonarr/ 0.234, 0.252, 0.301, 0.373, 0.415, 0.408, 0.388,
     %      0.366, 0.345, 0.325, 0.306, 0.289, 0.275, 0.263, 0.252, 0.242, 0.233,
     %      0.226, 0.221, 0.249, 0.240, 0.229, 0.216, 0.209, 0.204, 0.200, 0.197,
     %      0.192, 0.187, 0.183, 0.178, 0.173, 0.168, 0.158, 0.150, 0.144, 0.139,
     %      0.135, 0.131, 0.129, 0.126, 0.125, 0.124, 0.123, 0.122, 0.122, 0.121,
     %      0.120, 0.119, 0.118, 0.117, 0.115, 0.112, 0.110, 0.106, 0.098, 0.089,
     $      0.084, 0.082, 0.080, 0.079/
c
          data xtwarr/ 0.448, 0.454, 0.488, 0.536, 0.562, 0.557, 0.545,
     %      0.530, 0.513, 0.495, 0.477, 0.460, 0.444, 0.430, 0.419, 0.408, 0.398,
     %      0.390, 0.383, 0.384, 0.372, 0.357, 0.339, 0.328, 0.320, 0.314, 0.309,
     %      0.301, 0.294, 0.287, 0.279, 0.272, 0.264, 0.250, 0.238, 0.229, 0.221,
     %      0.215, 0.210, 0.207, 0.205, 0.204, 0.205, 0.206, 0.208, 0.209, 0.209,
     %      0.209, 0.207, 0.206, 0.203, 0.200, 0.196, 0.192, 0.187, 0.178, 0.168,
     $      0.164, 0.163, 0.164, 0.164/
c
          data y2array/ 0.320, 0.303, 0.281, 0.243, 0.221, 0.224, 0.235,
     %      0.245, 0.252, 0.255, 0.257, 0.256, 0.254, 0.252, 0.250, 0.249, 0.247,
     %      0.245, 0.243, 0.202, 0.198, 0.192, 0.185, 0.179, 0.174, 0.171, 0.169,
     %      0.164, 0.160, 0.156, 0.152, 0.148, 0.144, 0.137, 0.131, 0.127, 0.123,
     %      0.120, 0.118, 0.118, 0.118, 0.119, 0.122, 0.125, 0.129, 0.131, 0.133,
     %      0.134, 0.133, 0.132, 0.130, 0.128, 0.125, 0.123, 0.121, 0.120, 0.120,
     $      0.121, 0.122, 0.125, 0.127/
c
          data xtharr/-0.245,-0.203,-0.120, 0.008, 0.083, 0.071, 0.036,
     %     -0.001,-0.033,-0.057,-0.080,-0.095,-0.107,-0.115,-0.124,-0.130,-0.138,
     %     -0.142,-0.143,-0.054,-0.057,-0.059,-0.061,-0.059,-0.057,-0.056,-0.056,
     %     -0.055,-0.053,-0.052,-0.050,-0.050,-0.048,-0.048,-0.047,-0.046,-0.046,
     %     -0.046,-0.046,-0.048,-0.051,-0.054,-0.059,-0.064,-0.071,-0.075,-0.079,
     %     -0.081,-0.081,-0.081,-0.079,-0.077,-0.076,-0.075,-0.076,-0.082,-0.091,
     $     -0.097,-0.101,-0.107,-0.112/
c
          data ytharr/ 0.799, 0.758, 0.702, 0.608, 0.553, 0.561, 0.586,
     %      0.612, 0.630, 0.637, 0.644, 0.640, 0.636, 0.629, 0.626, 0.621, 0.618,
     %      0.614, 0.606, 0.506, 0.495, 0.480, 0.462, 0.447, 0.435, 0.427, 0.422,
     %      0.410, 0.400, 0.391, 0.380, 0.371, 0.360, 0.344, 0.329, 0.317, 0.309,
     %      0.301, 0.296, 0.294, 0.295, 0.298, 0.304, 0.311, 0.322, 0.328, 0.333,
     %      0.334, 0.333, 0.330, 0.325, 0.320, 0.313, 0.307, 0.304, 0.300, 0.299,
     $      0.302, 0.306, 0.312, 0.319/
c
          N=61
c
          if(Tin.le.tarray(1))then
            if(ilaw.le.1)then
              flimbx=xonarr(1)
              flimby=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(1)
              flimby=y2array(1)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(1)
              flimby=ytharr(1)
              return
            endif
          endif
c
          if(Tin.ge.tarray(N))then
            if(ilaw.le.1)then
              flimbx=xonarr(N)
              flimbx=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(N)
              flimbx=y2array(N)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(N)
              flimbx=ytharr(N)
              return
            endif
          endif
c
c   Find out where Tin is located in the tabulated temperature array.
c
          call locate(tarray,N,Tin,index)
c
          if(ilaw.le.1)then
            slope=(xonarr(index)-xonarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xonarr(index)
            flimby=0.0
            return
          endif
c
          if(ilaw.eq.2)then
            slope=(xtwarr(index)-xtwarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtwarr(index)
            slope=(y2array(index)-y2array(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+y2array(index)
            return
          endif
c
          if(ilaw.ge.3)then
            slope=(xtharr(index)-xtharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtharr(index)
            slope=(ytharr(index)-ytharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+ytharr(index)
            return
          endif
c
          return
          end
c
c   ***********************
c
          subroutine flcI50(Tin,ilaw,flimbx,flimby)
c
c
c
          implicit double precision (a-h,o-z)
c
          dimension tarray(61),xonarr(61),xtwarr(61),
     $     xtharr(61),
     $     y2array(61),ytharr(61)
c
          data tarray/ 3500., 3750., 4000., 4250., 4500., 4750., 5000.,
     %      5250., 5500., 5750., 6000., 6250., 6500., 6750., 7000., 7250., 7500.,
     %      7750., 8000., 8250., 8500., 8750., 9000., 9250., 9500., 9750.,10000.,
     %     10500.,11000.,11500.,12000.,12500.,13000.,14000.,15000.,16000.,17000.,
     %     18000.,19000.,20000.,21000.,22000.,23000.,24000.,25000.,26000.,27000.,
     %     28000.,29000.,30000.,31000.,32000.,33000.,34000.,35000.,37500.,40000.,
     $     42500.,45000.,47500.,50000./
c
          data xonarr/ 0.453, 0.430, 0.444, 0.506, 0.555, 0.549, 0.527,
     %      0.500, 0.473, 0.446, 0.420, 0.397, 0.377, 0.361, 0.348, 0.335, 0.323,
     %      0.314, 0.309, 0.347, 0.335, 0.321, 0.304, 0.295, 0.287, 0.281, 0.277,
     %      0.268, 0.261, 0.253, 0.246, 0.239, 0.232, 0.218, 0.207, 0.199, 0.192,
     %      0.187, 0.182, 0.179, 0.176, 0.173, 0.171, 0.169, 0.167, 0.165, 0.163,
     %      0.160, 0.159, 0.157, 0.155, 0.153, 0.150, 0.146, 0.142, 0.128, 0.115,
     $      0.109, 0.106, 0.103, 0.102/
c
          data xtwarr/ 0.689, 0.667, 0.661, 0.668, 0.666, 0.656, 0.647,
     %      0.637, 0.625, 0.609, 0.592, 0.575, 0.558, 0.544, 0.531, 0.520, 0.509,
     %      0.500, 0.493, 0.492, 0.480, 0.464, 0.442, 0.430, 0.421, 0.414, 0.408,
     %      0.398, 0.389, 0.380, 0.370, 0.360, 0.350, 0.333, 0.318, 0.306, 0.296,
     %      0.288, 0.283, 0.278, 0.275, 0.273, 0.272, 0.273, 0.273, 0.273, 0.272,
     %      0.270, 0.268, 0.266, 0.264, 0.260, 0.255, 0.250, 0.244, 0.228, 0.212,
     $      0.205, 0.203, 0.202, 0.202/
c
          data y2array/ 0.354, 0.356, 0.326, 0.243, 0.167, 0.161, 0.181,
     %      0.205, 0.228, 0.244, 0.259, 0.267, 0.271, 0.273, 0.275, 0.277, 0.279,
     %      0.279, 0.277, 0.218, 0.218, 0.214, 0.207, 0.203, 0.201, 0.199, 0.197,
     %      0.195, 0.192, 0.189, 0.186, 0.182, 0.178, 0.172, 0.166, 0.160, 0.156,
     %      0.153, 0.150, 0.149, 0.149, 0.150, 0.152, 0.155, 0.159, 0.162, 0.164,
     %      0.164, 0.164, 0.164, 0.163, 0.161, 0.158, 0.156, 0.154, 0.151, 0.146,
     $      0.144, 0.145, 0.148, 0.150/
c
          data xtharr/-0.077,-0.104,-0.044, 0.142, 0.305, 0.308, 0.256,
     %      0.192, 0.131, 0.080, 0.032,-0.003,-0.030,-0.049,-0.065,-0.080,-0.095,
     %     -0.104,-0.106, 0.019, 0.008, 0.000,-0.007,-0.011,-0.014,-0.017,-0.019,
     %     -0.025,-0.028,-0.030,-0.032,-0.034,-0.036,-0.039,-0.041,-0.042,-0.042,
     %     -0.042,-0.043,-0.044,-0.047,-0.051,-0.057,-0.063,-0.070,-0.078,-0.083,
     %     -0.086,-0.088,-0.089,-0.089,-0.089,-0.088,-0.088,-0.090,-0.099,-0.105,
     $     -0.108,-0.112,-0.118,-0.123/
c
          data ytharr/ 0.884, 0.890, 0.814, 0.607, 0.418, 0.402, 0.452,
     %      0.514, 0.569, 0.611, 0.647, 0.667, 0.679, 0.683, 0.688, 0.692, 0.698,
     %      0.697, 0.692, 0.546, 0.545, 0.535, 0.518, 0.509, 0.502, 0.496, 0.493,
     %      0.488, 0.481, 0.473, 0.464, 0.455, 0.446, 0.429, 0.414, 0.401, 0.390,
     %      0.382, 0.376, 0.372, 0.372, 0.374, 0.380, 0.387, 0.396, 0.404, 0.409,
     %      0.411, 0.411, 0.410, 0.407, 0.402, 0.396, 0.390, 0.385, 0.378, 0.366,
     $      0.360, 0.363, 0.370, 0.374/
c
          N=61
c
          if(Tin.le.tarray(1))then
            if(ilaw.le.1)then
              flimbx=xonarr(1)
              flimby=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(1)
              flimby=y2array(1)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(1)
              flimby=ytharr(1)
              return
            endif
          endif
c
          if(Tin.ge.tarray(N))then
            if(ilaw.le.1)then
              flimbx=xonarr(N)
              flimbx=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(N)
              flimbx=y2array(N)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(N)
              flimbx=ytharr(N)
              return
            endif
          endif
c
c   Find out where Tin is located in the tabulated temperature array.
c
          call locate(tarray,N,Tin,index)
c
          if(ilaw.le.1)then
            slope=(xonarr(index)-xonarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xonarr(index)
            flimby=0.0
            return
          endif
c
          if(ilaw.eq.2)then
            slope=(xtwarr(index)-xtwarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtwarr(index)
            slope=(y2array(index)-y2array(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+y2array(index)
            return
          endif
c
          if(ilaw.ge.3)then
            slope=(xtharr(index)-xtharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtharr(index)
            slope=(ytharr(index)-ytharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+ytharr(index)
            return
          endif
c
          return
          end
c
c   ***********************
c
          subroutine flcJ50(Tin,ilaw,flimbx,flimby)
c
c
c
          implicit double precision (a-h,o-z)

          dimension tarray(61),xonarr(61),xtwarr(61),
     $     xtharr(61),
     $     y2array(61),ytharr(61)
c
          data tarray/ 3500., 3750., 4000., 4250., 4500., 4750., 5000.,
     %      5250., 5500., 5750., 6000., 6250., 6500., 6750., 7000., 7250., 7500.,
     %      7750., 8000., 8250., 8500., 8750., 9000., 9250., 9500., 9750.,10000.,
     %     10500.,11000.,11500.,12000.,12500.,13000.,14000.,15000.,16000.,17000.,
     %     18000.,19000.,20000.,21000.,22000.,23000.,24000.,25000.,26000.,27000.,
     %     28000.,29000.,30000.,31000.,32000.,33000.,34000.,35000.,37500.,40000.,
     $     42500.,45000.,47500.,50000./
c
          data xonarr/ 0.234, 0.252, 0.301, 0.373, 0.415, 0.408, 0.388,
     %      0.366, 0.345, 0.325, 0.306, 0.289, 0.275, 0.263, 0.252, 0.242, 0.233,
     %      0.226, 0.221, 0.249, 0.240, 0.229, 0.216, 0.209, 0.204, 0.200, 0.197,
     %      0.192, 0.187, 0.183, 0.178, 0.173, 0.168, 0.158, 0.150, 0.144, 0.139,
     %      0.135, 0.131, 0.129, 0.126, 0.125, 0.124, 0.123, 0.122, 0.122, 0.121,
     %      0.120, 0.119, 0.118, 0.117, 0.115, 0.112, 0.110, 0.106, 0.098, 0.089,
     $      0.084, 0.082, 0.080, 0.079/
c
          data xtwarr/ 0.448, 0.454, 0.488, 0.536, 0.562, 0.557, 0.545,
     %      0.530, 0.513, 0.495, 0.477, 0.460, 0.444, 0.430, 0.419, 0.408, 0.398,
     %      0.390, 0.383, 0.384, 0.372, 0.357, 0.339, 0.328, 0.320, 0.314, 0.309,
     %      0.301, 0.294, 0.287, 0.279, 0.272, 0.264, 0.250, 0.238, 0.229, 0.221,
     %      0.215, 0.210, 0.207, 0.205, 0.204, 0.205, 0.206, 0.208, 0.209, 0.209,
     %      0.209, 0.207, 0.206, 0.203, 0.200, 0.196, 0.192, 0.187, 0.178, 0.168,
     $      0.164, 0.163, 0.164, 0.164/
c
          data y2array/ 0.320, 0.303, 0.281, 0.243, 0.221, 0.224, 0.235,
     %      0.245, 0.252, 0.255, 0.257, 0.256, 0.254, 0.252, 0.250, 0.249, 0.247,
     %      0.245, 0.243, 0.202, 0.198, 0.192, 0.185, 0.179, 0.174, 0.171, 0.169,
     %      0.164, 0.160, 0.156, 0.152, 0.148, 0.144, 0.137, 0.131, 0.127, 0.123,
     %      0.120, 0.118, 0.118, 0.118, 0.119, 0.122, 0.125, 0.129, 0.131, 0.133,
     %      0.134, 0.133, 0.132, 0.130, 0.128, 0.125, 0.123, 0.121, 0.120, 0.120,
     $      0.121, 0.122, 0.125, 0.127/
c
          data xtharr/-0.245,-0.203,-0.120, 0.008, 0.083, 0.071, 0.036,
     %     -0.001,-0.033,-0.057,-0.080,-0.095,-0.107,-0.115,-0.124,-0.130,-0.138,
     %     -0.142,-0.143,-0.054,-0.057,-0.059,-0.061,-0.059,-0.057,-0.056,-0.056,
     %     -0.055,-0.053,-0.052,-0.050,-0.050,-0.048,-0.048,-0.047,-0.046,-0.046,
     %     -0.046,-0.046,-0.048,-0.051,-0.054,-0.059,-0.064,-0.071,-0.075,-0.079,
     %     -0.081,-0.081,-0.081,-0.079,-0.077,-0.076,-0.075,-0.076,-0.082,-0.091,
     $     -0.097,-0.101,-0.107,-0.112/
c
          data ytharr/ 0.799, 0.758, 0.702, 0.608, 0.553, 0.561, 0.586,
     %      0.612, 0.630, 0.637, 0.644, 0.640, 0.636, 0.629, 0.626, 0.621, 0.618,
     %      0.614, 0.606, 0.506, 0.495, 0.480, 0.462, 0.447, 0.435, 0.427, 0.422,
     %      0.410, 0.400, 0.391, 0.380, 0.371, 0.360, 0.344, 0.329, 0.317, 0.309,
     %      0.301, 0.296, 0.294, 0.295, 0.298, 0.304, 0.311, 0.322, 0.328, 0.333,
     %      0.334, 0.333, 0.330, 0.325, 0.320, 0.313, 0.307, 0.304, 0.300, 0.299,
     $      0.302, 0.306, 0.312, 0.319/
c
          N=61
c
          if(Tin.le.tarray(1))then
            if(ilaw.le.1)then
              flimbx=xonarr(1)
              flimby=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(1)
              flimby=y2array(1)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(1)
              flimby=ytharr(1)
              return
            endif
          endif
c
          if(Tin.ge.tarray(N))then
            if(ilaw.le.1)then
              flimbx=xonarr(N)
              flimbx=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(N)
              flimbx=y2array(N)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(N)
              flimbx=ytharr(N)
              return
            endif
          endif
c
c   Find out where Tin is located in the tabulated temperature array.
c
          call locate(tarray,N,Tin,index)
c
          if(ilaw.le.1)then
            slope=(xonarr(index)-xonarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xonarr(index)
            flimby=0.0
            return
          endif
c
          if(ilaw.eq.2)then
            slope=(xtwarr(index)-xtwarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtwarr(index)
            slope=(y2array(index)-y2array(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+y2array(index)
            return
          endif
c
          if(ilaw.ge.3)then
            slope=(xtharr(index)-xtharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtharr(index)
            slope=(ytharr(index)-ytharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+ytharr(index)
            return
          endif
c
          return
          end
c
c   ***********************
c
          subroutine flcK50(Tin,ilaw,flimbx,flimby)
c
c
c
          implicit double precision (a-h,o-z)

          dimension tarray(61),xonarr(61),xtwarr(61),
     $     xtharr(61),
     $     y2array(61),ytharr(61)
c
          data tarray/ 3500., 3750., 4000., 4250., 4500., 4750., 5000.,
     %      5250., 5500., 5750., 6000., 6250., 6500., 6750., 7000., 7250., 7500.,
     %      7750., 8000., 8250., 8500., 8750., 9000., 9250., 9500., 9750.,10000.,
     %     10500.,11000.,11500.,12000.,12500.,13000.,14000.,15000.,16000.,17000.,
     %     18000.,19000.,20000.,21000.,22000.,23000.,24000.,25000.,26000.,27000.,
     %     28000.,29000.,30000.,31000.,32000.,33000.,34000.,35000.,37500.,40000.,
     $     42500.,45000.,47500.,50000./
c
          data xonarr/ 0.140, 0.158, 0.203, 0.250, 0.263, 0.257, 0.247,
     %      0.235, 0.222, 0.210, 0.198, 0.188, 0.178, 0.170, 0.163, 0.157, 0.151,
     %      0.148, 0.147, 0.156, 0.150, 0.142, 0.134, 0.130, 0.126, 0.124, 0.122,
     %      0.118, 0.115, 0.113, 0.109, 0.106, 0.103, 0.097, 0.092, 0.088, 0.085,
     %      0.082, 0.080, 0.079, 0.078, 0.078, 0.078, 0.079, 0.080, 0.081, 0.082,
     %      0.082, 0.081, 0.081, 0.079, 0.078, 0.076, 0.073, 0.071, 0.066, 0.061,
     $      0.059, 0.058, 0.058, 0.058/
c
          data xtwarr/ 0.284, 0.307, 0.361, 0.423, 0.452, 0.445, 0.428,
     %      0.410, 0.391, 0.373, 0.354, 0.338, 0.323, 0.310, 0.299, 0.289, 0.279,
     %      0.272, 0.265, 0.250, 0.239, 0.228, 0.217, 0.209, 0.203, 0.198, 0.195,
     %      0.189, 0.184, 0.179, 0.174, 0.169, 0.165, 0.157, 0.150, 0.145, 0.141,
     %      0.138, 0.136, 0.135, 0.135, 0.137, 0.140, 0.143, 0.146, 0.148, 0.149,
     %      0.148, 0.147, 0.145, 0.143, 0.139, 0.136, 0.133, 0.130, 0.127, 0.124,
     $      0.123, 0.124, 0.125, 0.125/
c
          data y2array/ 0.216, 0.224, 0.237, 0.260, 0.283, 0.281, 0.272,
     %      0.263, 0.254, 0.244, 0.234, 0.226, 0.217, 0.210, 0.205, 0.198, 0.192,
     %      0.185, 0.177, 0.140, 0.135, 0.129, 0.125, 0.119, 0.115, 0.112, 0.109,
     %      0.106, 0.103, 0.100, 0.097, 0.094, 0.092, 0.089, 0.087, 0.086, 0.085,
     %      0.084, 0.084, 0.084, 0.086, 0.089, 0.093, 0.096, 0.098, 0.100, 0.100,
     %      0.100, 0.099, 0.097, 0.095, 0.093, 0.090, 0.089, 0.089, 0.091, 0.095,
     $      0.096, 0.098, 0.100, 0.102/
c
          data xtharr/-0.184,-0.178,-0.153,-0.140,-0.162,-0.165,-0.161,
     %     -0.159,-0.158,-0.156,-0.154,-0.151,-0.148,-0.145,-0.144,-0.141,-0.137,
     %     -0.130,-0.118,-0.053,-0.052,-0.051,-0.053,-0.049,-0.046,-0.044,-0.043,
     %     -0.041,-0.039,-0.037,-0.036,-0.035,-0.035,-0.036,-0.039,-0.041,-0.042,
     %     -0.044,-0.045,-0.048,-0.051,-0.056,-0.061,-0.065,-0.067,-0.069,-0.069,
     %     -0.068,-0.067,-0.065,-0.063,-0.062,-0.060,-0.061,-0.063,-0.071,-0.080,
     $     -0.085,-0.089,-0.092,-0.095/
c
          data ytharr/ 0.541, 0.560, 0.592, 0.649, 0.709, 0.704, 0.680,
     %      0.657, 0.634, 0.611, 0.586, 0.564, 0.543, 0.525, 0.512, 0.496, 0.480,
     %      0.464, 0.442, 0.349, 0.337, 0.323, 0.311, 0.297, 0.287, 0.280, 0.274,
     %      0.265, 0.257, 0.249, 0.243, 0.236, 0.230, 0.222, 0.219, 0.215, 0.212,
     %      0.210, 0.210, 0.211, 0.215, 0.223, 0.231, 0.240, 0.246, 0.250, 0.251,
     %      0.250, 0.247, 0.242, 0.237, 0.232, 0.226, 0.223, 0.222, 0.229, 0.236,
     $      0.240, 0.246, 0.250, 0.254/
c
          N=61
c
          if(Tin.le.tarray(1))then
            if(ilaw.le.1)then
              flimbx=xonarr(1)
              flimby=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(1)
              flimby=y2array(1)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(1)
              flimby=ytharr(1)
              return
            endif
          endif
c
          if(Tin.ge.tarray(N))then
            if(ilaw.le.1)then
              flimbx=xonarr(N)
              flimbx=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(N)
              flimbx=y2array(N)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(N)
              flimbx=ytharr(N)
              return
            endif
          endif
c
c   Find out where Tin is located in the tabulated temperature array.
c
          call locate(tarray,N,Tin,index)
c
          if(ilaw.le.1)then
            slope=(xonarr(index)-xonarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xonarr(index)
            flimby=0.0
            return
          endif
c
          if(ilaw.eq.2)then
            slope=(xtwarr(index)-xtwarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtwarr(index)
            slope=(y2array(index)-y2array(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+y2array(index)
            return
          endif
c
          if(ilaw.ge.3)then
            slope=(xtharr(index)-xtharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtharr(index)
            slope=(ytharr(index)-ytharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+ytharr(index)
            return
          endif
c
          return
          end
c
c   ***********************
c
          subroutine flcR50(Tin,ilaw,flimbx,flimby)
c
c
c
          implicit double precision (a-h,o-z)

          dimension tarray(61),xonarr(61),xtwarr(61),
     $     xtharr(61),
     $     y2array(61),ytharr(61)
c
          data tarray/ 3500., 3750., 4000., 4250., 4500., 4750., 5000.,
     %      5250., 5500., 5750., 6000., 6250., 6500., 6750., 7000., 7250., 7500.,
     %      7750., 8000., 8250., 8500., 8750., 9000., 9250., 9500., 9750.,10000.,
     %     10500.,11000.,11500.,12000.,12500.,13000.,14000.,15000.,16000.,17000.,
     %     18000.,19000.,20000.,21000.,22000.,23000.,24000.,25000.,26000.,27000.,
     %     28000.,29000.,30000.,31000.,32000.,33000.,34000.,35000.,37500.,40000.,
     $     42500.,45000.,47500.,50000./
c
          data xonarr/ 0.553, 0.517, 0.533, 0.611, 0.668, 0.657, 0.627,
     %      0.593, 0.558, 0.527, 0.496, 0.470, 0.448, 0.432, 0.418, 0.406, 0.394,
     %      0.384, 0.378, 0.420, 0.407, 0.394, 0.383, 0.371, 0.360, 0.352, 0.345,
     %      0.332, 0.322, 0.313, 0.303, 0.294, 0.285, 0.269, 0.256, 0.245, 0.237,
     %      0.231, 0.225, 0.220, 0.216, 0.213, 0.210, 0.206, 0.203, 0.199, 0.195,
     %      0.192, 0.190, 0.187, 0.185, 0.182, 0.178, 0.174, 0.168, 0.152, 0.139,
     $      0.133, 0.130, 0.127, 0.125/
c
          data xtwarr/ 0.778, 0.756, 0.746, 0.750, 0.751, 0.744, 0.735,
     %      0.725, 0.711, 0.694, 0.676, 0.657, 0.640, 0.625, 0.613, 0.603, 0.594,
     %      0.587, 0.583, 0.599, 0.588, 0.572, 0.548, 0.535, 0.525, 0.516, 0.509,
     %      0.496, 0.484, 0.473, 0.461, 0.449, 0.437, 0.415, 0.395, 0.380, 0.368,
     %      0.358, 0.349, 0.343, 0.337, 0.334, 0.331, 0.329, 0.327, 0.324, 0.321,
     %      0.318, 0.315, 0.312, 0.309, 0.305, 0.300, 0.294, 0.288, 0.270, 0.252,
     $      0.244, 0.242, 0.240, 0.240/
c
          data y2array/ 0.336, 0.358, 0.320, 0.209, 0.124, 0.130, 0.163,
     %      0.198, 0.229, 0.251, 0.270, 0.280, 0.287, 0.290, 0.293, 0.296, 0.300,
     %      0.304, 0.307, 0.269, 0.272, 0.267, 0.247, 0.247, 0.246, 0.246, 0.246,
     %      0.246, 0.243, 0.240, 0.236, 0.232, 0.228, 0.219, 0.210, 0.202, 0.196,
     %      0.191, 0.187, 0.184, 0.182, 0.181, 0.182, 0.184, 0.186, 0.188, 0.189,
     %      0.189, 0.188, 0.188, 0.187, 0.185, 0.183, 0.181, 0.179, 0.176, 0.170,
     $      0.167, 0.168, 0.170, 0.172/
c
          data xtharr/ 0.049,-0.020, 0.053, 0.298, 0.481, 0.463, 0.383,
     %      0.295, 0.215, 0.150, 0.091, 0.050, 0.018,-0.003,-0.022,-0.038,-0.057,
     %     -0.072,-0.083, 0.017,-0.001,-0.006, 0.013, 0.000,-0.009,-0.018,-0.025,
     %     -0.036,-0.042,-0.047,-0.051,-0.054,-0.057,-0.059,-0.059,-0.057,-0.056,
     %     -0.055,-0.055,-0.055,-0.056,-0.059,-0.063,-0.069,-0.076,-0.082,-0.087,
     %     -0.091,-0.093,-0.094,-0.095,-0.096,-0.096,-0.097,-0.100,-0.112,-0.116,
     $     -0.118,-0.122,-0.128,-0.134/
c
          data ytharr/ 0.841, 0.896, 0.800, 0.522, 0.311, 0.324, 0.406,
     %      0.496, 0.572, 0.628, 0.676, 0.701, 0.718, 0.725, 0.733, 0.740, 0.751,
     %      0.761, 0.768, 0.672, 0.679, 0.667, 0.617, 0.617, 0.616, 0.616, 0.616,
     %      0.614, 0.607, 0.600, 0.591, 0.580, 0.570, 0.546, 0.524, 0.504, 0.489,
     %      0.476, 0.467, 0.459, 0.454, 0.453, 0.455, 0.459, 0.465, 0.469, 0.471,
     %      0.471, 0.471, 0.470, 0.467, 0.463, 0.457, 0.451, 0.448, 0.440, 0.424,
     $      0.418, 0.420, 0.425, 0.431/
c
          N=61
c
          if(Tin.le.tarray(1))then
            if(ilaw.le.1)then
              flimbx=xonarr(1)
              flimby=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(1)
              flimby=y2array(1)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(1)
              flimby=ytharr(1)
              return
            endif
          endif
c
          if(Tin.ge.tarray(N))then
            if(ilaw.le.1)then
              flimbx=xonarr(N)
              flimbx=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(N)
              flimbx=y2array(N)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(N)
              flimbx=ytharr(N)
              return
            endif
          endif
c
c   Find out where Tin is located in the tabulated temperature array.
c
          call locate(tarray,N,Tin,index)
c
          if(ilaw.le.1)then
            slope=(xonarr(index)-xonarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xonarr(index)
            flimby=0.0
            return
          endif
c
          if(ilaw.eq.2)then
            slope=(xtwarr(index)-xtwarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtwarr(index)
            slope=(y2array(index)-y2array(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+y2array(index)
            return
          endif
c
          if(ilaw.ge.3)then
            slope=(xtharr(index)-xtharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtharr(index)
            slope=(ytharr(index)-ytharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+ytharr(index)
            return
          endif
c
          return
          end
c
c   ***********************
c
          subroutine flcU00(Tin,ilaw,flimbx,flimby)
c
c
c
          implicit double precision (a-h,o-z)

          dimension tarray(11),xonarr(11),xtwarr(11),
     $     xtharr(11),
     $     y2array(11),ytharr(11)
c
          data tarray/ 3500., 3750., 4000., 4250., 4500., 4750., 5000.,
     $      5250., 5500., 5750., 6000./
c
          data xonarr/ 0.745, 0.934, 1.078, 1.076, 1.025, 0.973, 0.931,
     $      0.893, 0.922, 0.896, 0.884/
c
          data xtwarr/ 0.782, 0.761, 0.776, 0.795, 0.798, 0.782, 0.762,
     $      0.750, 0.737, 0.750, 0.757/
c
          data y2array/ 0.056,-0.260,-0.453,-0.421,-0.341,-0.287,-0.253,
     $     -0.215,-0.278,-0.219,-0.189/
c
          data xtharr/ 0.660, 1.324, 1.758, 1.708, 1.537, 1.404, 1.311,
     $      1.215, 1.338, 1.223, 1.168/
c
          data ytharr/ 0.141,-0.650,-1.132,-1.053,-0.853,-0.717,-0.633,
     $     -0.537,-0.694,-0.546,-0.474/
c
          N=11
c
          if(Tin.le.tarray(1))then
            if(ilaw.le.1)then
              flimbx=xonarr(1)
              flimby=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(1)
              flimby=y2array(1)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(1)
              flimby=ytharr(1)
              return
            endif
          endif
c
          if(Tin.ge.tarray(N))then
            if(ilaw.le.1)then
              flimbx=xonarr(N)
              flimbx=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(N)
              flimbx=y2array(N)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(N)
              flimbx=ytharr(N)
              return
            endif
          endif
c
c   Find out where Tin is located in the tabulated temperature array.
c
          call locate(tarray,N,Tin,index)
c
          if(ilaw.le.1)then
            slope=(xonarr(index)-xonarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xonarr(index)
            flimby=0.0
            return
          endif
c
          if(ilaw.eq.2)then
            slope=(xtwarr(index)-xtwarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtwarr(index)
            slope=(y2array(index)-y2array(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+y2array(index)
            return
          endif
c
          if(ilaw.ge.3)then
            slope=(xtharr(index)-xtharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtharr(index)
            slope=(ytharr(index)-ytharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+ytharr(index)
            return
          endif
c
          return
          end
c
c   ***********************
c
          subroutine flcU50(Tin,ilaw,flimbx,flimby)
c
c
c
          implicit double precision (a-h,o-z)

          dimension tarray(61),xonarr(61),xtwarr(61),
     $     xtharr(61),
     $     y2array(61),ytharr(61)
c
          data tarray/ 3500., 3750., 4000., 4250., 4500., 4750., 5000.,
     %      5250., 5500., 5750., 6000., 6250., 6500., 6750., 7000., 7250., 7500.,
     %      7750., 8000., 8250., 8500., 8750., 9000., 9250., 9500., 9750.,10000.,
     %     10500.,11000.,11500.,12000.,12500.,13000.,14000.,15000.,16000.,17000.,
     %     18000.,19000.,20000.,21000.,22000.,23000.,24000.,25000.,26000.,27000.,
     %     28000.,29000.,30000.,31000.,32000.,33000.,34000.,35000.,37500.,40000.,
     $     42500.,45000.,47500.,50000./
c
          data xonarr/ 0.723, 0.688, 0.760, 0.919, 1.025, 1.018, 0.985,
     %      0.945, 0.896, 0.843, 0.786, 0.732, 0.679, 0.634, 0.595, 0.562, 0.534,
     %      0.515, 0.504, 0.537, 0.515, 0.492, 0.471, 0.457, 0.447, 0.440, 0.436,
     %      0.429, 0.421, 0.413, 0.402, 0.392, 0.381, 0.362, 0.346, 0.334, 0.324,
     %      0.317, 0.311, 0.306, 0.302, 0.297, 0.293, 0.289, 0.284, 0.279, 0.274,
     %      0.269, 0.265, 0.262, 0.258, 0.253, 0.246, 0.239, 0.231, 0.208, 0.192,
     $      0.185, 0.181, 0.178, 0.175/
c
          data xtwarr/ 0.843, 0.834, 0.831, 0.821, 0.818, 0.832, 0.847,
     %      0.862, 0.872, 0.875, 0.871, 0.861, 0.845, 0.825, 0.805, 0.784, 0.763,
     %      0.744, 0.726, 0.700, 0.679, 0.655, 0.629, 0.611, 0.598, 0.590, 0.584,
     %      0.576, 0.570, 0.562, 0.553, 0.543, 0.532, 0.512, 0.494, 0.479, 0.468,
     %      0.459, 0.452, 0.446, 0.442, 0.440, 0.438, 0.436, 0.434, 0.430, 0.426,
     %      0.421, 0.417, 0.413, 0.409, 0.403, 0.396, 0.389, 0.380, 0.355, 0.334,
     $      0.325, 0.322, 0.320, 0.318/
c
          data y2array/ 0.181, 0.220, 0.107,-0.147,-0.312,-0.279,-0.207,
     %     -0.125,-0.037, 0.047, 0.128, 0.193, 0.248, 0.287, 0.316, 0.333, 0.343,
     %      0.343, 0.333, 0.245, 0.246, 0.245, 0.237, 0.231, 0.227, 0.224, 0.222,
     %      0.220, 0.222, 0.225, 0.226, 0.227, 0.226, 0.224, 0.221, 0.218, 0.215,
     %      0.212, 0.211, 0.210, 0.211, 0.213, 0.216, 0.220, 0.224, 0.227, 0.228,
     %      0.228, 0.228, 0.227, 0.227, 0.225, 0.225, 0.224, 0.224, 0.221, 0.213,
     $      0.210, 0.211, 0.213, 0.216/
c
          data xtharr/ 0.452, 0.358, 0.600, 1.139, 1.493, 1.438, 1.296,
     %      1.132, 0.952, 0.773, 0.594, 0.441, 0.307, 0.203, 0.121, 0.062, 0.019,
     %      0.000, 0.005, 0.170, 0.145, 0.125, 0.115, 0.110, 0.106, 0.105, 0.103,
     %      0.099, 0.088, 0.075, 0.063, 0.051, 0.042, 0.027, 0.014, 0.007, 0.003,
     %     -0.001,-0.005,-0.009,-0.015,-0.022,-0.031,-0.040,-0.051,-0.062,-0.069,
     %     -0.073,-0.077,-0.079,-0.082,-0.085,-0.091,-0.097,-0.106,-0.124,-0.127,
     $     -0.130,-0.136,-0.142,-0.149/
c
          data ytharr/ 0.452, 0.550, 0.266,-0.366,-0.780,-0.699,-0.518,
     %     -0.312,-0.092, 0.117, 0.319, 0.484, 0.620, 0.719, 0.789, 0.833, 0.859,
     %      0.859, 0.832, 0.611, 0.616, 0.612, 0.593, 0.578, 0.568, 0.560, 0.554,
     %      0.551, 0.556, 0.562, 0.566, 0.567, 0.565, 0.560, 0.554, 0.545, 0.537,
     %      0.531, 0.527, 0.525, 0.528, 0.533, 0.541, 0.550, 0.559, 0.568, 0.571,
     %      0.571, 0.570, 0.568, 0.567, 0.563, 0.562, 0.561, 0.561, 0.553, 0.532,
     $      0.524, 0.528, 0.533, 0.539/
c
          N=61
c
          if(Tin.le.tarray(1))then
            if(ilaw.le.1)then
              flimbx=xonarr(1)
              flimby=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(1)
              flimby=y2array(1)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(1)
              flimby=ytharr(1)
              return
            endif
          endif
c
          if(Tin.ge.tarray(N))then
            if(ilaw.le.1)then
              flimbx=xonarr(N)
              flimbx=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(N)
              flimbx=y2array(N)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(N)
              flimbx=ytharr(N)
              return
            endif
          endif
c
c   Find out where Tin is located in the tabulated temperature array.
c
          call locate(tarray,N,Tin,index)
c
          if(ilaw.le.1)then
            slope=(xonarr(index)-xonarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xonarr(index)
            flimby=0.0
            return
          endif
c
          if(ilaw.eq.2)then
            slope=(xtwarr(index)-xtwarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtwarr(index)
            slope=(y2array(index)-y2array(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+y2array(index)
            return
          endif
c
          if(ilaw.ge.3)then
            slope=(xtharr(index)-xtharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtharr(index)
            slope=(ytharr(index)-ytharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+ytharr(index)
            return
          endif
c
          return
          end
c
c   ***********************
c
          subroutine flcV50(Tin,ilaw,flimbx,flimby)
c
c
c
          implicit double precision (a-h,o-z)

          dimension tarray(61),xonarr(61),xtwarr(61),
     $     xtharr(61),
     $     y2array(61),ytharr(61)
c
          data tarray/ 3500., 3750., 4000., 4250., 4500., 4750., 5000.,
     %      5250., 5500., 5750., 6000., 6250., 6500., 6750., 7000., 7250., 7500.,
     %      7750., 8000., 8250., 8500., 8750., 9000., 9250., 9500., 9750.,10000.,
     %     10500.,11000.,11500.,12000.,12500.,13000.,14000.,15000.,16000.,17000.,
     %     18000.,19000.,20000.,21000.,22000.,23000.,24000.,25000.,26000.,27000.,
     %     28000.,29000.,30000.,31000.,32000.,33000.,34000.,35000.,37500.,40000.,
     $     42500.,45000.,47500.,50000./
c
          data xonarr/ 0.582, 0.549, 0.586, 0.694, 0.767, 0.759, 0.726,
     %      0.686, 0.646, 0.610, 0.575, 0.547, 0.523, 0.506, 0.491, 0.479, 0.468,
     %      0.457, 0.450, 0.488, 0.474, 0.464, 0.465, 0.448, 0.433, 0.421, 0.411,
     %      0.393, 0.379, 0.366, 0.354, 0.343, 0.333, 0.314, 0.300, 0.288, 0.279,
     %      0.271, 0.265, 0.259, 0.254, 0.250, 0.245, 0.241, 0.236, 0.231, 0.226,
     %      0.222, 0.219, 0.216, 0.212, 0.208, 0.204, 0.198, 0.191, 0.172, 0.158,
     $      0.151, 0.148, 0.145, 0.142/
c
          data xtwarr/ 0.824, 0.790, 0.778, 0.786, 0.793, 0.795, 0.794,
     %      0.789, 0.779, 0.764, 0.747, 0.730, 0.712, 0.698, 0.687, 0.679, 0.672,
     %      0.668, 0.666, 0.696, 0.686, 0.671, 0.647, 0.634, 0.622, 0.612, 0.603,
     %      0.586, 0.571, 0.556, 0.542, 0.527, 0.514, 0.488, 0.466, 0.448, 0.433,
     %      0.421, 0.411, 0.403, 0.396, 0.390, 0.386, 0.382, 0.377, 0.372, 0.368,
     %      0.363, 0.359, 0.355, 0.351, 0.347, 0.340, 0.333, 0.326, 0.304, 0.283,
     $      0.274, 0.271, 0.269, 0.268/
c
          data y2array/ 0.362, 0.361, 0.289, 0.139, 0.038, 0.053, 0.102,
     %      0.154, 0.199, 0.232, 0.259, 0.274, 0.284, 0.289, 0.294, 0.299, 0.306,
     %      0.315, 0.324, 0.312, 0.319, 0.311, 0.274, 0.279, 0.283, 0.286, 0.288,
     %      0.290, 0.288, 0.285, 0.281, 0.276, 0.271, 0.260, 0.249, 0.239, 0.232,
     %      0.225, 0.220, 0.216, 0.213, 0.211, 0.211, 0.211, 0.212, 0.212, 0.212,
     %      0.211, 0.210, 0.209, 0.209, 0.207, 0.205, 0.203, 0.203, 0.198, 0.189,
     $      0.185, 0.185, 0.186, 0.189/
c
          data xtharr/ 0.039, 0.006, 0.153, 0.485, 0.710, 0.679, 0.573,
     %      0.455, 0.348, 0.262, 0.187, 0.135, 0.097, 0.072, 0.050, 0.031, 0.008,
     %     -0.015,-0.037, 0.020,-0.005,-0.002, 0.054, 0.029, 0.009,-0.008,-0.021,
     %     -0.042,-0.053,-0.062,-0.067,-0.071,-0.074,-0.075,-0.074,-0.071,-0.069,
     %     -0.067,-0.065,-0.065,-0.065,-0.067,-0.071,-0.076,-0.081,-0.087,-0.092,
     %     -0.094,-0.097,-0.098,-0.100,-0.103,-0.104,-0.107,-0.114,-0.125,-0.125,
     $     -0.126,-0.130,-0.135,-0.142/
c
          data ytharr/ 0.906, 0.904, 0.721, 0.347, 0.095, 0.134, 0.255,
     %      0.386, 0.496, 0.580, 0.647, 0.685, 0.710, 0.722, 0.735, 0.748, 0.766,
     %      0.788, 0.811, 0.780, 0.798, 0.777, 0.684, 0.697, 0.707, 0.715, 0.719,
     %      0.724, 0.720, 0.713, 0.703, 0.691, 0.678, 0.650, 0.622, 0.599, 0.579,
     %      0.563, 0.550, 0.540, 0.532, 0.528, 0.527, 0.527, 0.529, 0.530, 0.530,
     %      0.527, 0.526, 0.523, 0.521, 0.518, 0.512, 0.508, 0.508, 0.495, 0.472,
     $      0.462, 0.463, 0.466, 0.473/
c
          N=61
c
          if(Tin.le.tarray(1))then
            if(ilaw.le.1)then
              flimbx=xonarr(1)
              flimby=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(1)
              flimby=y2array(1)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(1)
              flimby=ytharr(1)
              return
            endif
          endif
c
          if(Tin.ge.tarray(N))then
            if(ilaw.le.1)then
              flimbx=xonarr(N)
              flimbx=0.0
              return
            endif
            if(ilaw.eq.2)then
              flimbx=xtwarr(N)
              flimbx=y2array(N)
              return
            endif
            if(ilaw.ge.3)then
              flimbx=xtharr(N)
              flimbx=ytharr(N)
              return
            endif
          endif
c
c   Find out where Tin is located in the tabulated temperature array.
c
          call locate(tarray,N,Tin,index)
c
          if(ilaw.le.1)then
            slope=(xonarr(index)-xonarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xonarr(index)
            flimby=0.0
            return
          endif
c
          if(ilaw.eq.2)then
            slope=(xtwarr(index)-xtwarr(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtwarr(index)
            slope=(y2array(index)-y2array(index+1))/(tarray(index)
     $                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+y2array(index)
            return
          endif
c
          if(ilaw.ge.3)then
            slope=(xtharr(index)-xtharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimbx=slope*(Tin-tarray(index))+xtharr(index)
            slope=(ytharr(index)-ytharr(index+1))/(tarray(index)
     #                                           -tarray(index+1))
            flimby=slope*(Tin-tarray(index))+ytharr(index)
            return
          endif
c
          return
          end
c
c   ***********************
c


module declare

   implicit none

   integer(kind=8)::count_rate,cr,timestart,time0,timerun
   real(kind=8)::rate

   integer(kind=8)::nstep,jstep,jskip

   integer jobid,fanum,falen,myonum,mybodylen,nmemb,nfa,nbondfa,nmyo,nbondmyo,maxfalen
   integer nf,nb,jx,ja,ja1,ja2,jf,n,length,jdir,nm,jm,n1,n2,nstart,jfile,junit,junit1,junit2
   integer j,nl,jl,nltem,fanummax,nwalrad,nwalrep,nwalsurf,nwalsurf_p,nwalsurf_x,nlayer
   integer nrand,jrand,jreset,neinum,neinum5,ntotal,nbinds,nframe,jforce1,jforce2,jforce3
   integer jprint,nrforce,jrforce,crlknum1,crlknum2,crlknum,nlk,lklen,nbondlk,nnode,nabound,ntether,ntethertem
   integer days,hours,mins,secs,nthreads,jf1,jf2,j1,j2
   integer npair5_myac,npair5_lkac,npair5_mylk,npair5_ac2,npair5_my2,npair5_lk2,npair5_mb2
   integer npair_myac,npair_lkac,npair_mylk,npair_ac2,npair_my2,npair_lk2
   integer npair_acmb,npair_mymb,npair_lkmb,npair_mb2,nnei
   integer nhoop,nwall,nw,jp,nmeho,nbondwal,jm0,npick,nphi
   integer nxsol,nphisol,jh,jupdate,tension1,tension2,crlkorient,j_dep,cofilin,jmyoturn,jxldel,jxlturnover
   integer natom,natom_a1,natom_a2,natom_a2m,nact1,nact2,nfamax1,nfamax2,fanummax1,fanummax2
   integer jstart,nfahalf,nfafull,astart0,nfa1,nfa2,fanum1,fanum2,jbreak,nact,nmono
   integer natp,jsignal,crlknummax,crlknumactive,nturnover,nmyoturn

   integer,allocatable,dimension(:)::astart,alen,adir,mydir,filid,a2mem,mbhooplen,waltyp,boundtyp
   integer,allocatable,dimension(:,:)::bondfa,bondmyo,mybody,myhead,mytyp,bondwal,mbhoop
   integer,allocatable,dimension(:,:)::fa2myo,fa2lk,bondlk,apar,wposid
   integer,allocatable,dimension(:,:,:)::mynei,lknei,mynei5,lknei5
   integer,allocatable,dimension(:,:)::pair5_myac,pair5_lkac,pair5_mylk,pair5_ac2
   integer,allocatable,dimension(:,:)::pair5_my2,pair5_lk2,pair5_mb2
   integer,allocatable,dimension(:,:)::pair_myac,pair_lkac,pair_mylk,pair_ac2,pair_my2,pair_lk2
   integer,allocatable,dimension(:,:)::pair_acmb,pair_mymb,pair_lkmb,pair_mb2,pairpart
   integer,allocatable,dimension(:,:)::jfasol,jmysol,jlksol,jmbsol,jsursol,nsurf
   integer,allocatable,dimension(:)::fadist,mydist,lkdist,fa1stbound,apos,lktyp,lkstart,mark
!   integer,allocatable,dimension(:)::fa1stboundtem,alentem,astarttem

   double precision walrad,mbrad,rrad,rwid,rthick,mbrad2,invmbrad,mwid,kwall,lsqueez,wallbead
   double precision l_lk1,l_lk2,l_lk,k_lk,klk_thet,thet_lk,phi_node_size,l_mem,k_mem,k_orient,kblock
   double precision pi,k_a,l_a,invl_a,ka_thet,thet_fa,kmh_thet,kmb_thet,thet_mh1,thet_mh2,thet_mb,l_mh,l_mb
   double precision xh,yh,zh,xgap,prob,xboundmin,xboundmax,xrmin,xrmax,shift
   double precision ltether,ktether,pres,fmemb,fturgor,df,mbradnew,p_tether
   double precision rvdw,kvdw,r_on,r_off,r_on2,r_off2,fvdwmax,krad
   double precision kpair,l_pair,rpair,thetpair,thet2by2,cos_t_2,kmemb!_thet,thet_memb
   double precision rvdw_mb,r_on_mb,r_off_mb,r_on2_mb,r_off2_mb,fvdwmax_mb
   double precision dphi,x0,y0,z0,xdel,r,phi0,phi,thick,rad,dx,dy,dz,dytem,dztem,dist
   double precision dx1,dy1,dz1,dx2,dy2,dz2,dx3,dy3,dz3,dx4,dy4,dz4
   double precision sinp,cosp,rxy,rxz,ryy,ryz,rzy,rzz
   double precision xmin,xmax,wthick,d2,dist2,fmax2,runtime,oldtime,printtime,dt,gap
   double precision dxsol,dphisol,wallrate,ringthick,aconc1,aconc2,lkconc,invmylen2

   double precision kbind,lbind,p1_hydr,p1_hydr0,p2_bind,p3_pi_rele,p4_adp_rele,p5_ubind,p_dep
   double precision delta,invdelta,beta,gam,fmaxfa2,fmaxmyo2,fmaxlk2,plk_bind,fmaxmb2
   double precision plk_ubind1,plk_ubind2,plk_off,k_scale,k_scale_lk,plk_remove,pmyturn,plk_turn

   double precision halftime

   real,allocatable,dimension(:)::xwalsurf,ywalsurf,zwalsurf
   real,allocatable,dimension(:)::xwalrad,ywalrad,zwalrad,xwalrep,ywalrep,zwalrep

   double precision,allocatable,dimension(:)::xfa,yfa,zfa,xmyo,ymyo,zmyo
   double precision,allocatable,dimension(:)::rwhoop,xwhoop
   double precision,allocatable,dimension(:)::xmemb,ymemb,zmemb
   double precision,allocatable,dimension(:,:)::xwall,ywall,zwall,rwall,rmemb,rmembmax
   double precision,allocatable,dimension(:)::xlk,ylk,zlk
   double precision,allocatable,dimension(:)::fxfa,fyfa,fzfa,fxfarep,fyfarep,fzfarep
   double precision,allocatable,dimension(:)::fxanglfa,fyanglfa,fzanglfa
   double precision,allocatable,dimension(:)::fxmyo,fymyo,fzmyo
   double precision,allocatable,dimension(:)::fxmyorep,fymyorep,fzmyorep
   double precision,allocatable,dimension(:)::fxanglmyo,fyanglmyo,fzanglmyo
   double precision,allocatable,dimension(:)::fxlk,fylk,fzlk,fxlkrep,fylkrep,fzlkrep
   double precision,allocatable,dimension(:)::fxangllk,fyangllk,fzangllk
   double precision,allocatable,dimension(:)::rands,phi_node
   double precision,allocatable,dimension(:,:)::rxfa,ryfa,rzfa,rxmyo,rymyo,rzmyo,rxlk,rylk,rzlk
   double precision,allocatable,dimension(:,:)::rxmemb,rymemb,rzmemb
!   double precision,allocatable,dimension(:)::fymemfa,fzmemfa,fymemmyo,fzmemmyo,fymemlk,fzmemlk
   double precision,allocatable,dimension(:)::fxmemb,fymemb,fzmemb
!   double precision,allocatable,dimension(:)::fxoll_vdw,fyoll_vdw,fzoll_vdw
!   double precision,allocatable,dimension(:)::fxill_vdw,fyill_vdw,fzill_vdw
   double precision,allocatable,dimension(:)::fxmemb_vdw,fymemb_vdw,fzmemb_vdw

   double precision,allocatable,dimension(:)::fxfa_vdw,fyfa_vdw,fzfa_vdw
   double precision,allocatable,dimension(:)::fxmyo_vdw,fymyo_vdw,fzmyo_vdw
   double precision,allocatable,dimension(:)::fxlk_vdw,fylk_vdw,fzlk_vdw
   double precision,allocatable,dimension(:)::fxmemb_cst,fymemb_cst,fzmemb_cst
   double precision,allocatable,dimension(:)::fxfa_cst,fyfa_cst,fzfa_cst
   double precision,allocatable,dimension(:)::fxmyo_cst,fymyo_cst,fzmyo_cst
   double precision,allocatable,dimension(:)::fxlk_cst,fylk_cst,fzlk_cst
   double precision,allocatable,dimension(:,:)::rmbsol,rwlsol

   double precision,allocatable,dimension(:,:)::xnorwall,ynorwall,znorwall,xnorsurf,ynorsurf,znorsurf
   double precision,allocatable,dimension(:,:)::xsurf,ysurf,zsurf
   real fa1,fa2,fa3,fa4,fa5

   character(len=91)::a91

   real timecheck,myorate

end module