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  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
C      WRITE(*,*) HH,CC,EE,HCE
      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.
          ITTYPE(I,J)=0
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/SPIN CHANGING
C  TRTYPE(I,J)=-3 : E1 FORBIDDEN/SPIN CHANGING
C  TRTYPE(I,J)= 0 : 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)
        IF(NQ(KR).GT.MQ) CALL STOP('ATOM: NQ.GT.MQ')
        IF(QMAX(KR).LT.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)
C	WRITE(*,*) I,J,KR,HCE,EV(J),EV(I),ALAMB(KR),F(KR),G(I),G(J),A(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
