git push -u origin main
This commit is contained in:
@@ -0,0 +1,354 @@
|
||||
SUBROUTINE INISET
|
||||
C =================
|
||||
C
|
||||
C SELECTION OF LINES THAT MAY CONTRIBUTE,
|
||||
C SET UP AUXILIARY FIELDS CONTAINING LINE PARAMETERS,
|
||||
C SET UP THE SET OF FREQUENCY POINTS
|
||||
C
|
||||
INCLUDE 'PARAMS.FOR'
|
||||
INCLUDE 'MODELP.FOR'
|
||||
INCLUDE 'SYNTHP.FOR'
|
||||
INCLUDE 'LINDAT.FOR'
|
||||
INCLUDE 'WINCOM.FOR'
|
||||
COMMON/LIMPAR/ALAM0,ALAM1,FRMIN,FRLAST,FRLI0,FRLIM
|
||||
COMMON/BLAPAR/RELOP,SPACE0,CUTOF0,TSTD,DSTD,ALAMC
|
||||
COMMON/CTRFUN/CINT1(MDEPTH),CINT2(MDEPTH),
|
||||
* CTRI(MDEPTH),CTRR(MDEPTH),XKAR(MDEPTH),
|
||||
* ABXLI(MFREQ),EMXLI(MFREQ),IJCTR(MFREQ)
|
||||
SAVE ILLAST
|
||||
C
|
||||
DATA CNM,CAS /2.997925D17,2.997925D18/
|
||||
c DATA C1,C2,C3 /2.3025851, 4.2014672, 1.4387886/
|
||||
C
|
||||
DO 10 I=1,MFRQ
|
||||
W(I)=0.
|
||||
IJCTR(I)=0
|
||||
10 CONTINUE
|
||||
C
|
||||
IL0=0
|
||||
IPRSET=0
|
||||
NLIN=0
|
||||
IREADP=1
|
||||
IRLIST=0
|
||||
IF(IBLANK.LE.1.OR.IMODE.EQ.1.OR.IMODE.EQ.-1) IREADP=0
|
||||
IF(IBLANK.LE.1) APREV=0.
|
||||
FRMIN=CNM/ALAM0
|
||||
FRM=FRMIN
|
||||
if(ifwin.le.0) then
|
||||
ij0=3
|
||||
else
|
||||
ij0=1
|
||||
end if
|
||||
IJ=IJ0
|
||||
FREQ(IJ0)=FRM
|
||||
SPACE=SPACE0
|
||||
IF(ALAMC.GT.0.) SPACE=SPACE0*ALAM0/ALAMC
|
||||
IF(SPACE0.LT.0.) SPACE=-SPACE0
|
||||
IF(IMODE.EQ.2) THEN
|
||||
NFRP=NFREQS+1
|
||||
W0=SPACE
|
||||
GO TO 105
|
||||
END IF
|
||||
C
|
||||
ISTR=0
|
||||
IJMAX=0
|
||||
IMOD1L=0
|
||||
if(ifwin.le.0) then
|
||||
CUTOFF=CUTOF0
|
||||
DOPSTD=1.E7/ALAM0*DSTD
|
||||
DISTAN=0.15*DOPSTD
|
||||
SPAC=3.E16/ALAM0/ALAM0*SPACE
|
||||
DISTA0=0.14*SPAC
|
||||
ASTD=1.0
|
||||
AVAB=ABSTD(IDSTD)*RELOP
|
||||
end if
|
||||
FRLI0=FRMIN
|
||||
IF(IBLANK.GE.2.AND.IMODE.EQ.-1) IL0=ILLAST
|
||||
C
|
||||
20 CONTINUE
|
||||
C
|
||||
C set up indices of lines
|
||||
C IL0 - is the current index of line in the numbering of all lines
|
||||
C
|
||||
IF(IREADP.EQ.1) THEN
|
||||
IPRSET=IPRSET+1
|
||||
IL0=INDLIP(IPRSET)
|
||||
IF(FREQ0(IL0).LT.FRMIN) THEN
|
||||
IREADP=0
|
||||
IL0=INDLIP(IPRSET-1)+1
|
||||
END IF
|
||||
ELSE
|
||||
IL0=IL0+1
|
||||
END IF
|
||||
IF(IL0.GT.NLIN0) GO TO 210
|
||||
FRLIM=FRLI0
|
||||
FR0=FREQ0(IL0)
|
||||
ALAM=CNM/FR0
|
||||
C
|
||||
if(ifwin.gt.0) then
|
||||
IF(ALAMC.GT.0.) SPACE=SPACE0*ALAM/ALAMC
|
||||
IF(SPACE0.LT.0.) SPACE=-SPACE0
|
||||
CUTOFF=CUTOF0*ALAM/ALAMC
|
||||
DOPSTD=1.E7/ALAM*DSTD
|
||||
DISTAN=0.15*DOPSTD
|
||||
SPAC=SPACE
|
||||
IF(MOD(IFREQ,10).GT.0) SPAC=3.E16/ALAM/ALAM*SPACE
|
||||
DISTA0=0.14*SPAC
|
||||
end if
|
||||
C
|
||||
C set up a different starting wavelength for IMODE=1
|
||||
C
|
||||
IF(IMODE.NE.1) GO TO 45
|
||||
IF(ISTR.EQ.1.OR.IJ.NE.3) GO TO 45
|
||||
IF(ALAM.LT.ALAM0+2.*CUTOFF) GO TO 45
|
||||
ALAM0=ALAM-CUTOFF+0.0001
|
||||
FRMIN=CNM/ALAM0
|
||||
FRM=FRMIN
|
||||
IJ=IJ0
|
||||
FREQ(IJ0)=FRM
|
||||
45 CONTINUE
|
||||
IF(ALAM.LT.ALAM0-CUTOFF) GO TO 20
|
||||
IF(IJ.LT.NFREQS+1) GO TO 50
|
||||
IF(ALAM.GT.ALAM1+CUTOFF) GO TO 210
|
||||
C
|
||||
C SECOND SELECTION : FOR LINE STRENGHTS
|
||||
C
|
||||
50 CONTINUE
|
||||
ISTR=0
|
||||
IF(IMODE.GE.1) THEN
|
||||
ISTR=1
|
||||
ELSE
|
||||
EXT=EXTIN(IL0)
|
||||
FRLI0=FR0-EXT-SPAC
|
||||
IF(FRLI0.GT.FRLIM) FRLI0=FRLIM
|
||||
frmiv=frmin
|
||||
if(ifwin.gt.0) frmiv=frmiv*(1.+vinf/2.997925e10)
|
||||
IF(ALAM.LT.ALAM0.AND.FR0-FRMIv.GT.EXT+SPAC) GO TO 20
|
||||
ISTR=1
|
||||
frmav=frmax
|
||||
if(ifwin.gt.0) frmav=frmav*(1.-vinf/2.997925e10)
|
||||
IF(IJ.GE.NFREQS+1.AND.FRMAv-FR0.GT.EXT+SPAC) GO TO 20
|
||||
END IF
|
||||
|
||||
C
|
||||
NLIN=NLIN+1
|
||||
if(nlin.gt.mlin) call quit(' too many lines in a set')
|
||||
INDLIN(NLIN)=IL0
|
||||
ALAMCU=ALAM+CUTOFF
|
||||
C
|
||||
C FREQUENCY POINTS AND WEIGHTS
|
||||
C
|
||||
IF(IJ.GE.NFREQS+1) GO TO 20
|
||||
IF(FR0.GT.FRMIN) GO TO 20
|
||||
100 DELT=ABS(FRM-FR0)
|
||||
IF(DELT.LT.DISTA0.AND.IMODE.NE.1) GO TO 20
|
||||
DFREL=CNM*(1.D0/FR0-1.D0/FRM)/SPACE
|
||||
NFRP=int(DFREL)+1
|
||||
IF(NFRP.LE.2) NFRP=2
|
||||
W0=CNM*(1.D0/FR0-1.D0/FRM)/NFRP
|
||||
FRM=FR0
|
||||
105 FRACT=FREQ(IJ)
|
||||
ALACT=CNM/FRACT
|
||||
C
|
||||
DO 110 K=1,NFRP
|
||||
FRACT=FRACT-W0
|
||||
ALACT=ALACT+W0
|
||||
IF(IMODE.GE.1.OR.NFRP.EQ.2) GO TO 107
|
||||
IF(FRACT.LT.FRLIM.AND.FRACT.GT.FR0+EXT+SPAC) GO TO 110
|
||||
107 IJ=IJ+1
|
||||
IF(IJ.GT.NFREQS) GO TO 130
|
||||
FREQ(IJ)=CNM/ALACT
|
||||
W(IJ)=W(IJ)+(FREQ(IJ-1)-FREQ(IJ))*0.5
|
||||
W(IJ-1)=W(IJ-1)+(FREQ(IJ-1)-FREQ(IJ))*0.5
|
||||
C IF(FREQ(IJ).LT.FRLAST) GO TO 220
|
||||
IF(IMODE.EQ.1.AND.ALACT.GT.ALAMCU) GO TO 140
|
||||
110 CONTINUE
|
||||
IJCTR(IJ)=IL0
|
||||
IF(IMOD1L.EQ.1) GO TO 210
|
||||
DISTA0=DISTAN
|
||||
GO TO 20
|
||||
C
|
||||
130 FRMAX=FREQ(NFREQS)
|
||||
ALAM1=CNM/FRMAX
|
||||
NFREQ=NFREQS
|
||||
IF(IMODE.EQ.2) GO TO 210
|
||||
IF(IMOD1L.EQ.1) GO TO 210
|
||||
GO TO 20
|
||||
C
|
||||
140 IJMAX=IJ
|
||||
IJMAX=MIN(IJMAX,NFREQS)
|
||||
NFREQ=IJMAX
|
||||
IF(IL0.LT.NLIN0) THEN
|
||||
NBLANK=IBLANK+1
|
||||
ELSE
|
||||
NBLANK=IBLANK
|
||||
END IF
|
||||
GO TO 240
|
||||
C
|
||||
210 NBLANK=IBLANK+1
|
||||
IF(IJ.GE.NFREQS+1) GO TO 230
|
||||
IJMAX=IJ
|
||||
IJMAX=MIN(IJMAX,NFREQS)
|
||||
NFREQ=IJMAX
|
||||
IF(IMODE.NE.1) GO TO 240
|
||||
IF(IMOD1L.EQ.1) GO TO 240
|
||||
C FR0=MAX(CNM/(ALAM+CUTOFF),FRLAST*0.99999999D0)
|
||||
FR0=FRLAST*0.99999999D0
|
||||
ALAM=CNM/FR0
|
||||
IMOD1L=1
|
||||
GO TO 100
|
||||
C
|
||||
230 IJMAX=NFREQS
|
||||
NFREQ=NFREQS
|
||||
240 IF(FREQ(IJMAX).LE.FRLAST) NBLANK=IBLANK
|
||||
if(alm00.gt.0.) then
|
||||
if(freq(ijmax).ge.0.999999*cnm/alm00.and.iblank.gt.1)
|
||||
* nblank=iblank
|
||||
end if
|
||||
c
|
||||
c correction for molecular lines
|
||||
c
|
||||
if(nmlist.gt.0.and.ifmol.gt.0) then
|
||||
do ilist=1,nmlist
|
||||
if(alastm(ilist).gt.0..and.alastm(ilist).le.alact) then
|
||||
nblank=iblank
|
||||
irlist=1
|
||||
c write(*,*) 'iniset mol',ilist,alastm(ilist),alam
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
c
|
||||
if(ifwin.le.0) then
|
||||
FREQ(1)=FREQ(3)
|
||||
FREQ(2)=FREQ(IJMAX)
|
||||
W(1)=0.5*(FREQ(1)-FREQ(2))
|
||||
W(2)=W(1)
|
||||
end if
|
||||
C
|
||||
C truncate the interval if the required end is reached
|
||||
C
|
||||
ijmx=2
|
||||
if(ifwin.gt.0) ijmx=ijmax
|
||||
IF(FREQ(ijmx).LT.FRLAST) THEN
|
||||
FREQ(ijmx)=FRLAST
|
||||
if(ifwin.le.0) then
|
||||
W(1)=0.5*(FREQ(1)-FREQ(2))
|
||||
W(2)=W(1)
|
||||
end if
|
||||
DO 245 IJ=IJ0,NFREQ
|
||||
IF(FREQ(IJ).LT.FRLAST) GO TO 247
|
||||
IJMAX=IJ
|
||||
245 CONTINUE
|
||||
247 NFREQ=IJMAX+1
|
||||
FREQ(NFREQ)=FRLAST
|
||||
W(NFREQ)=0.5*(FREQ(NFREQ-1)-FREQ(NFREQ))
|
||||
W(NFREQ-1)=W(NFREQ)+0.5*(FREQ(NFREQ-2)-FREQ(NFREQ-1))
|
||||
END IF
|
||||
C
|
||||
C frequency interpolation coefficients
|
||||
C
|
||||
IF(IMODE.NE.-1) THEN
|
||||
if(ifwin.le.0) then
|
||||
XX=FREQ(2)-FREQ(1)
|
||||
DO IJ=1,NFREQ
|
||||
WLAM(IJ)=2.997925E18/FREQ(IJ)
|
||||
FRX1(IJ)=(FREQ(IJ)-FREQ(1))/XX
|
||||
FRX2(IJ)=(FREQ(2)-FREQ(IJ))/XX
|
||||
END DO
|
||||
else
|
||||
DO IJ=1,NFREQ
|
||||
WLAM(IJ)=CAS/FREQ(IJ)
|
||||
frqobs(ij)=freq(ij)
|
||||
wlobs(ij)=wlam(ij)
|
||||
fr=freq(ij)
|
||||
BNUE(IJ)=BN*fr*fr*fr
|
||||
DO IJCI=1,NFREQC-1
|
||||
IF(WLAM(IJ).LE.WLAMC(IJCI)) GO TO 248
|
||||
END DO
|
||||
248 CONTINUE
|
||||
IJC=IJCI
|
||||
IJCINT(IJ)=MAX(IJC-1,1)
|
||||
IJCI=IJCINT(IJ)
|
||||
FRX1(IJ)=(FREQ(IJ)-FREQC(IJCI+1))/
|
||||
* (FREQC(IJCI)-FREQC(IJCI+1))
|
||||
END DO
|
||||
nfrobs=nfreq
|
||||
xx=freq(nfreq)-freq(1)
|
||||
end if
|
||||
c
|
||||
c frequency indices of the line centers
|
||||
c
|
||||
DFRCON=NFREQ-ij0
|
||||
DFRCON=-DFRCON/XX
|
||||
IFRCON=INT(DFRCON)
|
||||
DO 255 IL=1,NLIN
|
||||
fr0=freq0(indlin(il))
|
||||
XJC=3.+DFRCON*(FREQ(1)-FR0)
|
||||
IJC=INT(XJC)
|
||||
IJCNTR(IL)=IJC
|
||||
if(ijc.le.ij0.or.ijc.ge.nfreq) go to 255
|
||||
if(fr0.lt.freq(ijc)) then
|
||||
ijc0=ijc
|
||||
dfr0=freq(ijc0)-fr0
|
||||
252 ijc0=ijc0+1
|
||||
dfr=abs(freq(ijc0)-fr0)
|
||||
if(dfr.lt.dfr0) then
|
||||
ijc=ijc0
|
||||
ijc0=ijc0+1
|
||||
dfr0=dfr
|
||||
go to 252
|
||||
end if
|
||||
else if(fr0.gt.freq(ijc)) then
|
||||
ijc0=ijc
|
||||
dfr0=fr0-freq(ijc0)
|
||||
254 ijc0=ijc0-1
|
||||
dfr=abs(freq(ijc0)-fr0)
|
||||
if(dfr.lt.dfr0) then
|
||||
ijc=ijc0
|
||||
ijc0=ijc0-1
|
||||
dfr0=dfr
|
||||
go to 254
|
||||
end if
|
||||
end if
|
||||
IJCNTR(IL)=IJC
|
||||
255 continue
|
||||
END IF
|
||||
C
|
||||
if(ifwin.gt.0) then
|
||||
C
|
||||
c set up switches for hydrogen and He II line opacity
|
||||
c
|
||||
DO IJ=1,NFREQ
|
||||
call hylsew(ij)
|
||||
call he2sew(ij)
|
||||
end do
|
||||
end if
|
||||
C
|
||||
NSP=0
|
||||
DO 260 IL=1,NLIN
|
||||
IL0=INDLIN(IL)
|
||||
ISP=ISPRF(IL0)
|
||||
IF(ISP.GT.5) THEN
|
||||
NSP=NSP+1
|
||||
ISP0(NSP)=ISP
|
||||
END IF
|
||||
INDLIP(IL)=INDLIN(IL)
|
||||
260 CONTINUE
|
||||
if(ifwin.le.0) then
|
||||
ILLAST=INDLIN(NLIN)
|
||||
else
|
||||
ILLAST=0
|
||||
IF(NLIN.GT.0) ILLAST=INDLIN(NLIN)
|
||||
end if
|
||||
C
|
||||
CALL READPH
|
||||
C
|
||||
IF(ALAM0.LE.APREV+0.001) NBLANK=IBLANK
|
||||
APREV=ALAM0
|
||||
ALAM0=ALAM1
|
||||
ALM00=CNM/FREQ(NFREQ)
|
||||
c
|
||||
c write(6,611) iblank,nblank,irlist,aprev*10.,alam0*10.
|
||||
c 611 format('inis ',2i6,i3,3f10.3)
|
||||
RETURN
|
||||
END
|
||||
Reference in New Issue
Block a user