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