87 lines
2.7 KiB
Fortran
87 lines
2.7 KiB
Fortran
SUBROUTINE IDMTAB
|
|
C =================
|
|
C
|
|
C output of selected molecular line parameters (identification table)
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'LINDAT.FOR'
|
|
|
|
COMMON/REFDEP/IREFD(MFREQ)
|
|
COMMON/RTEOPA/CH(MFREQ,MDEPTH),ET(MFREQ,MDEPTH),
|
|
* SC(MFREQ,MDEPTH)
|
|
|
|
CHARACTER*4 APB,AP0,AP1,AP2,AP3,AP4,APR
|
|
C
|
|
|
|
PARAMETER (C1=2.3025851, C2=4.2014672, C3=1.4387886)
|
|
DATA APB,AP0,AP1,AP2,AP3,AP4 /' ',' .',' *',' **',' ***',
|
|
* '****'/
|
|
C
|
|
ALM0=2.997925D18/FREQ(1)
|
|
ALM1=2.997925D18/FREQ(2)
|
|
if(ifwin.gt.0) ALM1=2.997925D18/FREQ(NFREQ)
|
|
IF(IPRIN.LE.-2) RETURN
|
|
if(iprin.ge.3) then
|
|
IF(IMODE.GE.0) WRITE(6,601) IBLANK,ALM0,ALM1
|
|
IF(IMODE.GE.0.OR.(IMODE.EQ.-1.AND.IBLANK.EQ.1)) WRITE(6,602)
|
|
end if
|
|
C
|
|
ID=IDSTD
|
|
DO 100 ILIST=1,NMLIST
|
|
IF(NLINML(ILIST).EQ.0) GO TO 100
|
|
DO IL0=1,NLINML(ILIST)
|
|
IL=INMLIN(IL0,ILIST)
|
|
ALAM=2.997925D18/FREQM(IL,ILIST)
|
|
c ID=IDSTD
|
|
IJCN=IJCMTR(IL0,ILIST)
|
|
c IF(IJCN.GE.1.AND.IJCN.LE.NFREQS) ID=IREFD(IJCN)
|
|
IMOL=INDATM(IL,ILIST)
|
|
DOP1=DOPMOL(IMOL,ID)
|
|
ANE=ELEC(ID)
|
|
AGAM=(GRM(IL,ILIST)+GSM(IL,ILIST)*ANE+
|
|
* GVDW(IL,ILIST,ID))*DOP1
|
|
ABCNT=EXP(GFM(IL,ILIST)-EXCLM(IL,ILIST)/TEMP(ID))*
|
|
* RRMOL(IMOL,ID)*DOP1*STIM(ID)
|
|
absta=min(ch(1,id),ch(2,id))
|
|
str0=abcnt/absta
|
|
if(ifwin.gt.0) STR0=ABCNT/ABSTDW(IJCONT(IL),ID)
|
|
GF=(GFM(IL,ILIST)+C2)/C1
|
|
EXCL=EXCLM(IL,ILIST)/C3
|
|
IF(STR0.LE.1.2) THEN
|
|
WW1=0.886*STR0*(1.-STR0*(0.707-STR0*0.577))
|
|
ELSE
|
|
WW1=SQRT(LOG(STR0))
|
|
END IF
|
|
IF(STR0.GT.55.) THEN
|
|
WW2=0.5*SQRT(3.14*AGAM*STR0)
|
|
IF(WW2.GT.WW1) WW1=WW2
|
|
END IF
|
|
EQW=ALAM/FREQM(IL,ILIST)*1.E3/DOP1*WW1
|
|
STR=EQW*10.
|
|
APR=APB
|
|
IF(STR.GE.1.E0.AND.STR.LT.1.E1) APR=AP0
|
|
IF(STR.GE.1.E1.AND.STR.LT.1.E2) APR=AP1
|
|
IF(STR.GE.1.E2.AND.STR.LT.1.E3) APR=AP2
|
|
IF(STR.GE.1.E3.AND.STR.LT.1.E4) APR=AP3
|
|
IF(STR.GE.1.E4) APR=AP4
|
|
if(alam.ge.alm0.and.alam.lt.alm1) then
|
|
WRITE(15,603) ALAM,CMOL(IMOL),GF,EXCL,
|
|
* STR0,EQW,APR,id,AGAM
|
|
end if
|
|
END DO
|
|
C
|
|
601 FORMAT(/' ',I4,'. SET (MOLECULAR LINES):',
|
|
* ' INTERVAL ',F9.3,' -',F9.3,' ANGSTROMS'/
|
|
* ' ------------')
|
|
602 FORMAT(/1H ,13X,
|
|
* 'LAMBDA MOLECULE LOG GF ELO LINE/CONT',2X,
|
|
* 'EQ.WIDTH',8x,'AGAM'/)
|
|
603 FORMAT(F11.3,2X,A4,4X,F7.2,F12.3,1PE11.2,0PF8.1,1X,A4,
|
|
* i4,1PE10.2)
|
|
C
|
|
100 CONTINUE
|
|
RETURN
|
|
END
|