204 lines
6.0 KiB
Fortran
204 lines
6.0 KiB
Fortran
SUBROUTINE IROSET
|
|
C =================
|
|
C
|
|
C Initialization of opacity sampling for iron-peak lines
|
|
C
|
|
C IOBS = 2 : ALL lines except lines to autoionized levels
|
|
C IOBS = 1 : ALL lines
|
|
C IOBS = 0 : only lines between observed levels
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
REAL*4 VDOP,AGAM,SIG0,SIGT
|
|
PARAMETER (CSIG=0.0149736)
|
|
COMMON/LINED/WAVE(MLINE),VDOP(MLINE,MDODF),
|
|
& AGAM(MLINE,MDODF),SIG0(MLINE,MDODF),
|
|
& JTR(MLINE,2)
|
|
DIMENSION SIGT(MDODF,MFREQ),DML(MDEPTH)
|
|
C
|
|
JIDR(1)=1
|
|
IF(JIDS.EQ.0) THEN
|
|
JIDR(2)=INT(0.7*ND)
|
|
JIDR(3)=ND
|
|
JIDN=3
|
|
JIDC=2
|
|
ELSE
|
|
I=1
|
|
DO WHILE(JIDR(I).LT.ND)
|
|
I=I+1
|
|
JIDR(I)=JIDR(I-1)+JIDS
|
|
IF(JIDR(I).LE.INT(0.7*ND)) JIDC=JIDR(I)
|
|
END DO
|
|
JIDN=I
|
|
IF(JIDR(I).GT.ND) THEN
|
|
IF(JIDR(I-1).GE.ND-5) JIDN=JIDN-1
|
|
JIDR(JIDN)=ND
|
|
END IF
|
|
IF(JIDN.GT.MDODF)
|
|
& CALL QUIT(' Too many depths for Fe x-sections',JIDN,MDODF)
|
|
END IF
|
|
c
|
|
DO ID=1,ND
|
|
DML(ID)=LOG(DM(ID))
|
|
END DO
|
|
DO I=1,JIDN-1
|
|
DXI=DML(JIDR(I+1))-DML(JIDR(I))
|
|
DO ID=JIDR(I)+1,JIDR(I+1)
|
|
JIDI(ID)=I
|
|
XJID(ID)=(DML(JIDR(I+1))-DML(ID))/DXI
|
|
END DO
|
|
END DO
|
|
JIDI(1)=1
|
|
XJID(1)=1.
|
|
|
|
XFRMA=DLOG(FRS1)
|
|
IJD=INT(9./DDNU)
|
|
IF(IJD.LT.2) IJD=2
|
|
NFTT=0
|
|
NFTMX=0
|
|
C
|
|
DO 500 ION=1,NION
|
|
IND=INODF1(ION)
|
|
IF(IND.LE.0) GO TO 500
|
|
IF(NLLIM(ION).GE.NLEVS(ION)) THEN
|
|
DO ID=1,ND
|
|
DO I=NFIRST(ION),NLAST(ION)
|
|
WOP(I,ID)=UN
|
|
END DO
|
|
END DO
|
|
GO TO 500
|
|
END IF
|
|
C
|
|
C Set up superlevels and read line data
|
|
C
|
|
IOBS=IKOBS(ION)
|
|
CALL LEVCD(ION,IOBS)
|
|
CALL INKUL(ION,IOBS)
|
|
c
|
|
write(6,610) ion,typion(ion),nlinku
|
|
610 format(/' *** superlines for ',i4,': ',a4,
|
|
* ' selected internal lines:',i10)
|
|
if(nlinku.gt.mline)
|
|
* call quit('too many internal lines',nlinku,mline)
|
|
C
|
|
C Assign line to supertransition and compute cross-section
|
|
C
|
|
N1=NFIRST(ION)
|
|
NLII=NLAST(ION)-N1+1
|
|
DO IL=1,NLII-1
|
|
KEVL=0
|
|
KODL=0
|
|
IF(JEN(IL).LE.NEVKU(ION)) THEN
|
|
KEVL=JEN(IL)
|
|
ELSE
|
|
KODL=JEN(IL)-NEVKU(ION)
|
|
END IF
|
|
ILOK=N1+IL-1
|
|
DO IU=IL+1,NLII
|
|
IUPK=N1+IU-1
|
|
ITR=ITRA(ILOK,IUPK)
|
|
INDXPA=ABS(INDEXP(ITR))
|
|
W1=0.
|
|
W2=0.
|
|
IFRKU=0
|
|
NFT=0
|
|
NLT=0
|
|
KEVU=0
|
|
KODU=0
|
|
IF(JEN(IU).LE.NEVKU(ION)) THEN
|
|
KEVU=JEN(IU)
|
|
ELSE
|
|
KODU=JEN(IU)-NEVKU(ION)
|
|
END IF
|
|
IF(KEVL.NE.0) THEN
|
|
KEV=KEVL
|
|
KOD=KODU
|
|
IEO=0
|
|
GSUPER=YMKU(JEN(IL),1)
|
|
ELSE
|
|
KEV=KEVU
|
|
KOD=KODL
|
|
IEO=1
|
|
GSUPER=YMKU(JEN(IL)-NEVKU(ION),2)
|
|
END IF
|
|
DO IJ=1,MFREQ
|
|
DO I=1,MDODF
|
|
SIGT(I,IJ)=0.
|
|
END DO
|
|
END DO
|
|
FCOL=0.
|
|
DO 10 K=1,NLINKU
|
|
IF(KSEV(JTR(K,1)).NE.KEV) GO TO 10
|
|
IF(KSOD(JTR(K,2)).NE.KOD) GO TO 10
|
|
NLT=NLT+1
|
|
FRL=CAS/WAVE(K)
|
|
IJL=NINT((XFRMA-DLOG(FRL))/DXNU)+NFRS1
|
|
D0=ABS((FREQ(IJL)-FRL)/(FREQ(IJL)-FREQ(IJL+1)))
|
|
IF(D0.GT.HALF) THEN
|
|
DO WHILE(FRL.GT.FREQ(IJL))
|
|
IJL=IJL-1
|
|
END DO
|
|
DO WHILE(FRL.LT.FREQ(IJL))
|
|
IJL=IJL+1
|
|
END DO
|
|
D1=FRL-FREQ(IJL)
|
|
D2=FREQ(IJL-1)-FRL
|
|
IF(D2.LT.D1) IJL=IJL-1
|
|
END IF
|
|
IJ0=IJL-IJD
|
|
IJ1=IJL+IJD
|
|
IF(IJ0.LT.1) IJ0=1
|
|
IF(IJ1.GT.NFREQ) IJ1=NFREQ
|
|
IF(IFRKU.EQ.0) IFRKU=IJ0
|
|
NFT=IJ1-IFRKU+1
|
|
DO IJ=IJ0,IJ1
|
|
DNU=FREQ(IJ)-FRL
|
|
DO I=1,JIDN
|
|
VV=DNU*dble(VDOP(K,I))
|
|
PRFK=VOIGTE(real(VV),AGAM(K,I))/GSUPER
|
|
SIGT(I,IJ)=SIGT(I,IJ)+SIG0(K,I)*real(PRFK)
|
|
END DO
|
|
END DO
|
|
FCOL=FCOL+SIG0(K,JIDC)/VDOP(K,JIDC)
|
|
10 CONTINUE
|
|
OSC0(ITR)=0.
|
|
IF(INDXPA.EQ.3 .OR. INDXPA.EQ.4) OSC0(ITR)=STRLX
|
|
IF(FCOL.GT.0.) OSC0(ITR)=FCOL/GSUPER/CSIG
|
|
IF(NLT.GT.0) THEN
|
|
W1=CAS/FREQ(IFRKU)
|
|
W2=CAS/FREQ(IFRKU+NFT-1)
|
|
END IF
|
|
IF(NFT.GT.0) THEN
|
|
IFR0(ITR)=IFRKU
|
|
IFR1(ITR)=IFRKU+NFT-1
|
|
KFR0(ITR)=NFTT+1
|
|
KFR1(ITR)=NFTT+NFT
|
|
NFTT=NFTT+NFT
|
|
itrl=itr
|
|
DO IJ=IFR0(ITR),IFR1(ITR)
|
|
KJ=IJ-IFR0(ITR)+KFR0(ITR)
|
|
DO I=1,JIDN
|
|
sxx=log(dble(sigt(i,ij))+1.d-40)
|
|
SIGFE(I,KJ)=real(sxx)
|
|
END DO
|
|
END DO
|
|
END IF
|
|
IF(KJ.GT.MCFE)
|
|
& CALL QUIT(' Too many Fe cross-sect. to store',
|
|
& KJ,MCFE)
|
|
WRITE(41,313) IL,IU,W1,W2,IFRKU,NFT,NLT,OSC0(ITR)
|
|
IF(NFT.GT.NFTMX) NFTMX=NFT
|
|
END DO
|
|
END DO
|
|
500 CONTINUE
|
|
WRITE(10,*) ' Max. number of freq. per transition:',NFTMX
|
|
WRITE(10,*) ' Number of iron line cross-sections: ',NFTT
|
|
313 FORMAT(2I4,2F12.3,3I10,1PE12.3)
|
|
C
|
|
CALL IJALI2
|
|
RETURN
|
|
END
|