SpectraRust/tlusty/extracted/cheav.f
2026-03-19 14:05:33 +08:00

149 lines
4.8 KiB
Fortran

FUNCTION CHEAV(II,JJ,IC)
C ========================
C
C Calculates collisional excitation rates of neutral helium
C between states with n= 1, 2, 3, 4; with either the upper state
C alone, or both upper and lower states are some averaged states
C The program allows only two standard possibilities of
C constructing averaged levels:
C i) all states within given principal quantum number n (>1) are
C lumped together
C ii) all siglet states for given n, and all triplet states for
C given n are lumped together separately (there are thus two
C explicit levels for a given n)
C
C The rates are calculated using appropriate summations and/or
C averages of the Storey-Hummer rates (calculated by procedure
C COLLHE and stored in array COLHE1)
C
C Input parameters:
C II,JJ - indices of the lower and the upper level (in the
C numbering of the explicit levels)
C IC - collisional switch ICOL for the given transition
C
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'ATOMIC.FOR'
C
CHEAV=0.
NI=NQUANT(II)
NJ=NQUANT(JJ)
IGI=INT(G(II)+0.01)
IGJ=INT(G(JJ)+0.01)
C
C ----------------------------------------------------------------
C IC=2 - transition from an (l,s) lower level to an averaged upper
C level
C ----------------------------------------------------------------
C
IF(IC.EQ.2) THEN
I=II-NFIRST(IELHE1)+1
CHEAV=CHEAVJ(I,NJ,IGJ)
END IF
C
C ----------------------------------------------------------------
C IC=3 - transition from an averaged lower level to an averaged
C upper level
C ----------------------------------------------------------------
C
IF(IC.EQ.3) THEN
IF(NI.EQ.2) THEN
C
C ******** transitions from an averaged level with n=2
C
IF(IGI.EQ.4) THEN
C
C a) lower level is an averaged singlet state
C
CHEAV=(CHEAVJ(3,NJ,IGJ)+3.D0*CHEAVJ(5,NJ,IGJ))/4.D0
ELSE IF(IGI.EQ.12) THEN
C
C b) lower level is an averaged triplet state
C
CHEAV=(CHEAVJ(2,NJ,IGJ)+3.D0*CHEAVJ(4,NJ,IGJ))/4.D0
ELSE IF(IGI.EQ.16) THEN
C
C c) lower level is an average of both singlet and triplet states
C
CHEAV=(CHEAVJ(3,NJ,IGJ)+3.D0*(CHEAVJ(5,NJ,IGJ)+
* CHEAVJ(2,NJ,IGJ))+9.D0*CHEAVJ(4,NJ,IGJ))/1.6D1
ELSE
GO TO 10
END IF
C
C
C ******** transitions from an averaged level with n=3
C
ELSE IF(NI.EQ.3) THEN
IF(IGI.EQ.9) THEN
C
C a) lower level is an averaged singlet state
C
CHEAV=(CHEAVJ(7,NJ,IGJ)+3.D0*CHEAVJ(11,NJ,IGJ)+
* 5.D0*CHEAVJ(10,NJ,IGJ))/9.D0
ELSE IF(IGI.EQ.27) THEN
C
C b) lower level is an averaged triplet state
C
CHEAV=(CHEAVJ(6,NJ,IGJ)+3.D0*CHEAVJ(8,NJ,IGJ)+
* 5.D0*CHEAVJ(9,NJ,IGJ))/9.D0
ELSE IF(IGI.EQ.36) THEN
C
C c) lower level is an average of both singlet and triplet states
C
CHEAV=(CHEAVJ(7,NJ,IGJ)+3.D0*CHEAVJ(11,NJ,IGJ)+
* 5.D0*CHEAVJ(10,NJ,IGJ)+
* 3.D0*CHEAVJ(6,NJ,IGJ)+9.D0*CHEAVJ(8,NJ,IGJ)+
* 1.5D1*CHEAVJ(9,NJ,IGJ))/3.6D1
ELSE
GO TO 10
END IF
C
C ******** transitions from an averaged level with n=4
C
ELSE IF(NI.EQ.4) THEN
IF(IGI.EQ.16) THEN
C
C a) lower level is an averaged singlet state
C
CHEAV=(CHEAVJ(13,NJ,IGJ)+
* 3.D0*CHEAVJ(19,NJ,IGJ)+
* 5.D0*CHEAVJ(16,NJ,IGJ)+
* 7.D0*CHEAVJ(18,NJ,IGJ))/1.6D1
ELSE IF(IGI.EQ.48) THEN
C
C b) lower level is an averaged triplet state
C
CHEAV=(CHEAVJ(12,NJ,IGJ)+
* 3.D0*CHEAVJ(14,NJ,IGJ)+
* 5.D0*CHEAVJ(15,NJ,IGJ)+
* 7.D0*CHEAVJ(17,NJ,IGJ))/1.6D1
ELSE IF(IGI.EQ.64) THEN
C
C c) lower level is an average of both singlet and triplet states
C
CHEAV=(CHEAVJ(13,NJ,IGJ)+
* 3.D0*CHEAVJ(19,NJ,IGJ)+
* 5.D0*CHEAVJ(16,NJ,IGJ)+
* 7.D0*CHEAVJ(18,NJ,IGJ)+
* 3.D0*CHEAVJ(12,NJ,IGJ)+
* 9.D0*CHEAVJ(14,NJ,IGJ)+
* 15.D0*CHEAVJ(15,NJ,IGJ)+
* 21.D0*CHEAVJ(17,NJ,IGJ))/6.4D1
ELSE
GO TO 10
END IF
ELSE
GO TO 10
END IF
END IF
RETURN
10 WRITE(6,601) NI,NJ,IGI,IGJ
write(10,601) NI,NJ,IGI,IGJ
601 FORMAT(1H0/' INCONSISTENT INPUT TO PROCEDURE CHEAV'/
* ' QUANTUM NUMBERS =',2I3,' STATISTICAL WEIGHTS',2I4)
call quit(' ',ni,nj)
END