git push -u origin main

2026-03-19 14:05:33 +08:00
commit 1e30b7bc63
739 changed files with 572150 additions and 0 deletions
@@ -0,0 +1,97 @@
+      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