SUBROUTINE INIBLH
C     =================
C
C     output information about hydrogen lines
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)
C
      PARAMETER (C1=2.3025851, C2=4.2014672, C3=1.4387886)
      PARAMETER (DP0=3.33564E-11, DP1=1.651E8, 
     *           VW1=0.42, VW2=0.45,TENM4=1.E-4)
      PARAMETER (UN=1.) 

      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(IPRIN.LE.-2.OR.IHYL.LT.0) RETURN
      ALM0=2.997925D18/FREQ(1)
      ALM1=2.997925D18/FREQ(2)
      XX=FREQ(1)
      IF(NFREQ.GE.2) XX=0.5*(FREQ(1)+FREQ(2))
      BNU=BN*(XX*1.E-15)**3
      HKF=HK*XX
C
      IAT=1
      ION=1
      IZZ=1
      ID=IDSTD
      T=TEMP(ID)
      ANE=ELEC(ID)
      EXH=EXP(HKF/T)
      EXHK(ID)=UN/EXH
      PLAN(ID)=BNU/(EXH-UN)
      STIM(ID)=UN-EXHK(ID)
      DOPA1(IAT,ID)=UN/(XX*DP0*SQRT(DP1*T/AMAS(IAT)+VTURB(ID)))
      ISERL=ILOWH
      ISERU=ILOWH
      IF(alm0.GT.17000..AND.alm1.LT.21000.) THEN
         ISERL=3
         ISERU=4
       ELSE IF(alm0.GT.22700.) THEN
         ISERL=4
         ISERU=5
         IF(alm0.GT.32800.) ISERU=6
         IF(alm0.GT.44660.) ISERU=7
      END IF
C
      DO I=ISERL,ISERU
         II=I*I
         XII=UN/II
         M1=M10
         IF(I.LT.ILOWH) M1=ILOWH-1
         M2=M1+1
         IF(M1.LT.I+1) M1=I+1
         M1=M1-1
         M2=M20+3
         IF(M1.LT.I+1) M1=I+1
         if(grav.gt.3.) then
            m2=m2+5
            m1=m1-3
            if(m1.gt.i+6) m1=m1-3 
         end if
         if(grav.gt.6.) then
            m2=m2+2
            m1=m1-1
            if(m1.gt.i+6) m1=m1-1 
         end if
         IF(M1.LT.I+1) M1=I+1
         IF(M2.GT.20) M2=20
         ILINH=0
         DO J=M2,M1,-1
            CALL STARK0(I,J,izz,XKIJ,WL0,FIJ,FIJ0)
            ALAM=WL0
            if(alam.ge.alm0.and.alam.lt.alm1) then
               ILINH=ILINH+1
               GH=2.*II
               GF=LOG10(FIJ*GH)
               EXCL=109679.*(1.-XII)
               EXCL0H=EXCL*C3
               GF0H=GF*C1-C2
               ABCNT=EXP(GF0H-EXCL0H/TEMP(ID))*RRR(ID,ION,IAT)*
     *                DOPA1(IAT,ID)*STIM(ID)
               STR0=ABCNT/ABSTD(ID)
               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
                  agam=0.01
                  WW2=0.5*SQRT(3.14*AGAM*STR0)
                  IF(WW2.GT.WW1) WW1=WW2
               END IF
               EQW=ALAM*ALAM/3.E18*1.E3/DOPA1(IAT,ID)*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
c              if(iprin.ge.2)
c    *         WRITE(6,601) ALAM,TYPAT(IAT),TYPION(ION),GF,EXCL,
c    *                      STR0,EQW,APR,i,j
               WRITE(14,601) ALAM,TYPAT(IAT),TYPION(ION),GF,EXCL,
     *                 STR0,EQW,APR,i,j
            end if
         END DO
      END DO
C
  601 FORMAT(F10.3,2X,2A4,F7.2,F12.3,1PE11.2,0PF8.1,1X,A4,2i3)
C
      RETURN
      END