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,120 @@
+      SUBROUTINE XENINI
+C     =================
+C
+C     Initializes necessary arrays for evaluating hydrogen line profiles
+C     from the XENOMORPH tables
+C
+      INCLUDE 'PARAMS.FOR'
+      INCLUDE 'MODELP.FOR'
+C
+      DO I=1,4
+         DO J=1,22
+            ILXEN(I,J)=0
+         END DO
+      END DO
+      if(ihxenb.gt.0) then
+         ihxenb=23
+         ihxenr=ihxenb+1
+         open(unit=ihxenb,file='xenomorph.blue.dat',status='old')
+         open(unit=ihxenr,file='xenomorph.red.dat',status='old')
+         write(6,641) ihxenb,ihxenr
+       else
+         return
+      end if
+c
+  641 format(' -----------'/
+     *       ' reading XENOMORPH tables; ihxen =',2i3,/
+     *       ' -----------')
+C
+C ---------------------------------
+C     read  tables - blue wing
+C ---------------------------------
+C
+      ILINE=0
+      READ(IHXENB,*) NTAB
+      DO ITAB=1,NTAB
+      ILINEB=ILINE
+      READ(IHXENB,*) NLXEN
+      DO ILI=1,NLXEN
+         ILINE=ILINE+1
+         READ(IHXENB,*) I,J,ALMIN,ANEMIN,TMIN,DLA,DLE,DLT,
+     *                  NWL,NE,NT
+         XNEMIN=ANEMIN
+         ILXEN(I,J)=ILINE
+         NWLXEN(ILINE)=NWL
+         NTHXEN(ILINE)=NT
+         NEHXEN(ILINE)=NE
+         DO IWL=1,NWL
+            ALXEN(ILINE,IWL)=ALMIN+(IWL-1)*DLA
+         END DO
+         DO INE=1,NE
+            XNEXEN(INE,ILINE)=ANEMIN+(INE-1)*DLE
+         END DO
+         DO IT=1,NT
+            XTXEN(IT,ILINE)=TMIN+(IT-1)*DLT
+         END DO
+      END DO
+c
+      DO ILI=1,NLXEN
+         ILNE=ILINEB+ILI
+         NWL=NWLXEN(ILNE)
+         READ(IHXENB,500)
+         DO INE=1,NEHXEN(ILNE)
+            DO IT=1,NTHXEN(ILNE)
+               READ(IHXENB,*) QLT,(PRFXB(ILNE,IWL,IT,INE),IWL=1,NWL)
+            END DO
+         END DO
+C
+      END DO
+      END DO
+  500 FORMAT(1X)
+      CLOSE(IHXENB)
+C
+C ---------------------------------
+C     read  tables - red wing
+C ---------------------------------
+C
+      ILINE=0
+      READ(IHXENR,*) NTAB
+      DO ITAB=1,NTAB
+      ILINEB=ILINE
+      READ(IHXENR,*) NLXEN
+      DO ILI=1,NLXEN
+         ILINE=ILINE+1
+         READ(IHXENR,*) I,J,ALMIN,ANEMIN,TMIN,DLA,DLE,DLT,
+     *                  NWL,NE,NT
+      END DO
+c
+      DO ILI=1,NLXEN
+         ILNE=ILINEB+ILI
+         NWL=NWLXEN(ILNE)
+         READ(IHXENR,500)
+         DO INE=1,NEHXEN(ILNE)
+            DO IT=1,NTHXEN(ILNE)
+               READ(IHXENR,*) QLT,(PRFXR(ILNE,IWL,IT,INE),IWL=1,NWL)
+            END DO
+         END DO
+C
+      END DO
+      END DO
+C
+C     interpolation to the actual values of temperature and electron
+C     density
+C
+      do id =1,nd
+         tl=log10(temp(id))
+         anel=log10(elec(id))
+         do ili=1,nlxen
+            iline=ilineb+ili
+            nwl=nwlxen(iline)
+            do iwl=1,nwl
+               call intxen(prfb0,prfr0,tl,anel,iwl,iline)
+               prfb(iline,id,iwl)=prfb0
+               prfr(iline,id,iwl)=prfb0
+            end do
+         end do
+      end do
+      CLOSE(IHXENR)
+c
+      RETURN
+      END