88 lines
2.6 KiB
Fortran
88 lines
2.6 KiB
Fortran
SUBROUTINE SWITCH(INITM)
|
|
C ========================
|
|
C
|
|
C Procedure for evaluating the collisional-radiative switching
|
|
C parameter lambda(R), denoted here CRSW(ID);
|
|
C Original procedure suggested by Hummer and Voels,
|
|
C Astron. Astrophys. 192, 279, 1988, was modified here by a
|
|
C possibility of considering depth dependent switching parameter CRSW
|
|
C
|
|
C Parameters SWPFAC, SWPLIM, SWPINC, and ICRSW are input
|
|
C parameters, having the meaning:
|
|
C
|
|
C ICRSW = 0 - collisional-radiative switching not considered
|
|
C > 0 - collisional-radiative switching is considered
|
|
C SWPFAC - initial CRSW = SWPFAC * min(collis.rate/rad.rate)
|
|
C SWPLIM - has the meaning: if CRSW > SWPLIM, then CRSW = 1
|
|
C SWPINC - CRSW(actual) = CRSW(previous) * SWPINC
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
DIMENSION SWTCH(MDEPTH)
|
|
C
|
|
IF(ICRSW.EQ.0) RETURN
|
|
IF(INITM.EQ.0) GO TO 10
|
|
C
|
|
C Before the first iteration of complete linearization
|
|
C initialisation of the collisional-radiative switching
|
|
C parameters, as described by Hummer and Voels,
|
|
C Astron. Astrophys. 192, 279, 1988;
|
|
C modified here by considering depth-dependent swiching
|
|
C parameter lambda(R) - denoted here CRSW(ID)
|
|
C
|
|
SWMIN=UN
|
|
DO ID=1,ND
|
|
SWTCH(ID)=UN
|
|
DO ITR=1,NTRANS
|
|
C=COLRAT(ITR,ID)
|
|
IF(RRU(ITR,ID).NE.0.) THEN
|
|
C
|
|
C upward rates
|
|
C
|
|
SWU=C/RRU(ITR,ID)
|
|
C
|
|
C downward rates
|
|
C
|
|
IF(LINE(ITR)) THEN
|
|
SWD=C*EXP(HK*FR0(ITR)/TEMP(ID))/RRD(ITR,ID)
|
|
ELSE
|
|
SWD=C/RRD(ITR,ID)
|
|
END IF
|
|
C
|
|
C minimum value
|
|
C
|
|
IF(SWU.LT.SWTCH(ID)) SWTCH(ID)=SWU
|
|
IF(SWD.LT.SWTCH(ID)) SWTCH(ID)=SWD
|
|
END IF
|
|
END DO
|
|
IF(SWTCH(ID).LT.SWMIN) SWMIN=SWTCH(ID)
|
|
END DO
|
|
C
|
|
DO ID=1,ND
|
|
IF(ICRSW.EQ.1) THEN
|
|
CRSW(ID)=SWMIN*SWPFAC
|
|
ELSE
|
|
CRSW(ID)=SWTCH(ID)*SWPFAC
|
|
END IF
|
|
IF(CRSW(ID).GT.SWPLIM) CRSW(ID)=UN
|
|
END DO
|
|
WRITE(6,601) (CRSW(ID),ID=1,ND)
|
|
RETURN
|
|
C
|
|
C After second and further iterations of complete linearization
|
|
C evaluation of new collisional-radiative switching parameters
|
|
C by multiplication of the previous ones by a prechosen factor
|
|
C SWPINC
|
|
C
|
|
10 CONTINUE
|
|
DO ID=1,ND
|
|
CRSW(ID)=CRSW(ID)*SWPINC
|
|
IF(CRSW(ID).GT.SWPLIM) CRSW(ID)=UN
|
|
END DO
|
|
WRITE(6,601) (CRSW(ID),ID=1,ND)
|
|
601 FORMAT(1P8D10.3)
|
|
RETURN
|
|
END
|