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,68 @@
+      SUBROUTINE INIMOD
+C
+C   SET UP COMMON/RRRVAL/  - VALUES OF  N(ION)/U(ION) FOR ALL THE ATOMS
+C   AND IONS CONSIDERED
+C
+      INCLUDE 'PARAMS.FOR'
+      INCLUDE 'MODELP.FOR'
+      COMMON/BLAPAR/RELOP,SPACE0,CUTOF0,TSTD,DSTD,ALAMC
+      COMMON/HPOPST/HPOP
+C
+c     1. "low-temperature" ionization fractions 
+c         (using Hamburg partition functions)
+c
+      DO 50 ID=1,ND
+         IF(IFMOL.EQ.0.OR.TEMP(ID).GE.TMOLIM) THEN
+            CALL STATE(ID,TEMP(ID),ELEC(ID),S1)
+            HPOP=DENS(ID)/WMM(ID)/YTOT(ID)
+            DO J=1,MION0
+               DO I=1,MATOM
+                  RRR(ID,J,I)=RR(I,J)*HPOP
+               END DO
+            END DO
+            DO IAT=1,NATOM
+               ATTOT(IAT,ID)=HPOP*ABUND(IAT,ID)
+            END DO
+          ELSE
+            HPOP=ATTOT(1,ID)
+         END IF
+         IF(ID.NE.IDSTD) GO TO 50
+         TSTD=TEMP(ID)
+         VTS=VTURB(ID)
+         DSTD=SQRT(1.4E7*TSTD+VTS)
+         WRITE(6,601) ID,TEMP(ID),ELEC(ID),hpop
+c        DO I=1,MATOM
+         DO I=1,30    
+            WRITE(6,602) TYPAT(I),(RRR(ID,J,I),J=1,MION0-1)
+         END DO
+c        WRITE(6,603)
+c        DO I=1,MATOM
+c           WRITE(6,602) TYPAT(I),(PFSTD(J,I),J=1,MION0-1)
+c        END DO
+   50 CONTINUE
+c
+c     2. "high-temperature" ionization fractions 
+c         (using the Opacity Project ionization fractions)
+c
+      if(teff.lt.0.) then
+      CALL FRAC1
+      ID=IDSTD
+      HPOP=DENS(ID)/WMM(ID)/YTOT(ID)
+      WRITE(6,604) ID,TEMP(ID),ELEC(ID)
+      DO 60 I=1,MATOM
+         WRITE(6,605) TYPAT(I),(RRR(ID,J,I)/hpop,J=1,MION)
+         ioniz(i)=i+1
+   60 continue
+      end if
+C
+  601 FORMAT(/' N/U  AT THE STANDARD DEPTH  (ID =',I3, 
+     *         ' ; T,Ne = ',F8.1,1P2E12.3,' )'/
+     *         ' --------------------------'//)
+  602 FORMAT(1H ,A4,1P8E9.2)
+c 603 FORMAT(//' PARTITION FUNCTIONS AT THE STANDARD DEPTH'/
+c    *        ' ------------------------------------------'//)
+  604 FORMAT(/' N/U  AT THE STANDARD DEPTH  - OP DATA',
+     * '  (ID =',I3,' ; T,Ne = ',F8.1,1PE12.3,' )'//)
+  605 FORMAT(1H ,A4,(1P8E9.2))
+      RETURN
+      END