144 lines
3.7 KiB
Fortran
144 lines
3.7 KiB
Fortran
SUBROUTINE MOLSET(ILIST)
|
|
C ========================
|
|
C
|
|
C Selection of molecular lines that may contribute,
|
|
C set up auxiliary fields containing line parameters.
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'LINDAT.FOR'
|
|
COMMON/LIMPAR/ALAM0,ALAM1,FRMIN,FRLAST,FRLI0,FRLIM
|
|
COMMON/BLAPAR/RELOP,SPACE0,CUTOF0,TSTD,DSTD,ALAMC
|
|
common/alendm/alend(mmlist)
|
|
SAVE IMLAST
|
|
C
|
|
DATA CNM /2.997925D17/
|
|
C
|
|
if(inactm(ilist).ne.0) return
|
|
IL0=0
|
|
IPRSEM(ILIST)=0
|
|
NLINM=0
|
|
IREADM(ILIST)=1
|
|
IF(IBLANK.LE.1.OR.IMODE.EQ.1.OR.IMODE.EQ.-1) IREADM(ILIST)=0
|
|
IF(IBLANK.LE.1) APREV=0.
|
|
ALA0=CNM/FREQ(1)
|
|
ALA1=CNM/FREQ(2)
|
|
c
|
|
c skip if current wavelength larger than the largest wavelngth in the
|
|
c line list
|
|
c
|
|
if(ala0.gt.alend(ilist)) then
|
|
inactm(ilist)=1
|
|
return
|
|
end if
|
|
c
|
|
FRMINM=CNM/ALA0
|
|
FRM=FRMINM
|
|
SPACE=SPACE0
|
|
IF(ALAMC.GT.0.) SPACE=SPACE0*ALA0/ALAMC
|
|
IF(SPACE0.LT.0.) SPACE=-SPACE0
|
|
|
|
CUTOFF=CUTOF0*0.2
|
|
DOPSTD=1.E7/ALA0*DSTD
|
|
DISTAN=0.15*DOPSTD
|
|
SPAC=3.E16/ALA0/ALA0*SPACE
|
|
DISTA0=0.14*SPAC
|
|
IF(IBLANK.GE.2.AND.IMODE.EQ.-1) IL0=IMLAST
|
|
FRLI0=FRMINM
|
|
ASTD=1.0
|
|
AVAB=ABSTD(IDSTD)*RELOP
|
|
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(IREADM(ILIST).EQ.1) THEN
|
|
IPRSEM(ILIST)=IPRSEM(ILIST)+1
|
|
IL0=INMLIP(IPRSEM(ILIST),ILIST)
|
|
IF(FREQM(IL0,ILIST).LT.FRMINM) THEN
|
|
IREADM(ILIST)=0
|
|
IL0=INMLIP(IPRSEM(ILIST)-1,ILIST)+1
|
|
END IF
|
|
ELSE
|
|
IL0=IL0+1
|
|
END IF
|
|
IF(IL0.GT.NLINM0(ILIST)) GO TO 210
|
|
FRLIM=FRLI0
|
|
FR0=FREQM(IL0,ILIST)
|
|
ALAM=CNM/FR0
|
|
C
|
|
IF(ALAM.LT.ALA0-CUTOFF) GO TO 20
|
|
IF(ALAM.GT.ALA1+CUTOFF) GO TO 210
|
|
C
|
|
C SECOND SELECTION : FOR LINE STRENGHTS
|
|
C
|
|
EXT=EXTINM(IL0,ILIST)
|
|
FRLI0=FR0-EXT-SPAC
|
|
IF(FRLI0.GT.FRLIM) FRLI0=FRLIM
|
|
IF(ALAM.LT.ALA0.AND.FR0-FRMINM.GT.EXT+SPAC) GO TO 20
|
|
IF(FREQ(NFREQS)-FR0.GT.EXT+SPAC) GO TO 20
|
|
C
|
|
NLINM=NLINM+1
|
|
if(nlinm.gt.mlinm) then
|
|
write(*,*) 'nlinm,mlinm',nlinm,mlinm
|
|
call quit('too many molecular lines in a set')
|
|
end if
|
|
INMLIN(NLINM,ILIST)=IL0
|
|
GO TO 20
|
|
c
|
|
c frequency indices of the line centers
|
|
c
|
|
210 CONTINUE
|
|
XX=FREQ(2)-FREQ(1)
|
|
DFRCON=NFREQ-3
|
|
DFRCON=-DFRCON/XX
|
|
IFRCON=INT(DFRCON)
|
|
DO 255 IL=1,NLINM
|
|
fr0=freqm(inmlin(il,ilist),ILIST)
|
|
XJC=3.+DFRCON*(FREQ(1)-FR0)
|
|
IJC=INT(XJC)
|
|
IJCMTR(IL,ILIST)=IJC
|
|
if(ijc.le.3.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
|
|
IJCMTR(IL,ILIST)=IJC
|
|
255 continue
|
|
C
|
|
DO IL=1,NLINM
|
|
INMLIP(IL,ILIST)=INMLIN(IL,ILIST)
|
|
END DO
|
|
NLINML(ILIST)=NLINM
|
|
IMLAST=INMLIN(NLINML(ILIST),ILIST)
|
|
C
|
|
CALL INIBLM
|
|
C
|
|
c write(6,611) inmlin(1,ilist),inmlin(nlinm,ilist),
|
|
c * 2.997925e18/freqm(inmlin(1,ilist),ILIST),
|
|
c * 2.997925e18/freqm(inmlin(nlinm,ilist),ILIST)
|
|
c 611 format('mols',2i7,2f10.3)
|
|
RETURN
|
|
END
|