*ident up51
*/ Oct. 2015
*/ ----------------------------------------------
*/ changes to thermr and aceth necessary to process
*/ CAB Model TSL files
*/ ----------------------------------------------
*d thermr.31
   integer,parameter::nwscr=200000
*d thermr.1510
   integer,parameter::nlmax=65
*d thermr.1516
   real(kr)::ubar(118)
*d thermr.1517
    real(kr)::u2,u2last,u3,u3last,p2(118),p3(118),p(4)
*d thermr.1521
   integer,parameter::ngrid=118
*d thermr.1522
   real(kr),dimension(118),parameter::egrid=(/&
*d thermr.1542
     7.00e0_kr,7.65e0_kr,8.40e0_kr,9.15e0_kr,9.85e0_kr,10.00e0_kr/)
*/ ---
*d thermr.1874
   enow=sigfig(enow,8,0)
*d thermr.1907
         ep=sigfig(enow,8,-1)
*d thermr.1909
         ep=sigfig(ep,8,0)
*d thermr.1918
         ep=sigfig(enow,8,+1)
*d thermr.1921
         ep=sigfig(ep,8,0)
*d thermr.1928
   ep=sigfig(ep,8,0)
*d thermr.1947
   xm=sigfig(xm,8,0)
*d thermr.1996
      scr(1+jscr)=sigfig(y(1,i),9,0)
*d thermr.1998
      scr(1+jscr)=sigfig(y(1,i),8,0)
*/ ---
*d thermr.2001
      scr(il+jscr)=sigfig(y(il,i),9,0)
         if (scr(il+jscr).gt.1.0e0_kr) then 
           write(nsyso,'(/'' ***warning***'',''cosine '', f12.8,&
                          &'' set to 1.0'')') scr(il+jscr)
           scr(il+jscr)=1.0e0_kr
         endif  
         if (scr(il+jscr).lt.-1.0e0_kr) then
           write(nsyso,'(/'' ***warning***'',''cosine '', f12.8,&
                          &'' set to -1.0'')') scr(il+jscr)
           scr(il+jscr)=-1.0e0_kr
         endif  
*/ ---
*d thermr.2047
   xsi(ie)=sigfig(xsi(ie),9,0)
*d thermr.2051
      scr(1+jscr)=sigfig(y(1,i),9,0)
*d thermr.2053
      scr(1+jscr)=sigfig(y(1,i),8,0)
*/ ---
*d thermr.2056
      scr(il+jscr)=sigfig(y(il,i),9,0)
         if (scr(il+jscr).gt.1.0e0_kr) then 
           write(nsyso,'(/'' ***warning***'',''cosine '', f12.8,&
                       &'' set to 1.0'')') scr(il+jscr)
           scr(il+jscr)=1.0e0_kr
         endif  
         if (scr(il+jscr).lt.-1.0e0_kr) then
           write(nsyso,'(/'' ***warning***'',''cosine '', f12.8,&
                       &'' set to -1.0'')') scr(il+jscr)
           scr(il+jscr)=-1.0e0_kr
         endif  
*/ ---
*d thermr.2149
   enow=sigfig(enow,8,0)
*d thermr.2170
   xm=sigfig(xm,7,0)
*d thermr.2559
   x(2)=sigfig(x(2),8,0)
*d thermr.2570
   xm=sigfig(xm,8,0)
*d thermr.2619
   x(2)=sigfig(x(2),8,0)
*d thermr.2630
   xm=sigfig(xm,8,0)
*d thermr.2775
      x(1)=sigfig(x(1),8,0)
*d thermr.2776
      if (x(1).eq.e) x(1)=sigfig(e,8,-1)
*d thermr.2791
   x(1)=sigfig(x(1),8,0)
*d thermr.2800
   xm=sigfig(xm,8,0)
*d thermr.2865
   integer,parameter::nwscr=200000
*/ ---
*d aceth.26
   integer,parameter::nxss=8000000
*/ --- 
*d aceth.81
   ninmax=200000
*d aceth.96
   nwscr=200000
*/ --- do k=1,nang ------
*d aceth.440
    if (abs(xn-xhi).lt.eps) then
*d aceth.441
      six(k+loc)=scr(k+isn)
    else if (abs(xn-xlo).lt.eps) then 
       six(k+loc)=scr(k+isl)
    else 
       six(k+loc)=scr(k+isl)+&
       (scr(k+isn)-scr(k+isl))*(xn-xlo)/(xhi-xlo)
    endif
    if ((six(k+loc).lt.-1.0e0_kr).or.(six(k+loc).gt.1.0e0_kr)) then  
    write(nsyso,'(/'' ---warning from acesix---'',''cosine '',f12.8,& 
                   &'' outside [-1,1] range for e='',e12.4,&
                   &'', bin mu='',i4)') six(k+loc),e,k
    endif
       if(iwt == 2 .and. six(k+loc).lt.-1.0e0_kr) then 
       six(k+loc) = -1.0e0_kr
       write(nsyso,'(/'' ---fixed---'')')
       endif
     if(iwt == 2 .and. six(k+loc).gt.1.0e0_kr)  then
     six(k+loc) = 1.0e0_kr
     write(nsyso,'(/'' ---fixed---'')')
     endif
*/ ---               
*d aceth.631
   nwscr=200000
*/ ---
*d aceth.967
   use mainio ! provides nsyso
   use util ! provides openz
*d aceth.1222
            do k=1,nang
   if ((xss(loc+3+k).lt.-1.0e0_kr).or.(xss(loc+3+k).gt.1.0e0_kr)) then
     write(nsyso,'(/'' ---warning from tplots---'', &       
           &''cosine '',f12.8,'' outside [-1,1] range'')') xss(loc+3+k)
   endif                      
*/ ---