C C PURPOSE: READS AN ATOMIC MODEL C C INPUTS: NONE C C OUTPUTS: SETS VARIABLES IN CATOM C C COMMON: C CATOM CSLINE CLU CATMOS C COMMENTS: OCTOBER 6, 1999, P. JUDGE C MODIFICATIONS: C JANUARY 11, 2006. CHECK ON MJMAX GE MAX(J) (PGJ) C SUBROUTINE ATOM C C READS AN ATOMIC MODEL AND CALCULATES EINSTEIN A,B COEFFICIENTS. C C A : EINSTEIN A COEFFICIENT C B : B C C NK : NUMBER OF LEVELS, CONTINUUM LEVELS INCLUDED C NRAD : NUMBER OF RADIATIVE TRANSITIONS C NLINE : NUMBER OF BOUND-BOUND TRANSITIONS C NCONT : NUMBER OF BOUND-FREE TRANSITIONS I DETAIL C IWIDE : =.TRUE. FOR FREQUENCY DEPENDENT TRANSITIONS C (CONTINUA AND WIDE LINES) C KTRANS(K) TRANSITION NUMBER K IS FREQUENCY DEPENDENT C TRANSITION NUMBER KTRANS C (NOTE - NRFIX Comment not in Phil's latest 6jul22 distribution) C NRFIX : NUMBER OF TRANSITIONS WITH FIXED RATES C FOR FIXED RATES VARIABLES SEE ROUTINE FIXRAD C IRAD(K): LOWER LEVEL FOR RADIATIVE TRANSITION K C JRAD(K): UPPER '' C ALAMB : VACUUM WAVELENGTH IN ANGSTROM C IN PRINTOUT ROUTINES IT IS PRINTED AS EITHER VACUUM OR AIR C DEPENDING ON THE VALUE (.LT.2000 VACUUM, .GT.2000 AIR) C HNY4P : H*NY/4PI, NY IN UNITS OF A TYPICAL DOPPLER WIDTH C G : STATISTICAL WEIGHT C F : FOR LINES : OSCILLATOR STRENGTH C FOR CONTINUA: CROSS-SECTION AT LIMIT C THE WAVELENGTH DEPENDENCE OF THE CROSS-SECTION IS C ASSUMED TO BE A=A0*(NY0/NY)**3 IF NOT GIVEN EXPLICITLY C EV : ENERGY IN EV INPUT IN CM-1 C C IND IS SET TO 2 FOR WIDE LINES AND 1 FOR CONTINUA C INCLUDE 'PREC' INCLUDE 'PARAM' INCLUDE 'CATOM' INCLUDE 'CATMOS' INCLUDE 'CSLINE' INCLUDE 'CCONST' INCLUDE 'CINTS' INCLUDE 'CLU' C CHARACTER TEXT*80 LOGICAL SALLOW,PALLOW C C C CALL FROM START. CALCULATE CONSTANTS AND READ FILE ATOM C HCE=HH*CC/EE*1.E8 HC2=2.*HH*CC *1.E24 HCK=HH*CC/BK*1.E8 EK=EE/BK HNY4P=HH*CC/QNORM/FOUR/PI*1.E-5 CALL CSTRIP(LATOM,'ATOM') C C READ INPUT VALUES AND LEFT JUSTIFY ATOMID C READ(LDUMS,40) ATOMID 40 FORMAT(A) CALL LJUST(ATOMID) C READ(LDUMS,*) ABND,AWGT AWGT=AWGT*UU READ(LDUMS,*) NK,NLINE,NCONT,NRFIX NRAD=NLINE+NCONT IF(NK.GT.MK) CALL STOP('ATOM: NK.GT.MK') IF(NRAD.GT.MRAD) CALL STOP('ATOM: NRAD.GT.MRAD') IF(NLINE.GT.MLINE) CALL STOP('ATOM: NLINE.GT.MLINE') IF(NRFIX.GT.MRFIX) CALL STOP('ATOM: NRFIX.GT.MRFIX') C C WHILE READING, CHECK THAT JUST ONE ION IS PRESENT C JMX=0 DO 120 I=1,NK READ(LDUMS,*) EV(I),G(I),LABEL(I),ION(I), * QNS(I),QNL(I),QNJ(I),IQNP(I),GLAND(I) IF(QNJ(I) .GT. MJMAX) CALL STOP(' ATOM: MJMAX IS TOO SMALL') IIJ=INT((G(I)-ONE)/TWO) IF(JMX .LT. IIJ) JMX=IIJ EV(I)=EV(I)*CC *HH/EE IF(ION(I) .NE. ION(1)) * CALL STOP(' ATOM: MUST CONTAIN JUST ONE ION STAGE') CALL LJUST(LABEL(I)) C C DEFINE MK X MK ARRAYS C DO 110 J=1,NK KRAD(I,J)=0 B(I,J)=0. C (Note this changed in Phils 6jul22 dist- before was set to 0 ITTYPE(I,J)=4 C C USE QUANTUM NUMBERS TO IDENTIFY THE TYPE OF TRANSITION C TRTYPE(I,J)=+1 : E1 C TRTYPE(I,J)=+2 : E2 C TRTYPE(I,J)=-1 : M1 C TRTYPE(I,J)=+3 : E1 ALLOWED / SPIN CHANGING C TRTYPE(I,J)=-3 : E1 FORBIDDEN / SPIN CHANGING C (note this next line was set to 0 pre 6jul22) C TRTYPE(I,J)= 4 : OTHERWISE C C SPIN ALLOWED? SALLOW=QNS(I).EQ.QNS(J) C PARITY CHANGE? PALLOW=(IQNP(I).NE.IQNP(J)) C E1: ISUMM=NINT(QNJ(I)+QNJ(J)) IDIFF=NINT(ABS(QNJ(I)-QNJ(J))) IF(SALLOW .AND. PALLOW .AND. ISUMM.NE.0 .AND. IDIFF.LE.1) * ITTYPE(I,J)=1 C E2: IF(SALLOW.AND.(.NOT. PALLOW).AND.ISUMM.GE.2 * .AND.IDIFF.LE.2) ITTYPE(I,J)=2 C M1: IF(SALLOW .AND. (.NOT. PALLOW) .AND. ISUMM.NE.0 * .AND. IDIFF.LE.1) ITTYPE(I,J)=-1 C E1 BUT SPIN CHANGING IF((.NOT. SALLOW) .AND. PALLOW .AND. ISUMM.NE.0 * .AND. IDIFF.LE.1) ITTYPE(I,J)=3 C E1-FORBIDDEN BUT SPIN CHANGING IF((.NOT. SALLOW) .AND. (.NOT. PALLOW) .AND. ISUMM.NE.0 * .AND. IDIFF.LE.2) ITTYPE(I,J)=-3 ITTYPE(J,I)=ITTYPE(I,J) 110 CONTINUE 120 CONTINUE IF(JMX.GT.MJMAX) CALL STOP('ATOM: MAX(J).GT.MJMAX') C C BOUND-BOUND TRANSITIONS IN DETAIL C CALCULATE LAMBDA, A AND B C IF QMAX OR Q0.LT.0 FREQUENCY POINTS IN DOPPLER UNITS ARE READ C KT=0 DO 200 KR=1,NLINE READ(LDUMS,*) J,I,F(KR),NQ(KR),QMAX(KR),Q0(KR),IO, * GA(KR),GW(KR),GQ(KR) c Note this was introduced with 6jul22 IF(NQ(KR).LT.3) CALL STOP('ATOM: NQ.LT.3 NEED MORE FREQUENCIES') IF(NQ(KR).GT.MQ) CALL STOP('ATOM: NQ.GT.MQ') C note this next line was LT not LE pre 6jul22 IF(QMAX(KR).LE.0.0 .OR. Q0(KR).LT.0.0) THEN READ(LDUMS,*) (Q(NY,KR),NY=1,NQ(KR)) IF(ABS(Q(2,KR)).LT.ABS(Q(1,KR)) .AND. * ABS(Q(NQ(KR),KR)).GT.ABS(Q(NQ(KR)-1,KR))) IND(KR)=2 DO 150 NY=2,NQ(KR) IF(Q(NY,KR).LT.Q(NY-1,KR)) THEN CALL STOP('ATOM: Q NOT MONOTONICALLY INCREASING') ENDIF 150 CONTINUE ENDIF C C SET IWIDE = 1 FOR ALL LINES (I.E. DO FULL PROFILES) C C IWIDE(KR)=IO.EQ.1 IWIDE(KR)=.TRUE. IF(IWIDE(KR)) THEN KT=KT+1 KTRANS(KR)=KT IND(KR)=2 ENDIF KRAD(I,J)=KR KRAD(J,I)=KR IRAD(KR)=I JRAD(KR)=J ALAMB(KR)=HCE/(EV(J)-EV(I)) A(KR)=F(KR)*6.671E15*G(I)/G(J)/ALAMB(KR)/ALAMB(KR) B(J,I)=ALAMB(KR)**3/HC2*A(KR) B(I,J)=G(J)/G(I)*B(J,I) 200 CONTINUE IF(KT+NRAD-NLINE.GT.MWIDE) CALL STOP('ATOM: NWIDE.GT.MWIDE') C C BOUND-FREE TRANSITIONS IN DETAIL C IF QMAX.LT.0.0 FREQUENCY POINTS IN ANGSTROM (STARTING WITH C THRESHOLD AND DECREASING) AND CROSSECTIONS IN CM2 ARE READ. C UNIT CONVERSION IN ROUTINE FREQC C DO 250 KR=NLINE+1,NRAD READ(LDUMS,*) J,I,F(KR),NQ(KR),QMAX(KR) IF(NQ(KR).GT.MQ) CALL STOP('ATOM: NQ.GT.MQ') IF(QMAX(KR).LT.0.0) THEN READ(LDUMS,*) (Q(NY,KR),ALFAC(NY,KR-NLINE),NY=1,NQ(KR)) DO 230 NY=2,NQ(KR) IF(Q(NY,KR).GT.Q(NY-1,KR)) THEN WRITE(LJOBLO,220) KR-NLINE 220 FORMAT(' ATOM: CONTINUUM TRANSITION NR',I3/ * ' WAVELENGTHS NOT DECREASING') CALL STOP(' ') ENDIF 230 CONTINUE ENDIF KTRANS(KR)=KR-NLINE+KT IRAD(KR)=I JRAD(KR)=J KRAD(I,J)=KR KRAD(J,I)=KR GA(KR)=0. GW(KR)=0. GQ(KR)=0. IWIDE(KR)=.TRUE. IND(KR)=1 ALAMB(KR)=HCE/(EV(J)-EV(I)) 250 CONTINUE C C READ CHOICE OF COLLISIONAL SUBROUTINE C READ(LDUMS,40) TEXT CALL LJUST(TEXT) CROUT=TEXT(1:6) C RETURN END C C*********************************************************************** C