c main program to run tero.f subprograms
      implicit none
      integer idime,nasymp,nfreq,in,itur
      integer nt,i,j
      parameter(idime=52)
      double precision temp,scatt,sigmat,accur,gap,d(idime),tc,tur
      double precision gap0,sigmaa
      double precision alphp,beta,betb,grad,grap
      double precision gapsb,gapsa,sgapa,sgapb,srholl,srhopd,srhob
      double precision tempt(10),suppr(10),x(idime)
      data nt/7/(tempt(i),i=1,7)/1.0,0.9,0.8,0.7,0.5,0.2,0.01/
      data scatt/0.1/sigmat,temp/0.5,0.7/accur,nasymp/0.0001,2/
100   write(6,1)temp,scatt,sigmat
1     format(' compute[1] temp[-4]=',f8.6,' scatt[-3]=',f8.6,
     x' sigmat[-11]=',f8.6)
      write(6,2)accur,nasymp
2     format(' accur[-8]=',f10.8,' nasymp[-19]=',i2,' scatt(tc)[2]',
     x' gltable[3] end[-99]')
      write(6,*)'table s(temp) for gap [4]'
      write(6,*)'table s(sigmat,phase) for gap[5], for rho[6]'
      write(6,*)'table gap^2(temp) [7]'
      read(5,*)in
      if(in.eq.1)then
        call gapimp(temp,scatt,sigmat,accur,nasymp,gap,d,nfreq,tc)
        call gapimp(temp/tc,0.d0,sigmat,accur,nasymp,gap0,d,itur,tur)
        write(6,3)(gap/gap0)**2,temp/tc
3       format(' (gap/gap0)^2=',f8.6,' temp/tc=',f8.6)
        call hsmgl(scatt,sigmat,tc,alphp,beta,betb,grad,grap,
     x  gapsa,gapsb,sgapa,sgapb,srholl,srhopd,srhob)
        write(6,*)'scatt     tc    alphp     beta',
     x  '     betb     grad     grap'
        write(6,4)scatt,tc,alphp,beta,betb,grad,grap
      else if(in.eq.-4)then
        write(6,*)' temp? (relative to tc if negative)'
        read(5,*)temp
        if(temp.lt.0)temp=-temp*tc
      else if(in.eq.-3)then
        read(5,*)scatt
      else if(in.eq.-11)then
        read(5,*)sigmat
      else if(in.eq.-8)then
        read(5,*)accur
      else if(in.eq.-19)then
        read(5,*)nasymp
      else if(in.eq.2)then
        write(6,*)'tc?'
        read(5,*)tc
        call scattf(tc,scatt)
      else if(in.eq.3)then
        write(6,*)'scatt     tc    alphp     beta',
     x  '     betb     grad     grap'
        do 200 j=0,11
          scatt=0.025*float(j)
          call hsmgl(scatt,sigmat,tc,alphp,beta,betb,grad,grap,
     x    gapsa,gapsb,sgapa,sgapb,srholl,srhopd,srhob)
          write(6,4)scatt,tc,alphp,beta,betb,grad,grap
4         format(f4.3,8f9.6)
200     continue
      else if(in.eq.4)then
        write(6,*)'scatt  tc**2  B suppression factors at t='
        write(6,5)(tempt(i),i=1,nt)
5       format('scatt  tc**2',7f9.6)
        do 420 j=0,11
          scatt=0.025*float(j)
          call hsmgl(scatt,sigmat,tc,alphp,beta,betb,grad,grap,
     x    gapsa,gapsb,sgapa,sgapb,srholl,srhopd,srhob)
          suppr(1)=sgapb
          do 410 i=2,nt
            call gap_b(10,tempt(i)*tc,gap,x,scatt,sigmat)
            call bcsgap(tempt(i),gap0)
            suppr(i)=(gap/gap0)**2
410       continue
          write(6,4)scatt,tc**2,(suppr(i),i=1,nt)
420     continue
      else if(in.eq.5)then
        write(6,*)'scatt  tc**2    aborn     amed',
     x  '    aunit    bborn     bmed    bunit'
        do 520 j=0,11
          scatt=0.025*float(j)
          do 510 i=0,2
            sigmaa=0.5*float(i) 
            call hsmgl(scatt,sigmaa,tc,alphp,beta,betb,grad,grap,
     x      gapsa,gapsb,sgapa,sgapb,srholl,srhopd,srhob)
            suppr(1+i)=sgapa
            suppr(4+i)=sgapb
510       continue
          write(6,4)scatt,tc**2,(suppr(i),i=1,6)
520     continue
      else if(in.eq.6)then
        write(6,*)'scatt  tc**2    aborn     amed',
     x  '    aunit    bborn     bmed    bunit'
        do 620 j=0,11
          scatt=0.025*float(j)
          do 610 i=0,2
            sigmaa=0.5*float(i) 
            call hsmgl(scatt,sigmaa,tc,alphp,beta,betb,grad,grap,
     x      gapsa,gapsb,sgapa,sgapb,srholl,srhopd,srhob)
            suppr(1+i)=(srholl+2.*srhopd)/3.
            suppr(4+i)=srhob
610       continue
          write(6,4)scatt,tc**2,(suppr(i),i=1,6)
620     continue
      else if(in.eq.7)then
        call tcimp(scatt,tc)
        do 700 i=0,20
          temp=0.05*i*tc
          call gap_b(10,temp,gap,x,scatt,sigmat)
          write(6,4)temp,gap**2
700     continue
      else if(in.eq.-99)then
        stop
      end if
      goto 100
      end