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,101 @@
+      SUBROUTINE PHTX(ID,ABSO,EMIS,fre,icon)
+C     ======================================
+C
+C     Opacity due to detailed photoionization (read from tables by
+C     routine SIGAVS)
+C
+      INCLUDE 'PARAMS.FOR'
+      INCLUDE 'MODELP.FOR'
+      INCLUDE 'SYNTHP.FOR'
+      INCLUDE 'LINDAT.FOR'
+      DIMENSION ABSO(MFREQ),EMIS(MFREQ),PLANF(MFREQ),STIMU(MFREQ)
+      dimension fre(mfreq)
+      DIMENSION PHOTI(MCROSS,MFREQ)
+      DIMENSION IJP(MLEVEL),IJQ(MPHOT)
+      PARAMETER (C3=1.4387886)
+      SAVE PHOTI,IJP,IJQ
+C
+      IF(IASV.EQ.0 .AND. NQHT.EQ.0) RETURN
+      T=TEMP(ID)
+      nfre=nfreq
+      ij0=3
+      if(icon.eq.1) then
+         ij0=1
+         nfre=nfreqc
+      end if
+c
+      DO 10 IJ=1,NFRE
+         XX=FRE(IJ)
+         X15=XX*1.E-15
+         BNU=BN*X15*X15*X15
+         HKF=HK*XX
+         EXH=EXP(HKF/T)
+         PLANF(IJ)=BNU/(EXH-1.)
+         STIMU(IJ)=1.-1./EXH
+   10 CONTINUE
+C
+      IF(IASV.EQ.0) GOTO 100
+      IF(ID.EQ.1) THEN
+        DO 40 I=1,NLEVEL
+          IF(CRMX(I).EQ.0.) GOTO 40
+          IK1=MAX0(2,IJP(I))
+          DO 42 IJ=3,NFRE
+            DO 45 IK=IK1,NFCR(I)
+              IF(FRECR(I,IK).LT.FRE(IJ)) THEN
+                IK2=IK
+                GOTO 46
+              ENDIF
+   45       CONTINUE
+   46       IK1=IK2
+            IF(IJ.EQ.3) IJP(I)=IK1
+            DFR=(FRE(IJ)-FRECR(I,IK1))/(FRECR(I,IK1-1)-FRECR(I,IK1))
+            PHOTI(I,IJ)=CROSR(I,IK1)+DFR*(CROSR(I,IK1-1)-CROSR(I,IK1))
+   42     CONTINUE
+          PHOTI(I,1)=PHOTI(I,3)
+          PHOTI(I,2)=PHOTI(I,NFREQ)
+   40   CONTINUE
+      ENDIF
+      DO 30 I=1,NLEVEL
+        IF(CRMX(I).EQ.0.) GOTO 30
+        POP=POPUL(I,ID)
+        DO 20 IJ=1,NFRE
+          AB=PHOTI(I,IJ)*POP*STIMU(IJ)
+          ABSO(IJ)=ABSO(IJ)+AB
+          EMIS(IJ)=EMIS(IJ)+AB*PLANF(IJ)
+   20   CONTINUE
+   30 CONTINUE
+C
+  100 IF(NQHT.EQ.0) RETURN
+      IF(ID.EQ.1) THEN
+        DO 110 I=1,NQHT
+          IF(CRMY(I).EQ.0.) GOTO 110
+          IK1=MAX0(2,IJQ(I))
+          DO 120 IJ=3,NFRE
+            DO 125 IK=IK1,NFQHT(I)
+              IF(FRECQ(I,IK).LT.FRE(IJ)) THEN
+                IK2=IK
+                GOTO 126
+              ENDIF
+  125       CONTINUE
+  126       IK1=IK2
+            IF(IJ.EQ.3) IJQ(I)=IK1
+            DFR=(FRE(IJ)-FRECQ(I,IK1))/(FRECQ(I,IK1-1)-FRECQ(I,IK1))
+            PHOTI(I,IJ)=QHOT(I,IK1)+DFR*(QHOT(I,IK1-1)-QHOT(I,IK1))
+  120     CONTINUE
+  110   CONTINUE
+      ENDIF
+      DO 210 I=1,NQHT
+        IF(CRMY(I).EQ.0.) GOTO 210
+        IAT=int(AQHT(I))
+        X=(AQHT(I)-FLOAT(IAT)+1.E-4)*100.
+        ION=INT(X)+1
+        POP=RRR(ID,ION,IAT)*GQHT(I)*EXP(-EQHT(I)*C3/T)
+        DO 220 IJ=3,NFRE
+          AB=PHOTI(I,IJ)*POP*STIMU(IJ)
+          ABSO(IJ)=ABSO(IJ)+AB
+          EMIS(IJ)=EMIS(IJ)+AB*PLANF(IJ)
+  220   CONTINUE
+  210 CONTINUE
+C
+      RETURN
+      END