C C PURPOSE: CONVERTS "MULTI" RADIATIVE ATOMIC TRANSITION PROBABILITIES C TO THOSE NEEDED FOR FORMALISM OF C CASINI, R. & JUDGE, P. G., 1999. AP J 522, 524-539 C C INPUTS: C C OUTPUTS (COMMON): C AJ REAL QUANTUM NUMBER J OF A LEVEL C ECOEFF(I,J) EINSTEIN A-COEFFICIENT (I > J) C ECOEFF(I,J) 2*PI* B COEFFICIENT (I < J) C COMMON: C CATOM, CATMOS, CSLINE, CCONST, CLU, CSE, C COMMENTS: OCTOBER 6, 1999, P. JUDGE C SUBROUTINE ATOM1 C C FILLS ARRAYS J, ECOEFF, FOR USE WITH ROBERTO'S SUBROUTINES C INCLUDE 'PREC' INCLUDE 'PARAM' INCLUDE 'CATOM' INCLUDE 'CATMOS' INCLUDE 'CSLINE' INCLUDE 'CCONST' INCLUDE 'CLU' INCLUDE 'CSE' INCLUDE 'CINTS' C DIMENSION DUM(MK,MK) C C SET AJ, TOTAL ANGULAR MOMENTUM QUANTUM NUMBER C DO 10 I=1,NK AJ(I)=(G(I)-ONE)/TWO E(I)=EV(I)*EE/HH/CC DO 9 J=1,NK ECOEFF(I,J)=ZERO 9 CONTINUE 10 CONTINUE C C ECOEFF C C WRITE(LOUT,'(A/)') ' ECOEFF: EINSTEIN COEFFICIENTS' C WRITE(LOUT,'(A/)') ' I J ENERGY CM-1' C DO 15 I=1,NK C WRITE(LOUT,1001) I,AJ(I),E(I) C 15 CONTINUE C XT=5600. DO 11 KR=1,NLINE ECOEFF(JRAD(KR),IRAD(KR))=A(KR) ECOEFF(IRAD(KR),JRAD(KR))=B(IRAD(KR),JRAD(KR))*TWO*PI C DUM(JRAD(KR),IRAD(KR))=A(KR) C Y=2.*PI*CC*1.E8/ALAMB(KR) C DUM(IRAD(KR),JRAD(KR))=B(IRAD(KR),JRAD(KR))*TWO*PI*PLANCK(Y,XT) 11 CONTINUE C WRITE(LOUT,1002) (J,J=1,NK) C DO 13 I=1,NK C WRITE(LOUT,1000) I,(ECOEFF(I,J),J=1,NK) C 13 CONTINUE C WRITE(LOUT,'(//A)') ' ECOEFF: RATES SEC-1' C WRITE(LOUT,'(A)') ' I J ENERGY CM-1' C WRITE(LOUT,1002) (J,J=1,NK) C DO 14 I=1,NK C WRITE(LOUT,1000) I,(DUM(I,J),J=1,NK) C 14 CONTINUE C 1000 FORMAT(4X,I2,1P,10(E14.6)) C 1001 FORMAT(3X,I3,2X,1P,2(2X,E14.6)) C 1002 FORMAT(//1X,1P,10(I14)) RETURN END C C*********************************************************************** C