      use dflib
      implicit real*8 (a-h,o-z)
      integer*2 narg
      character*80 buf
      character*40 fnout
      narg=1
      call getarg(narg,buf)
      read(buf,*) iwla1
      narg=2
      call getarg(narg,buf)
      read(buf,*) iwla2
      narg=3
      call getarg(narg,buf)
      read(buf,*) hgauss
      narg=4
      call getarg(narg,buf)
      read(buf,'(a)') fnout

      call setkgf(iwla1,iwla2,hgauss,fnout)
      stop
      end
      
      subroutine setkgf(iwla1,iwla2,hgauss,fnout)
      use dfport
      implicit real*8 (a-h,o-z)
      PARAMETER (MC=100)                                           
      DIMENSION DMGSP(MC),AISP(MC),DMGSM(MC),AISM(MC),DMGPI(MC),AIPI(MC)        
      DIMENSION DIFLA3(MC*3),RFA3(MC*3)
      character*133 line
      character*10 label,labelp
      character*5 axj,axjp
      character fnout*40,linedir*80
      character*9 gfname(190)
      character*9 gflab1(50),gflab2(50),gflab3(50),gflab4(40)
c
      logical locx,logx,loex,lowx
      character*1 chrem
c
      dimension wlimit(0:190),wsave(99999)
      data gflab1/
     a'GF0010.10','GF0020.10','GF0030.10','GF0040.10','GF0050.10',
     1'GF0060.10','GF0070.10','GF0080.10','GF0090.10','GF0100.10',
     2'GF0110.10','GF0120.10','GF0130.10','GF0140.10','GF0150.10',
     3'GF0160.10','GF0170.10','GF0180.10','GF0190.10','GF0200.10',
     4'GF0210.10','GF0220.10','GF0230.10','GF0240.10','GF0250.10',
     5'GF0260.10','GF0270.10','GF0280.10','GF0290.10','GF0300.10',
     6'GF0310.10','GF0320.10','GF0330.10','GF0340.10','GF0350.10',
     7'GF0360.10','GF0370.10','GF0380.10','GF0390.10','GF0400.10',
     8'GF0410.10','GF0420.10','GF0430.10','GF0440.10','GF0450.10',
     9'GF0460.10','GF0470.10','GF0480.10','GF0490.10','GF0500.10'/
      data gflab2/
     a'GF0510.10','GF0520.10','GF0530.10','GF0540.10','GF0550.10',
     1'GF0560.10','GF0570.10','GF0580.10','GF0590.10','GF0600.10',
     2'GF0610.10','GF0620.10','GF0630.10','GF0640.10','GF0650.10',
     3'GF0660.10','GF0670.10','GF0680.10','GF0690.10','GF0700.10',
     4'GF0710.10','GF0720.10','GF0730.10','GF0740.10','GF0750.10',
     5'GF0760.10','GF0770.10','GF0780.10','GF0790.10','GF0800.10',
     6'GF0810.10','GF0820.10','GF0830.10','GF0840.10','GF0850.10',
     7'GF0860.10','GF0870.10','GF0880.10','GF0890.10','GF0900.10',
     8'GF0910.10','GF0920.10','GF0930.10','GF0940.10','GF0950.10',
     9'GF0960.10','GF0970.10','GF0980.10','GF0990.10','GF1000.10'/
      data gflab3/
     a'GF1100.10','GF1200.10','GF1300.10','GF1400.10','GF1500.10',
     1'GF1600.10','GF1700.10','GF1800.10','GF1900.10','GF2000.10',
     2'GF2100.10','GF2200.10','GF2300.10','GF2400.10','GF2500.10',
     3'GF2600.10','GF2700.10','GF2800.10','GF2900.10','GF3000.10',
     4'GF3100.10','GF3200.10','GF3300.10','GF3400.10','GF3500.10',
     5'GF3600.10','GF3700.10','GF3800.10','GF3900.10','GF4000.10',
     6'GF4100.10','GF4200.10','GF4300.10','GF4400.10','GF4500.10',
     7'GF4600.10','GF4700.10','GF4800.10','GF4900.10','GF5000.10',
     8'GF5100.10','GF5200.10','GF5300.10','GF5400.10','GF5500.10',
     9'GF5600.10','GF5700.10','GF5800.10','GF5900.10','GF6000.10'/
      data gflab4/
     a'GF6100.10','GF6200.10','GF6300.10','GF6400.10','GF6500.10',
     1'GF6600.10','GF6700.10','GF6800.10','GF6900.10','GF7000.10',
     2'GF7100.10','GF7200.10','GF7300.10','GF7400.10','GF7500.10',
     3'GF7600.10','GF7700.10','GF7800.10','GF7900.10','GF8000.10',
     4'GF8100.10','GF8200.10','GF8300.10','GF8400.10','GF8500.10',
     5'GF8600.10','GF8700.10','GF8800.10','GF8900.10','GF9000.10',
     6'GF9100.10','GF9200.10','GF9300.10','GF9400.10','GF9500.10',
     7'GF9600.10','GF9700.10','GF9800.10','GF9900.10','GFEND.10 '/
      equivalence (gfname(001),gflab1(1))
      equivalence (gfname(051),gflab2(1))
      equivalence (gfname(101),gflab3(1))
      equivalence (gfname(151),gflab4(1))
      character*1 sql,lql,squ,lqu
      character*1 term1(4),term2(4)
      character*10 labl,labu
      character*18 labres
      wla1=iwla1
      wla2=iwla2
      hkg=hgauss/1000.
      write(*,*) 'h(kG)=',hkg
      call retenv("KGF_DIR",linedir)
      call lablen(linedir,80,nsdir,nedir)
      wlimit(0)=0.
      do i=1,189
      read(gfname(i),'(2x,f5.0,2x)') wlimit(i)
      end do
      wlimit(190)=1.d99
      open (unit=40,file=fnout)
      call lablen(fnout,40,ns1,ne1)
      open (unit=41,file=fnout(ns1:ne1)//'.log')
      wln1=wla1/10.
      wln2=wla2/10.
      do 11 k=1,190
      if(wln1.ge.wlimit(k-1).and.wln1.le.wlimit(k)) go to 12
   11 continue
      write(*,*) '!! wla1=',wla1
      stop
   12 ks=k
      do 21 k=190,1,-1
      if(wln2.ge.wlimit(k-1).and.wln2.le.wlimit(k)) go to 22
   21 continue
      write(*,*) '!! wla2=',wla2
      stop
   22 ke=k
      write(*,*) 'ks,ke=',ks,ke
      write(*,*) linedir(nsdir:nedir)//'\'//gfname(k)
      do 100 k=ks,ke
      open (unit=38,file=linedir(nsdir:nedir)//'\'//gfname(k),
     & form='formatted')
      iline=0
      do 9 i=1,1000000
      read(38,'(a)',err=90,end=90) line
      call lablen(line,133,nsln,neln)
      if(ifnum(line(nsln:nsln)).eq.0) go to 9
      read(line,2,end=90)wl,gflog,code,e,axj,label,ep,axjp,labelp,
     & gammar,gammas,gammaw
    2 format(f11.4,f7.3,f6.2,f12.3,a5,1x,a10,f12.3,a5,1X,a10,3f6.2)
      if(wl.lt.wln1.or.wl.gt.wln2) go to 9
      ek=e
      if(ep.lt.e) ek=ep
      expot=1.23981e-4*ek
      wla=wl*10.
c
      locx=abs(code-codepre).le.0.001
      lowx=abs(wl-wlpre)*10..le.0.001
      loex=abs(expot-expotpre).le.0.001
      logx=abs(gflog-gflogpre).le.0.001
      if(locx.and.lowx.and.loex.and.logx) then
        chrem='*'
        write(*,223) '!!!! caution !!!',iline,code,wl*10.,expot,gflog
  223   format(1h ,a16,i4,':',f9.2,f11.3,f8.3,f8.3)
      else
        chrem=' '
      end if
      codepre=code
      wlpre=wl
      expotpre=expot
      gflogpre=gflog
c
      iline=iline+1
      wsave(iline)=wla

      do m=10,1,-1
      if(label(m:m).ne.' ') go to 231
      end do
  231 ncl=m
      sql=label(ncl-1:ncl-1)
      lql=label(ncl:ncl)
      do m=10,1,-1
      if(labelp(m:m).ne.' ') go to 232
      end do
  232 ncu=m
      squ=labelp(ncu-1:ncu-1)
      lqu=labelp(ncu:ncu)
      term1(1)=sql
      term1(2)=lql
      term1(3)=axj(3:3)
      term1(4)=axj(5:5)
      term2(1)=squ
      term2(2)=lqu
      term2(3)=axjp(3:3)
      term2(4)=axjp(5:5)
c      write(*,*) term1,term2
      ifskip=0
      if((trans(sql).lt.0.).or.(tchar(lql).lt.0.)
     %.or.(trans(squ).lt.0.).or.(tchar(lqu).lt.0.)) ifskip=1
      if(ifskip.eq.0) labres='successfully done!'
      if(ifskip.eq.1) labres='Term unidentified!'
      write(41,221) code,wla,expot,gflog,gammar,gammas,gammaw,
     &iline,chrem,(term1(l),l=1,4),(term2(l),l=1,4), labres
  221 format(f9.2,f11.3,f8.3,f8.3,3f7.2,1x,i5,1x,a1,2x,4a1,1x,4a1,a18)
      if(ifskip.eq.1) then
      write(*,1221) code,wla,expot,gflog,gammar,gammas,gammaw,
     &iline,chrem,(term1(l),l=1,4),(term2(l),l=1,4)
 1221 format('skipped! ', f8.2,f10.3,f7.3,f7.3,3f7.2,1x,i4,1x,a1,1x,
     &4a1,1x,4a1)
      go to 9
      end if
C
      CALL ZEEMAN(TERM1,TERM2,NSP,DMGSP,AISP,NSM,DMGSM,AISM,              
     % NPI,DMGPI,AIPI)                                                          
C     THE CASE OF MT
      DLH=4.67E-13*WLA**2*(HKG*1000.)                                           
      IT=0                                                                      
      DO 720 M=1,NSM                                                            
      IT=IT+1                                                                   
      RFA3(IT)=AISM(M)/3.                                                       
  720 DIFLA3(IT)=DLH*DMGSM(M)                                                   
      DO 721 M=1,NSP                                                            
      IT=IT+1                                                                   
      RFA3(IT)=AISP(M)/3.                                                       
  721 DIFLA3(IT)=DLH*DMGSP(M)                                                   
      DO 722 M=1,NPI                                                            
      IT=IT+1                                                                   
      RFA3(IT)=AIPI(M)/3.                                                       
  722 DIFLA3(IT)=DLH*DMGPI(M)                                                   
      NZ3=IT                                                                    
c      WRITE(6,743) NZ3                                                          
c  743 FORMAT(1H ,'CASE OF MT : RESOLVED INTO ',I3,' COMPONENTS')                
c      sumrfa=0
c      DO 1853 KZ=1,NZ3
c      sumrfa=sumrfa+rfa3(kz)                                                          
c 1853 WRITE(6,1863) KZ,DIFLA3(KZ),RFA3(KZ)                                      
c 1863 FORMAT(1H ,'NZ3 DATA:',2X,'KZ=',I3,3X,'DIFLA3=',0PF6.3,2X,                
c     #'RFA3=',1PE10.3)
c      write(*,*) 'sumrfa=',sumrfa
      do it=1,nz3
      wlat=wla+difla3(it)
      gflogt=gflog+log10(max(1.d-30,rfa3(it))) 
      write(40,220) code,wlat,expot,gflogt,gammar,gammas,gammaw,
     &iline,chrem,(term1(l),l=1,4),(term2(l),l=1,4),nz3,it,
     &wla,difla3(it),gflog,log10(max(1.d-30,rfa3(it))),rfa3(it)
  220 format(f9.2,f11.3,f8.3,f8.3,3f7.2,1x,i5,1x,a1,2x,4a1,1x,4a1,
     &i3,1x,i3,1x,2f10.3,2f8.3,f9.5)
      end do
    9 continue
   90 close(38)
      if(iline.le.0) go to 100
      write(*,'(''data output to file:'',a40)') fnout
      write(*,30) k,gfname(k),wsave(1),wsave(iline),iline
   30 format(1h ,'file no.',i3,1x,'fname:',a9,1x,
     % 'from ',f11.3,' to ',f11.3,' A',2x,'(',i6,' lines)')
  100 continue
  999 continue
      close(40)
      close(41)
 9999 return
      end
      subroutine lablen(label,nlen,ns,ne)
      implicit real*8 (a-h,o-z)
      character*(*) label
      do n=nlen,1,-1
      if((label(n:n).ne.' ').and.(label(n:n).ne.'')) exit
      end do
      ne=n
      do n=1,nlen
      if((label(n:n).ne.' ').and.(label(n:n).ne.'')) exit
      end do
      ns=n
      return
      end
      function ifnum(ch)
      character*1 ch,num(10)
      data num/'1','2','3','4','5','6','7','8','9','0'/
      do 100 i=1,10
      if(ch.eq.num(i)) go to 99
  100 continue
      ifnum=0
      return
   99 ifnum=1
      return
      end
      SUBROUTINE ZEEMAN(TERM1,TERM2,NSP,DMGSP,AISP,NSM,DMGSM,AISM,              
     % NPI,DMGPI,AIPI)                                                          
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
      PARAMETER (MV=50,MN=200,MC=100)                                           
      DIMENSION M1(MV),M2(MV),GM1(MV),GM2(MV),AI(MN),DMG(MN),MDIF(MN)           
      DIMENSION DMGSP(MC),AISP(MC),DMGSM(MC),AISM(MC),DMGPI(MC),AIPI(MC)        
      REAL*8 L1,J1,L2,J2,M1,M2                                                  
      CHARACTER*1 TERM1(4),TERM2(4)                                             
      S1=(TRANS(TERM1(1))-1.)/2.                                                
      S2=(TRANS(TERM2(1))-1.)/2.                                                
      L1=TCHAR(TERM1(2))                                                        
      L2=TCHAR(TERM2(2))                                                        
      J1=TRANS(TERM1(3))+TRANS(TERM1(4))/10.                                    
      J2=TRANS(TERM2(3))+TRANS(TERM2(4))/10.                                    
      NM1=INT(2.*J1+1.+0.5)                                                     
      NM2=INT(2.*J2+1.+0.5)                                                     
      DO 11 N=1,NM1                                                             
   11 M1(N)=-J1+FLOAT(N-1)                                                      
      DO 12 N=1,NM2                                                             
   12 M2(N)=-J2+FLOAT(N-1)                                                      
      IF(J1.EQ.0.) THEN                                                         
      G1=1.                                                                     
      ELSE                                                                      
      G1=1.+(J1*(J1+1.)+S1*(S1+1.)-L1*(L1+1.))/(2.*J1*(J1+1.))                  
      END IF                                                                    
      IF(J2.EQ.0.) THEN                                                         
      G2=1.                                                                     
      ELSE                                                                      
      G2=1.+(J2*(J2+1.)+S2*(S2+1.)-L2*(L2+1.))/(2.*J2*(J2+1.))                  
      END IF                                                                    
C      WRITE(6,6) TERM1,TERM2                                                    
C    6 FORMAT(1H ,1X,'***** TERM1=',4A1,4X,'TERM2=',4A1,' *****  ')              
C     WRITE(6,7) S1,L1,J1,G1,S2,L2,J2,G2                                        
C   7 FORMAT(1H ,1X,'S1=',F4.1,2X,'L1=',F4.1,2X,'J1=',F4.1,2X,'G1=',            
C    #F6.3,4X,'S2=',F4.1,2X,'L2=',F4.1,2X,'J2=',F4.1,2X,'G2=',F6.3)             
C     WRITE(6,14) (M1(N),N=1,NM1)                                               
C  14 FORMAT(1H ,'M1:',20(F5.1,1X))                                             
C     WRITE(6,15) (M2(N),N=1,NM2)                                               
C  15 FORMAT(1H ,'M2:',20(F5.1,1X))                                             
      DO 21 N=1,NM1                                                             
   21 GM1(N)=G1*M1(N)                                                           
      DO 22 N=1,NM2                                                             
   22 GM2(N)=G2*M2(N)                                                           
C     WRITE(6,16) (GM1(N),N=1,NM1)                                              
C  16 FORMAT(1H ,'GM1:',20F6.3)                                                 
C     WRITE(6,17) (GM2(N),N=1,NM2)                                              
C  17 FORMAT(1H ,'GM2:',20F6.3)                                                 
      IF(J2-J1.EQ.0.) GO TO 100                                                 
      IF(J2-J1.EQ.+1.) GO TO 200                                                
      IF(J2-J1.EQ.-1.) GO TO 300                                                
C     WRITE(6,8) J1,J2                                                          
C   8 FORMAT(1H ,3X,'J1=',F8.4,3X,'J2=',F8.4)                                   
      CALL EXIT                                                                 
C     J2=J1                                                                     
  100 CONTINUE                                                                  
      K=0                                                                       
      DO 101 N1=1,NM1                                                           
      DO 102 N2=1,NM2                                                           
      IF(M2(N2)-M1(N1).EQ.+1.) THEN                                             
      K=K+1                                                                     
      AI(K)=(J1-M1(N1))*(J1+M2(N2))                                             
      DMG(K)=GM2(N2)-GM1(N1)                                                    
      MDIF(K)=+1                                                                
      GO TO 102                                                                 
      END IF                                                                    
      IF(M2(N2)-M1(N1).EQ.0.) THEN                                              
      K=K+1                                                                     
      AI(K)=4.*M1(N1)**2                                                        
      DMG(K)=GM2(N2)-GM1(N1)                                                    
      MDIF(K)=0                                                                 
      GO TO 102                                                                 
      END IF                                                                    
      IF(M2(N2)-M1(N1).EQ.-1.) THEN                                             
      K=K+1                                                                     
      AI(K)=(J1-M2(N2))*(J1+M1(N1))                                             
      DMG(K)=GM2(N2)-GM1(N1)                                                    
      MDIF(K)=-1                                                                
      GO TO 102                                                                 
      END IF                                                                    
  102 CONTINUE                                                                  
  101 CONTINUE                                                                  
      GO TO 900                                                                 
C     J2=J1+1                                                                   
  200 CONTINUE                                                                  
      K=0                                                                       
      DO 201 N1=1,NM1                                                           
      DO 202 N2=1,NM2                                                           
      IF(M2(N2)-M1(N1).EQ.+1.) THEN                                             
      K=K+1                                                                     
      AI(K)=(J1+M2(N2))*(J1+(M2(N2)+1.))                                        
      DMG(K)=GM2(N2)-GM1(N1)                                                    
      MDIF(K)=+1                                                                
      GO TO 202                                                                 
      END IF                                                                    
      IF(M2(N2)-M1(N1).EQ.0.) THEN                                              
      K=K+1                                                                     
      AI(K)=4.*(J1+M1(N1)+1.)*(J1-M1(N1)+1.)                                    
      DMG(K)=GM2(N2)-GM1(N1)                                                    
      MDIF(K)=0                                                                 
      GO TO 202                                                                 
      END IF                                                                    
      IF(M2(N2)-M1(N1).EQ.-1.) THEN                                             
      K=K+1                                                                     
      AI(K)=(J1-M2(N2))*(J1-(M2(N2)-1.))                                        
      DMG(K)=GM2(N2)-GM1(N1)                                                    
      MDIF(K)=-1                                                                
      GO TO 202                                                                 
      END IF                                                                    
  202 CONTINUE                                                                  
  201 CONTINUE                                                                  
      GO TO 900                                                                 
C     J2=J1-1                                                                   
  300 CONTINUE                                                                  
      K=0                                                                       
      DO 301 N1=1,NM1                                                           
      DO 302 N2=1,NM2                                                           
      IF(M1(N1)-M2(N2).EQ.+1.) THEN                                             
      K=K+1                                                                     
      AI(K)=(J2+M1(N1))*(J2+(M1(N1)+1.))                                        
      DMG(K)=GM2(N2)-GM1(N1)                                                    
      MDIF(K)=-1                                                                
      GO TO 302                                                                 
      END IF                                                                    
      IF(M1(N1)-M2(N2).EQ.0.) THEN                                              
      K=K+1                                                                     
      AI(K)=4.*(J2+M2(N2)+1.)*(J2-M2(N2)+1.)                                    
      DMG(K)=GM2(N2)-GM1(N1)                                                    
      MDIF(K)=0                                                                 
      GO TO 302                                                                 
      END IF                                                                    
      IF(M1(N1)-M2(N2).EQ.-1.) THEN                                             
      K=K+1                                                                     
      AI(K)=(J2-M1(N1))*(J2-(M1(N1)-1.))                                        
      DMG(K)=GM2(N2)-GM1(N1)                                                    
      MDIF(K)=+1                                                                
      GO TO 302                                                                 
      END IF                                                                    
  302 CONTINUE                                                                  
  301 CONTINUE                                                                  
  900 CONTINUE                                                                  
      KK=K                                                                      
      NSP=0                                                                     
      NSM=0                                                                     
      NPI=0                                                                     
      DO 910 K=1,KK                                                             
      IF(MDIF(K).EQ.+1) THEN                                                    
      NSP=NSP+1                                                                 
      DMGSP(NSP)=DMG(K)                                                         
      AISP(NSP)=AI(K)                                                           
      END IF                                                                    
      IF(MDIF(K).EQ.-1) THEN                                                    
      NSM=NSM+1                                                                 
      DMGSM(NSM)=DMG(K)                                                         
      AISM(NSM)=AI(K)                                                           
      END IF                                                                    
      IF(MDIF(K).EQ.0) THEN                                                     
      NPI=NPI+1                                                                 
      DMGPI(NPI)=DMG(K)                                                         
      AIPI(NPI)=AI(K)                                                           
      END IF                                                                    
  910 CONTINUE                                                                  
      CALL ORD(DMGSP,AISP,NSP)                                                  
      CALL ORD(DMGSM,AISM,NSM)                                                  
      CALL ORD(DMGPI,AIPI,NPI)                                                  
C     WRITE(6,*) 'MDIF=-1 (SIGMA COMPONENT)'                                    
C     DO 1010 N=1,NSM                                                           
C1010 WRITE(6,800) DMGSM(N),AISM(N)                                             
C     WRITE(6,*) 'MDIF=+1 (SIGMA COMPONENT)'                                    
C     DO 1020 N=1,NSP                                                           
C1020 WRITE(6,800) DMGSP(N),AISP(N)                                             
C     WRITE(6,*) 'MDIF= 0 (PI COMPONENT)'                                       
C     DO 1030 N=1,NPI                                                           
C1030 WRITE(6,800) DMGPI(N),AIPI(N)                                             
C 800 FORMAT(1H ,3X,'DMG=',F7.3,3X,'AI=',F7.3)                                  
      PP=0.                                                                     
      QQ=0.                                                                     
      DO 810 N=1,NSP                                                            
      PP=PP+DMGSP(N)*AISP(N)                                                    
  810 QQ=QQ+AISP(N)                                                             
      GEFF=PP/QQ                                                                
      PP=0.                                                                     
      QQ=0.                                                                     
      DO 820 N=1,NSP                                                            
      PP=PP+(DMGSP(N)-GEFF)**2*AISP(N)                                          
  820 QQ=QQ+AISP(N)                                                             
      SIGE=SQRT(PP/QQ)                                                          
C      WRITE(6,830) GEFF,SIGE                                                    
  830 FORMAT(1H ,5X,'G(EFF)=',F8.3,5X,'S.D.=',F8.3)                             
      SUMSG=0.                                                                  
      DO 850 N=1,NSP                                                            
  850 SUMSG=SUMSG+AISP(N)                                                       
      DO 851 N=1,NSM                                                            
  851 SUMSG=SUMSG+AISM(N)                                                       
      SUMPI=0.                                                                  
      DO 852 N=1,NPI                                                            
  852 SUMPI=SUMPI+AIPI(N)                                                       
C     WRITE(6,880) SUMSG,SUMPI                                                  
C 880 FORMAT(1H ,5X,'SUMI(SIGMA)=',F8.3,5X,'SUMI(PI)=',F8.3)                    
      SPSUM=0.                                                                  
      DO 710 N=1,NSP                                                            
  710 SPSUM=SPSUM+AISP(N)                                                       
      DO 711 N=1,NSP                                                            
  711 AISP(N)=AISP(N)/SPSUM                                                     
      SMSUM=0.                                                                  
      DO 720 N=1,NSM                                                            
  720 SMSUM=SMSUM+AISM(N)                                                       
      DO 721 N=1,NSM                                                            
  721 AISM(N)=AISM(N)/SMSUM                                                     
      PISUM=0.                                                                  
      DO 730 N=1,NPI                                                            
  730 PISUM=PISUM+AIPI(N)                                                       
      DO 731 N=1,NPI                                                            
  731 AIPI(N)=AIPI(N)/PISUM                                                     
C     WRITE(6,*) 'ZEEMAN INTENSITIES HAVE BEEN NORMALIZED.'                     
      RETURN                                                                    
      END                                                                       
      FUNCTION TRANS(C)                                                         
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
      CHARACTER*1 C                                                             
      IF(C.EQ.'0') GO TO 10                                                     
      IF(C.EQ.'1') GO TO 11                                                     
      IF(C.EQ.'2') GO TO 12                                                     
      IF(C.EQ.'3') GO TO 13                                                     
      IF(C.EQ.'4') GO TO 14                                                     
      IF(C.EQ.'5') GO TO 15                                                     
      IF(C.EQ.'6') GO TO 16                                                     
      IF(C.EQ.'7') GO TO 17                                                     
      IF(C.EQ.'8') GO TO 18                                                     
      IF(C.EQ.'9') GO TO 19                                                     
c      WRITE(6,*) 'NOT UNDERSTAND IN TRANS -> ',C                                
c      CALL EXIT
      trans=-999.
      return                                                                 
   10 TRANS=0.                                                                  
      RETURN                                                                    
   11 TRANS=1.                                                                  
      RETURN                                                                    
   12 TRANS=2.                                                                  
      RETURN                                                                    
   13 TRANS=3.                                                                  
      RETURN                                                                    
   14 TRANS=4.                                                                  
      RETURN                                                                    
   15 TRANS=5.                                                                  
      RETURN                                                                    
   16 TRANS=6.                                                                  
      RETURN                                                                    
   17 TRANS=7.                                                                  
      RETURN                                                                    
   18 TRANS=8.                                                                  
      RETURN                                                                    
   19 TRANS=9.                                                                  
      RETURN                                                                    
      END                                                                       
      FUNCTION TCHAR(C)                                                         
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
      CHARACTER*1 C                                                             
      IF(C.EQ.'S') GO TO 10                                                     
      IF(C.EQ.'P') GO TO 11                                                     
      IF(C.EQ.'D') GO TO 12                                                     
      IF(C.EQ.'F') GO TO 13                                                     
      IF(C.EQ.'G') GO TO 14                                                     
      IF(C.EQ.'H') GO TO 15                                                     
      IF(C.EQ.'I') GO TO 16                                                     
      IF(C.EQ.'K') GO TO 17                                                     
      IF(C.EQ.'L') GO TO 18                                                     
      IF(C.EQ.'M') GO TO 19                                                     
      IF(C.EQ.'N') GO TO 20                                                     
c      WRITE(6,*) 'NOT UNDERSTAND IN TCHAR -> ',C                                
c      CALL EXIT
      tchar=-999.                                                                 
      return
   10 TCHAR=0.                                                                  
      RETURN                                                                    
   11 TCHAR=1.                                                                  
      RETURN                                                                    
   12 TCHAR=2.                                                                  
      RETURN                                                                    
   13 TCHAR=3.                                                                  
      RETURN                                                                    
   14 TCHAR=4.                                                                  
      RETURN                                                                    
   15 TCHAR=5.                                                                  
      RETURN                                                                    
   16 TCHAR=6.                                                                  
      RETURN                                                                    
   17 TCHAR=7.                                                                  
      RETURN                                                                    
   18 TCHAR=8.                                                                  
      RETURN                                                                    
   19 TCHAR=9.                                                                  
      RETURN                                                                    
   20 TCHAR=10.                                                                  
      RETURN                                                                    
      END                                                                       
      SUBROUTINE ORD(A,B,N)                                                     
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
      DIMENSION A(N),B(N)                                                       
      DO 10 K=N,2,-1                                                            
      DO 20 I=1,K-1                                                             
      IF(A(I).GT.A(I+1)) THEN                                                   
      AT=A(I+1)                                                                 
      A(I+1)=A(I)                                                               
      A(I)=AT                                                                   
      BT=B(I+1)                                                                 
      B(I+1)=B(I)                                                               
      B(I)=BT                                                                   
      END IF                                                                    
   20 CONTINUE                                                                  
   10 CONTINUE                                                                  
      RETURN                                                                    
      END                                                                       

      subroutine retenv(varname,string)
      use dfport
      character*7 varname
      character*80 sptool,string
      call getenv('SPTOOL',sptool)
      call lablen(sptool,80,is,ie)
      call lablen(varname,7,ivs,ive)
      if(varname(ivs:ive).eq.'SPTOOL') then
          string=sptool(is:ie)
        else if(varname(ivs:ive).eq.'SPT_DIR') then
          string=sptool(is:ie)//'\exefiles'
        else if(varname(ivs:ive).eq.'MOD_DIR') then
          string=sptool(is:ie)//'\k2models'
        else if(varname(ivs:ive).eq.'KGF_DIR') then
          string=sptool(is:ie)//'\GF10'
        else if(varname(ivs:ive).eq.'SFX_DIR') then
          string=sptool(is:ie)//'\sflxkpno'
        else if(varname(ivs:ive).eq.'DAT_DIR') then
          string=sptool(is:ie)//'\miscdata'
        else
          write(*,*) 'I do not understand '//varname(ivs:ive)
          stop
      end if
      return
      end
