SUBROUTINE IDTAB
C     ================
C
C     output of selected line parameters (identification table)
C
      INCLUDE 'PARAMS.FOR'
      INCLUDE 'MODELP.FOR'
      INCLUDE 'SYNTHP.FOR'
      INCLUDE 'LINDAT.FOR'
      CHARACTER*4 TYPION(30)
      CHARACTER*4 APB,AP0,AP1,AP2,AP3,AP4,APR
      COMMON/PRFQUA/DOPA1(MATOM,MDEPTH),VDWC(MDEPTH)
      COMMON/REFDEP/IREFD(MFRQ)
      COMMON/RTEOPA/CH(MFREQ,MDEPTH),ET(MFREQ,MDEPTH),
     *              SC(MFREQ,MDEPTH)
C
      PARAMETER (C1=2.3025851, C2=4.2014672, C3=1.4387886)
      DATA TYPION /' I  ',' II ',' III',' IV ',' V  ',
     *             ' VI ',' VII','VIII',' IX ',' X  ',
     *             ' XI ',' XII','XIII',' XIV',' XV ',
     *             ' XVI','XVII',' 18 ',' XIX',' XX ',
     *             ' XXI','XXII',' 23 ','XXIV','XXV ',
     *             'XXVI',' 27 ',' 28 ','XXIX',' XXX'/
      DATA APB,AP0,AP1,AP2,AP3,AP4 /'    ','   .','   *','  **',' ***',
     *                              '****'/
C
      IF(NLIN.EQ.0) GO TO 100
C
      ALM0=2.997925D18/FREQ(1)
      ALM1=2.997925D18/FREQ(2)
      if(ifwin.gt.0) ALM0=2.997925D18/FRQOBS(1)
      if(ifwin.gt.0) ALM1=2.997925D18/FRQOBS(NFREQ)
      IF(IPRIN.LE.-2) RETURN
      if(iprin.ge.2) then
c     IF(IMODE.GE.0.OR.(IMODE.EQ.-1.AND.IBLANK.EQ.1)) WRITE(6,602)
      end if
C
      DO IL0=1,NLIN
         IL=INDLIN(IL0) 
         ALAM=2.997925D18/FREQ0(IL)
         ID=IDSTD
         IJCN=IJCNTR(IL0)
         ID0=0
         IF(IJCN.GE.1.AND.IJCN.LE.NFREQS) ID0=IREFD(IJCN)
         IF(ID0.GT.0.and.id0.lt.nd) ID=ID0
         IAT=INDAT(IL)/100
         ION=MOD(INDAT(IL),100)
         CALL PROFIL(IL,IAT,ID,AGAM)
         ABCNT=EXP(GF0(IL)-EXCL0(IL)/TEMP(ID))*RRR(ID,ION,IAT)*
     *         STIM(ID)
         absta=min(ch(1,idstd),ch(2,idstd))
         if(ifwin.le.0) then
            DOP1=DOPA1(IAT,ID)
            str0=abcnt*dop1/absta
          else 
            DOP1=DOPA1(IAT,ID)/FREQ0(IL)
            STR0=ABCNT*DOP1/ABSTDW(IJCONT(IL),ID)
         end if
         GF=(GF0(IL)+C2)/C1
         EXCL=EXCL0(IL)/C3
         IF(STR0.LE.1.2) THEN
            WW1=0.886*STR0*(1.-STR0*(0.707-STR0*0.577))
          ELSE 
            WW1=SQRT(LOG(STR0))
         END IF
         IF(STR0.GT.55.) THEN
            WW2=0.5*SQRT(3.14*AGAM*STR0)
            IF(WW2.GT.WW1) WW1=WW2
         END IF
         EQW=ALAM/FREQ0(IL)*1.E3/DOP1*WW1
         STR=EQW*10.
         APR=APB
         IF(STR.GE.1.E0.AND.STR.LT.1.E1) APR=AP0
         IF(STR.GE.1.E1.AND.STR.LT.1.E2) APR=AP1
         IF(STR.GE.1.E2.AND.STR.LT.1.E3) APR=AP2
         IF(STR.GE.1.E3.AND.STR.LT.1.E4) APR=AP3
         IF(STR.GE.1.E4) APR=AP4
         if(alam.ge.alm0.and.alam.lt.alm1) then
         ill=ilown(il)
         ilu=iupn(il)
         if(ill.gt.0) ill=ill-nfirst(iel(ill))+1
         if(ilu.gt.0) ilu=ilu-nfirst(iel(ilu))+1
       
         WRITE(12,603) ALAM,TYPAT(IAT),TYPION(ION),GF,EXCL,
     *                 STR0,EQW,APR,ill,ilu,id
         end if
      END DO
C
c 602 FORMAT(/1H ,13X,
c    * 'LAMBDA    ATOM    LOG GF       ELO    LINE/CONT',2X,
c    * 'EQ.WIDTH'/)
  603 FORMAT(F11.3,2X,A4,A3,F7.2,F12.3,1PE11.2,0PF8.1,1X,A4,
     *       3i4)
C
  100 CONTINUE
      RETURN
      END