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,82 @@
+      SUBROUTINE INTHE2(W0,X0,Z0,IWL,ILINE)
+C     =====================================
+C
+C     Interpolation in temperature and electron density from the
+C     Schoening and Butler tables for He II lines to the actual
+C     actual values of temperature and electron density
+C
+C     This procedure is quite analogous to INTHYD for hydrogen lines
+C
+      INCLUDE 'PARAMS.FOR'
+      PARAMETER (UN=1.)
+      COMMON/HE2DAT/WL2(36,19),XT2(6),XNE2(11,19),PRF2(36,6,11),
+     *              NWL2,NT2,NE2
+      DIMENSION ZZ(3),XX(3),WX(3),WZ(3)
+C
+      NX=3
+      NZ=3
+C
+C     for values lower than the lowest grid value of electron density
+C     the profiles are determined by the approximate expression
+C     (see STARKA); not by an extrapolation in the tables which may
+C     be very inaccurate
+C
+      IF(Z0.LT.XNE2(1,ILINE)*0.99.OR.Z0.GT.XNE2(NE2,ILINE)*1.01) THEN
+         CALL DIVHE2(A,DIV)
+         W0=STARKA(WL2(IWL,ILINE)/FXK,A,DIV,UN)*DBETA
+         W0=LOG10(W0)
+         GO TO 500
+      END IF
+C
+C     Otherwise, one interpolates (or extrapolates for higher than the
+C     highes grid value of electron density) in the Schoening and
+C     Butler tables
+C
+      DO 10 IZZ=1,NE2-1
+         IPZ=IZZ
+         IF(Z0.LE.XNE2(IZZ+1,ILINE)) GO TO 20
+   10 CONTINUE
+   20 N0Z=IPZ-NZ/2+1
+      IF(N0Z.LT.1) N0Z=1
+      IF(N0Z.GT.NE2-NZ+1) N0Z=NE2-NZ+1
+      N1Z=N0Z+NZ-1
+C
+      DO 300 IZZ=N0Z,N1Z
+         I0Z=IZZ-N0Z+1
+         ZZ(I0Z)=XNE2(IZZ,iline)
+C
+C     Likewise, the approximate expression instead of extrapolation
+C     is used for higher that the highest grid value of temperature,
+C     if the Doppler width expressed in beta units (BETAD) is
+C     sufficiently large (> 10)
+C
+         IF(X0.GT.1.01*XT2(NT2).AND.BETAD.GT.10.) THEN
+            W0=STARKA(WL2(IWL,ILINE)/FXK,A,DIV,UN)*DBETA
+            W0=LOG10(W0)
+            GO TO 500
+         END IF
+C
+C     Otherwise, normal inter- or extrapolation
+C
+C     Both interpolations (in T as well as in electron density) are
+C     by default the quadratic interpolations in logarithms
+C
+         DO 30 IX=1,NT2-1
+            IPX=IX
+            IF(X0.LE.XT2(IX+1)) GO TO 40
+   30    CONTINUE
+   40    N0X=IPX-NX/2+1
+         IF(N0X.LT.1) N0X=1
+         IF(N0X.GT.NT2-NX+1) N0X=NT2-NX+1
+         N1X=N0X+NX-1
+         DO 200 IX=N0X,N1X
+            I0=IX-N0X+1
+            XX(I0)=XT2(IX)
+            WX(I0)=PRF2(IWL,IX,IZZ)
+  200       CONTINUE
+         WZ(I0Z)=YINT(XX,WX,X0)
+  300 CONTINUE
+      W0=YINT(ZZ,WZ,Z0)
+  500 CONTINUE
+      RETURN
+      END