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,100 @@
+      SUBROUTINE CHANGE
+C     =================
+C
+C     This procedure controls an evaluation of initial level
+C     populations in case where the system of explicit levels
+C     (ie. the choice of explicit level, their numbering, or their
+C     total number) is not consistent with that for the input level
+C     populations read by procedure INPMOD.
+C     Obviously, this procedure need be used only for NLTE input models.
+C
+C     Input from unit 5:
+C     For each explicit level, II=1,NLEVEL, the following parameters:
+C      IOLD   -  NE.0 - means that population of this level is
+C                       contained in the set of input populations;
+C                       IOLD is then its index in the "old" (i.e. input)
+C                       numbering.
+C                       All the subsequent parameters have no meaning
+C                       in this case.
+C             -  EQ.0 - means that this level has no equivalent in the
+C                       set of "old" levels. Population of this level
+C                       has thus to be evaluated.
+C      MODE   -    indicates how the population is evaluated:
+C             = 0  - population is equal to the population of the "old"
+C                    level with index ISIOLD, multiplied by REL;
+C             = 1  - population assumed to be LTE, with respect to the
+C                    first state of the next ionization degree whose
+C                    population must be contained in the set of "old"
+C                    (ie. input) populations, with index NXTOLD in the
+C                    "old" numbering.
+C                    The population determined of this way may further
+C                    be multiplied by REL.
+C             = 2  - population determined assuming that the b-factor
+C                    (defined as the ratio between the NLTE and
+C                    LTE population) is the same as the b-factor of
+C                    the level ISINEW (in the present numbering). The
+C                    level ISINEW must have the equivalent in the "old"
+C                    set; its index in the "old" set is ISIOLD, and the
+C                    index of the first state of the next ionization
+C                    degree, in the "old" numbering, is NXTSIO.
+C                    The population determined of this way may further
+C                    be multiplied by REL.
+C             = 3  - level corresponds to an ion or atom which was not
+C                    explicit in the old system; population is assumed
+C                    to be LTE.
+C      NXTOLD  -  see above
+C      ISINEW  -  see above
+C      ISIOLD  -  see above
+C      NXTSIO  -  see above
+C      REL     -  population multiplier - see above
+C                 if REL=0, the program sets up REL=1
+C
+      INCLUDE 'PARAMS.FOR'
+      INCLUDE 'MODELP.FOR'
+      DIMENSION ESEMAT(MLEVEL,MLEVEL),BESE(MLEVEL),POPLTE(MLEVEL)
+      COMMON ESEMAT,BESE,POPLTE,POPUL0(MLEVEL,MDEPTH),
+     *       POPULL(MLEVEL,MDEPTH),POPL(MLEVEL)
+C
+      PARAMETER (S = 2.0706E-16)
+      IFESE=0
+      DO 100 II=1,NLEVEL
+         READ(ICHANG,*) IOLD,MODE,NXTOLD,ISINEW,ISIOLD,NXTSIO,REL
+         IF(MODE.GE.3) IFESE=IFESE+1
+         IF(REL.EQ.0.) REL=1.
+         DO 90 ID=1,ND
+            IF(IOLD.EQ.0) GO TO 10
+            POPUL0(II,ID)=POPUL(IOLD,ID)
+            GO TO 90
+   10       IF(MODE.NE.0) GO TO 20
+            POPUL0(II,ID)=POPUL(ISIOLD,ID)*REL
+            GO TO 90
+   20       T=TEMP(ID)
+            ANE=ELEC(ID)
+            IF(MODE.GE.3) GO TO 40
+            NXTNEW=NNEXT(IEL(II))
+            SB=S/T/SQRT(T)*G(II)/G(NXTNEW)*EXP(ENION(II)/T/BOLK)
+            IF(MODE.GT.1) GO TO 30
+            POPUL0(II,ID)=SB*ANE*POPUL(NXTOLD,ID)*REL
+            GO TO 90
+   30       KK=ISINEW
+            KNEXT=NNEXT(IEL(KK))
+            SBK=S/T/SQRT(T)*G(KK)/G(KNEXT)*EXP(ENION(KK)/T/BOLK)
+            POPUL0(II,ID)=SB/SBK*POPUL(NXTOLD,ID)/POPUL(NXTSIO,ID)*
+     *                    POPUL(ISIOLD,ID)*REL
+            GO TO 90
+   40       IF(IFESE.EQ.1) THEN
+               CALL SABOLF(ID)
+               CALL RATMAT(ID,ESEMAT,BESE)
+               CALL LINEQS(ESEMAT,BESE,POPLTE,NLEVEL,MLEVEL)
+               DO 50 III=1,NLEVEL
+   50             POPULL(III,ID)=POPLTE(III)
+            END IF
+            POPUL0(II,ID)=POPULL(II,ID)
+   90    CONTINUE
+  100 CONTINUE
+      DO 110 I=1,NLEVEL
+         DO 110 ID=1,ND
+            POPUL(I,ID)=POPUL0(I,ID)
+  110 CONTINUE
+      RETURN
+      END