PROGRAM LTE_SELECT *+ * Name: * LTE_SELECT * Purpose: * Select lines from an LTE_LINES linelist * Method: * An initial linelist (QUB format) may optionally be read in. * This will not be changed, but additional lines may be added. * * An additional linelist (QUB format) is read in, it may be in the * form of a Hubeny list, sorted by wavelength, or in some other order. * Individual lines may be selected using various criteria including * one or more of the following: * wavelength region * ions * oscillator strength * * Examples of use: * 1. Starting with an assessed list (such as created by "lte"), * add additional lines from large database (eg Kurucz & Petrymann) * 2. Starting with a large database (eg Kurucz & Petrymann) build * up a reduced list ion by ion * * * Version: * 14-Nov-2001: changed to new QUB linelsit format *- * I/O channels INTEGER NFILE PARAMETER ( NFILE = 99 ) INTEGER NOUT PARAMETER ( NOUT = 98 ) * Filenames CHARACTER*(72) FOLDL ! Name of file containing old line list CHARACTER*(72) FLINE ! Name of file containing database list CHARACTER*(72) FOUTL ! Name of file containing new line list * Main program parameters INTEGER NLINES ! Number of lines read into linelist LOGICAL CHECK_LIST LOGICAL CHECK_WL LOGICAL CHECK_GF LOGICAL CHECK_ION, MATCH_ION REAL WLMIN, WLMAX REAL GFMIN, XION INTEGER ION_NUM INTEGER ION_LIST(100), ION_ATOM(100) CHARACTER*(1) YESNO * Linelist Data INTEGER KL PARAMETER (KL=100000) ! Maximum number of lines allowed INTEGER NL ! Number of lines currently in the list INTEGER ISP(KL) ! Species number ! 0 < ISP < 93 INTEGER NION(KL) ! Ionization stage ! 1 - neutral ! 2 - once ionized etc. REAL WAVE(KL) ! Wavelength in Angstroms REAL GF(KL) ! gf-value REAL EDAM(KL) ! Electron damping ! Half-width-half-maximum in Angstroms ! for electron density 10**15 cm-3 REAL RDAM(KL) ! Radiative damping ! Half-width-half-maxima in Angstroms REAL WDAM(KL) ! Van der Waal's damping ! Half-width-half-maxima in Angstroms REAL EXC(KL) ! Excitation potential of lower level in eV REAL ZM(KL) ! Multiplet number (from Moore) ! UV multiplets are -ve, optical are +ve. * Error status ! INTEGER STATUS ! Global status *. * Define selection criteria WRITE (*,*) WRITE (*,*) ' LTE_SELECT ' WRITE (*,*) CHECK_LIST = .FALSE. WRITE (*,*) ' Read in an existing linelist (y/n) ' READ (*,'(A)') YESNO IF (YESNO.EQ.'y'.OR.YESNO.EQ.'Y') THEN CHECK_LIST = .TRUE. WRITE (*,*) ' Enter linelist filename ' READ (*,'(A)') FOLDL WRITE (*,*) ' Do not select lines within WTOL of old lines ' READ (*,*) WTOL ENDIF CHECK_WL = .FALSE. WRITE (*,*) ' Restrict wavelength range (y/n) ' READ (*,'(A)') YESNO IF (YESNO.EQ.'y'.OR.YESNO.EQ.'Y') THEN CHECK_WL = .TRUE. WRITE (*,*) ' Enter w_min, w_max ' READ (*,*) WLMIN, WLMAX ENDIF CHECK_GF = .FALSE. WRITE (*,*) ' Restrict gf - values (y/n) ' READ (*,'(A)') YESNO IF (YESNO.EQ.'y'.OR.YESNO.EQ.'Y') THEN CHECK_GF = .TRUE. WRITE (*,*) ' Enter log gf_min ' READ (*,*) GFMIN ENDIF CHECK_ION = .FALSE. WRITE (*,*) ' Restrict ions (y/n) ' READ (*,'(A)') YESNO IF (YESNO.EQ.'y'.OR.YESNO.EQ.'Y') THEN CHECK_ION = .TRUE. WRITE (*,*) ' Enter ion (one per line, -ve to finish) ' WRITE (*,*) ' Format zz.ee ' WRITE (*,*) ' eg Fe^0 = 26.00, C^++ = 6.01, N^all = 7.99 ' DO J = 1,100 READ (*,*) XION IF (XION.LT.0.) GO TO 80 ION_ATOM(J) = INT(XION) ION_LIST(J) = NINT(100. * (XION-FLOAT(ION_ATOM(J)))) + 1 ENDDO 80 ION_NUM = J - 1 WRITE (*,*)(ION_ATOM(J),ION_LIST(J),J=1,ION_NUM) ENDIF ! Get the filenames for database and new linelist WRITE (*,*) ' Enter filenames for input and output lists ' READ (*,'(A)') FLINE READ (*,'(A)') FOUTL OPEN (UNIT=NOUT,FILE=FOUTL,STATUS='UNKNOWN') ! ! If required, read in the old linelist and write it out to ! the new file ! NL = 0 IF (CHECK_LIST) THEN OPEN (UNIT=NFILE,FILE=FOLDL,STATUS='OLD') DO I=1,KL READ(NFILE,101,END=20) ISP(I),NION(I),WAVE(I),GF(I), : EDAM(I),RDAM(I),WDAM(I),EXC(I),ZM(I) WRITE (NOUT,101) ISP(I),NION(I),WAVE(I),GF(I), : EDAM(I),RDAM(I),WDAM(I),EXC(I),ZM(I) NL = NL + 1 ENDDO 20 CLOSE(NFILE) WRITE (*,*) NL, ' old lines written to ', FOUTL ENDIF ! ! Read in the new lines, test them against selection criteria ! and append to output file. ! OPEN (UNIT=NFILE,FILE=FLINE,STATUS='OLD') NOLD = NL DO I=1,1000000 READ(NFILE,101,END=10) ISPX,NIONX,WAVEX,GFX,EDAMX,RDAMX,WDAMX, : EXCX,ZMX 101 FORMAT(2I3,F9.3,F7.3,4F8.3,F7.2) IF (ISPX.EQ.-1) GOTO 10 ! Check the wavelength criterion IF ( (CHECK_WL .AND. WLMIN.LT.WAVEX .AND. WAVEX.LT.WLMAX) : .OR. .NOT. CHECK_WL ) THEN ! Check the gf-value criterion IF ( (CHECK_GF .AND. GFX.GT.GFMIN) .OR. .NOT. CHECK_GF ) THEN MATCH_ION = .TRUE. ! Check the ion seclection criterion IF ( CHECK_ION ) THEN MATCH_ION = .FALSE. DO J = 1,ION_NUM IF ( ISPX.EQ.ION_ATOM(J) .AND. : ( NIONX.EQ.ION_LIST(J) .OR. ION_LIST(J).GT.99 ) ) : MATCH_ION=.TRUE. ENDDO ENDIF ! Check whethe line already exists in database IF ( CHECK_LIST .AND. MATCH_ION ) THEN DO K = 1,NOLD IF ( ISPX.EQ.ISP(K) .AND. NIONX.EQ.NION(K) ) THEN IF ( ABS(WAVE(K)-WAVEX).LT.WTOL ) MATCH_ION = .FALSE. ENDIF ENDDO ENDIF ! If all checks were ok, append the line to the output list IF ( MATCH_ION .AND. EXCX.LT.100. ) THEN NL = NL + 1 WRITE (NOUT,101) : ISPX,NIONX,WAVEX,GFX,EDAMX,RDAMX,WDAMX,EXCX,ZMX ENDIF ENDIF ENDIF ENDDO 10 CLOSE(UNIT=NFILE) CLOSE(UNIT=NOUT) WRITE (*,*) NL-NOLD, ' lines added to ', FOUTL END