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,86 @@
+      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