98 lines
3.1 KiB
Fortran
98 lines
3.1 KiB
Fortran
SUBROUTINE IDTAB
|
|
C ================
|
|
C
|
|
C output of selected line parameters (identification table)
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'LINDAT.FOR'
|
|
CHARACTER*4 TYPION(30)
|
|
CHARACTER*4 APB,AP0,AP1,AP2,AP3,AP4,APR
|
|
COMMON/PRFQUA/DOPA1(MATOM,MDEPTH),VDWC(MDEPTH)
|
|
COMMON/REFDEP/IREFD(MFRQ)
|
|
COMMON/RTEOPA/CH(MFREQ,MDEPTH),ET(MFREQ,MDEPTH),
|
|
* SC(MFREQ,MDEPTH)
|
|
C
|
|
PARAMETER (C1=2.3025851, C2=4.2014672, C3=1.4387886)
|
|
DATA TYPION /' I ',' II ',' III',' IV ',' V ',
|
|
* ' VI ',' VII','VIII',' IX ',' X ',
|
|
* ' XI ',' XII','XIII',' XIV',' XV ',
|
|
* ' XVI','XVII',' 18 ',' XIX',' XX ',
|
|
* ' XXI','XXII',' 23 ','XXIV','XXV ',
|
|
* 'XXVI',' 27 ',' 28 ','XXIX',' XXX'/
|
|
DATA APB,AP0,AP1,AP2,AP3,AP4 /' ',' .',' *',' **',' ***',
|
|
* '****'/
|
|
C
|
|
IF(NLIN.EQ.0) GO TO 100
|
|
C
|
|
ALM0=2.997925D18/FREQ(1)
|
|
ALM1=2.997925D18/FREQ(2)
|
|
if(ifwin.gt.0) ALM0=2.997925D18/FRQOBS(1)
|
|
if(ifwin.gt.0) ALM1=2.997925D18/FRQOBS(NFREQ)
|
|
IF(IPRIN.LE.-2) RETURN
|
|
if(iprin.ge.2) then
|
|
c IF(IMODE.GE.0.OR.(IMODE.EQ.-1.AND.IBLANK.EQ.1)) WRITE(6,602)
|
|
end if
|
|
C
|
|
DO IL0=1,NLIN
|
|
IL=INDLIN(IL0)
|
|
ALAM=2.997925D18/FREQ0(IL)
|
|
ID=IDSTD
|
|
IJCN=IJCNTR(IL0)
|
|
ID0=0
|
|
IF(IJCN.GE.1.AND.IJCN.LE.NFREQS) ID0=IREFD(IJCN)
|
|
IF(ID0.GT.0.and.id0.lt.nd) ID=ID0
|
|
IAT=INDAT(IL)/100
|
|
ION=MOD(INDAT(IL),100)
|
|
CALL PROFIL(IL,IAT,ID,AGAM)
|
|
ABCNT=EXP(GF0(IL)-EXCL0(IL)/TEMP(ID))*RRR(ID,ION,IAT)*
|
|
* STIM(ID)
|
|
absta=min(ch(1,idstd),ch(2,idstd))
|
|
if(ifwin.le.0) then
|
|
DOP1=DOPA1(IAT,ID)
|
|
str0=abcnt*dop1/absta
|
|
else
|
|
DOP1=DOPA1(IAT,ID)/FREQ0(IL)
|
|
STR0=ABCNT*DOP1/ABSTDW(IJCONT(IL),ID)
|
|
end if
|
|
GF=(GF0(IL)+C2)/C1
|
|
EXCL=EXCL0(IL)/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/FREQ0(IL)*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
|
|
ill=ilown(il)
|
|
ilu=iupn(il)
|
|
if(ill.gt.0) ill=ill-nfirst(iel(ill))+1
|
|
if(ilu.gt.0) ilu=ilu-nfirst(iel(ilu))+1
|
|
|
|
WRITE(12,603) ALAM,TYPAT(IAT),TYPION(ION),GF,EXCL,
|
|
* STR0,EQW,APR,ill,ilu,id
|
|
end if
|
|
END DO
|
|
C
|
|
c 602 FORMAT(/1H ,13X,
|
|
c * 'LAMBDA ATOM LOG GF ELO LINE/CONT',2X,
|
|
c * 'EQ.WIDTH'/)
|
|
603 FORMAT(F11.3,2X,A4,A3,F7.2,F12.3,1PE11.2,0PF8.1,1X,A4,
|
|
* 3i4)
|
|
C
|
|
100 CONTINUE
|
|
RETURN
|
|
END
|