Initial commit

1 files changed, 131 insertions, 0 deletions

diff --git a/synthe/synbeg.for b/synthe/synbeg.for
new file mode 100644
index 0000000..3ab1597
--- /dev/null
+++ b/synthe/synbeg.for
@@ -0,0 +1,131 @@
+      PROGRAM SYNBEG
+c     revised 18oct99
+C
+C     SYNBEG IS THE FIRST PROGRAM IN THE SYNTHE SERIES.
+C     IT READS THE INPUT PARAMETERS AND INITIALIZES TAPES 12 AND 13.
+C     SUBSEQUENT PROGRAMS READ THE ATOMIC AND MOLECULAR LINE DATA
+C     AND WRITE DATA ON TAPES 12 AND 13 FOR LINES FALLING IN
+C     THE WAVELENGTH INTERVAL.  SYNTHE READS TAPES 12 AND 13.
+C     PARAMETERS ARE PASSED FROM PROGRAM TO PROGRAM VIA TAPE 93.
+C     LINES ARE INCLUDED OR LEFT OUT BY INCLUDING OR LEAVING OUT THE
+C     PROGRAM THAT READS THEM.  THE NAMES OF ALL THE READING PROGRAMS
+C     BEGIN WITH R.  A SUFFIX P MEANS THAT THE PROGRAM READS BOTH
+C     PREDICTED AND REAL WAVELENGTHS.  THE P PROGRAMS SHOULD NOT BE USED
+C     FOR MAKING DETAILED LINE BY LINE COMPARISONS WITH OBSERVATIONS.
+C     THE ORDER OF THESE READING PROGRAMS DOES NOT MATTER
+CCC     EXCEPT FOR RNLTE, RLINE, RKP, AND RKPP, WHICH MUST
+C     EXCEPT FOR RNLTE, RLINE, AND RGFIRON WHICH MUST
+C     COME FIRST AND IN RELATIVE ORDER IF THEY ARE USED.
+C
+C     RNLTE READS THE NLTE LINE LIST AND SENDS THE DATA EITHER TO SPECTR
+C     (IFNLTE=1, N19=0) OR TO SYNTHE (IFNLTE=0, N19=NUMBER OF LINES IN
+C     LTE) IF THE LINES ARE TO BE TREATED IN LTE.  IN EITHER CASE THE
+C     LINES ARE WRITTEN ON TAPE 19.
+C
+CCC     RLINE READS ADDITIONS AND CORRECTIONS TO KP.
+C     RLINE READS ADDITIONS AND CORRECTIONS TO GFIRON.
+C
+CCCC     RKP READS KP.  IT ALSO READS A FILE DELETEKP OF LINE NUMBERS
+CCCC     OF LINES THAT ARE TO BE DELETED AND STORES THEM IN ARRAY
+CCCC     NDELET.  RNLTE AND RLINE WRITE IN THIS ARRAY IF THEY HAVE A
+CCCC     LINE THAT IS ALSO IN KP.  A LIST OF IONS TO BE TOTALLY DELETED
+CCCC     FROM KP IS ALSO INCLUDED ON DELETEKP AND IS STORED IN ARRAY NELDLT.
+C     RGFIRON READS GFIRON.  IT ALSO READS A FILE DELETEGFIRON OF LINE NUMBERS
+C     OF LINES THAT ARE TO BE DELETED AND STORES THEM IN ARRAY
+C     NDELET.  RNLTE AND RLINE WRITE IN THIS ARRAY IF THEY HAVE A
+C     LINE THAT IS ALSO IN GFIRON.  A LIST OF IONS TO BE TOTALLY DELETED
+C     FROM GFIRON IS ALSO INCLUDED ON DELETEGFIRON AND IS STORED IN ARRAY NELDLT.
+C     THE PRESENT TIME ATLAS7 CANNOT TREAT THE LINES ABOVE THE FIFTH STAGE OF
+C     IONIZATION BECAUSE PFSAHA HAS NOT YET BEEN REWRITTEN.
+C
+CCCC     RKPP READS PREDICTED KP LINES FROM THE MILLION LINE TAPE.
+C
+C     RBELL READS BELLLIGHT.DAT AND BELLHEAVY.DAT.  THESE ARE THE LIGHT AND
+C     HEAVY ELEMENTS, I.E., NOT IRON GROUP, FROM KP AND VARIOUS LABORATORY
+C     SOURCES.  THE LISTS WERE PREPARED BY BARBARA BELL.  SOME OF THE LINES ARE
+C     GUESSED SO THAT A LINE WILL APPEAR IN THE RIGHT POSITION EVEN IF IT HAS
+C     THE WRONG LOG GF.
+C
+C             DO NOT USE THESE DATA BLINDLY FOR AN ABUNDANCE ANALYSIS.
+C
+      PARAMETER (kw=99)
+      DIMENSION DECKJ(7,kw)
+      REAL*8 WLBEG,WLEND,RESOLU,RATIO,RATIOLG
+      REAL*8 WBEGIN,WLLAST
+      DATA DECKJ/kw*0.,kw*0.,kw*0.,kw*0.,kw*0.,kw*0.,kw*0./
+      READ(5,1)AIRVAC,WLBEG,WLEND,RESOLU,TURBV,IFNLTE,LINOUT,
+     1CUTOFF,IFPRED,NREAD
+    1 FORMAT(A3,7X,4F10.4,I3,I7,F10.5,2I5)
+      WRITE(6,2)AIRVAC,WLBEG,WLEND,RESOLU,TURBV,IFNLTE,LINOUT,
+     1CUTOFF,IFPRED,NREAD
+    2 FORMAT(1H0,A3,9H   WLBEG=,F10.4,9H   WLEND=,F10.4,
+     1 10H   RESOLU=,F10.1,9H   TURBV=,F5.2,10H   IFNLTE=,I1,
+     2 10H   LINOUT=,I6,10H   CUTOFF=,F7.5,10H   IFPRED=,I1/
+     3 8H   NREAD,I3)
+C      RESOLU IS THE RESOLUTION OF THE POINT SPACING IN WL/DELTA WL
+C         THUS .001 NM AT 500 NM IS 500000.
+C     TURBV IS ADDED TO ANY MICROTURBULENCE ALREADY PRESENT IN THE MODEL
+C     IFNLTE=0 SYNTHE COMPUTES NLTELINES IN LTE
+C     IFNLTE=1 SPECTR COMPUTES NLTELINES IN NLTE
+C     LINOUT IS LIMIT ON PRINTOUT OF SPECTRUM
+C
+C     LINOUT IS ALSO A SWITCH THAT TURNS OFF SAVING LINE DATA IN ORDER TO
+C        SPEED UP THE PROGRAMS AND SAVE ON STORAGE.  IF LINOUT.LT.0 LINE
+C        DATA ARE NOT SAVED.  IF LINOUT.GE.0 LINE DATA ARE SAVED.
+C
+C     IFVAC DOES NOT WORK PROPERLY FOR ALL LINES ON THE KP TAPE
+C     CUTOFF IS THE FRACTION OF THE CONTINUUM OPACITY BELOW WHICH
+C        WINGS OF LINES ARE NOT COMPUTED
+C     IFPRED=0 LEAVE OUT LINES WITH PREDICTED WAVELENGTHS
+C     IFPRED=1 USE ALL LINES
+C     IF NREAD GT 0   READ NREAD CARDS CONTAINING DEPTH DEPENDENT
+C         VARIABLES FOR THE MODEL SUCH AS DEPTH DEPENDENT DOPPLER
+C         SHIFTS AND MAGNETIC FIELDS.  UP TO SEVEN VARIABLES ARE PASSED.
+      IFVAC=1
+      IF(AIRVAC.EQ.3HAIR)IFVAC=0
+      IF(AIRVAC.EQ.3HVAC)IFVAC=1
+      RATIO=1.+1./RESOLU
+      RATIOLG=DLOG(RATIO)
+      IXWLBEG=DLOG(WLBEG)/RATIOLG
+      WBEGIN=DEXP(IXWLBEG*RATIOLG)
+      IF(WBEGIN.LT.WLBEG)THEN
+      IXWLBEG=IXWLBEG+1
+      WBEGIN=DEXP(IXWLBEG*RATIOLG)
+      ENDIF
+      IXWLEND=DLOG(WLEND)/RATIOLG
+      WLLAST=DEXP(IXWLEND*RATIOLG)
+      IF(WLLAST.GE.WLEND)THEN
+      IXWLEND=IXWLEND-1
+      WLLAST=DEXP(IXWLEND*RATIOLG)
+      ENDIF
+      LENGTH=IXWLEND-IXWLBEG+1
+      DWLBEG=WBEGIN*RATIO-WBEGIN
+      DWLLAST=WLLAST-WLLAST/RATIO
+      WRITE(6,3)LENGTH,RATIO,WBEGIN,DWLBEG,WLLAST,DWLLAST
+    3 FORMAT('0LENGTH=',I6,'   RATIO=',F12.10,'   WBEGIN=',F11.5,
+     1 '   DWLBEG=',F7.5,'   WLLAST=',F11.5,'   DWLLAST=',F7.5)
+      N19=0
+C      DO 5 ILINE=1,50000
+C    5 NDELET(ILINE)=0
+C      DO 6 NELION=1,594
+C    6 NELDLT(NELION)=1
+      NLINES=0
+      IF(NREAD.GT.0)THEN
+      READ(5,7)
+      DO 9 I=1,NREAD
+      READ(5,7)J,(DECKJ(K,J),K=1,7)
+    7 FORMAT(I3,7X,7F10.3)
+    9 WRITE(6,7)J,(DECKJ(K,J),K=1,7)
+      ENDIF
+      OPEN(UNIT=12,STATUS='NEW',FORM='UNFORMATTED')
+      CLOSE(UNIT=12)
+      OPEN(UNIT=14,STATUS='NEW',FORM='UNFORMATTED')
+      CLOSE(UNIT=14)
+      OPEN(UNIT=19,STATUS='NEW',FORM='UNFORMATTED')
+      CLOSE(UNIT=19)
+      OPEN(UNIT=20,STATUS='NEW',FORM='UNFORMATTED')
+      CLOSE(UNIT=20)
+      WRITE(93)NLINES,LENGTH,IFVAC,IFNLTE,N19,TURBV,DECKJ,IFPRED,
+     1WLBEG,WLEND,RESOLU,RATIO,RATIOLG,CUTOFF,LINOUT
+      CALL EXIT
+      END