git push -u origin main

2026-03-19 14:05:33 +08:00
commit 1e30b7bc63
739 changed files with 572150 additions and 0 deletions
@@ -0,0 +1,125 @@
+      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