C C PURPOSE: WRITES ATOMIC PARAMETERS TO OUTPUT LISTING C C INPUTS: ICALL. WRITE ONLY IF ICALL NEQ 0 C C OUTPUTS: C C COMMON: C C COMMENTS: OCTOBER 6, 1999, P. JUDGE C SUBROUTINE WATOM(ICALL) C C C INCLUDE 'PREC' INCLUDE 'PARAM' INCLUDE 'CATOM' INCLUDE 'CSLINE' INCLUDE 'CCONST' INCLUDE 'CINPUT' INCLUDE 'CLU' C C KOUNT=0 DO KR=1,NLINE IF ((ALAMB(KR) .GE. WLMIN).AND.(ALAMB(KR) .LE. WLMAX)) THEN KOUNT=KOUNT+1 ENDIF ENDDO C IF(IWATOM.EQ.0) RETURN C WRITE(LOUT,50) ATOMID 50 FORMAT('1 ATOMIC PARAMETERS ',A//) WRITE(LOUT,100) ABND, 10.**(ABND-12.) 100 FORMAT(' ABUNDANCE=',F7.4,1P,E11.4//7X,'E(CM-1)', * 4X,'G LABEL',26X,'ION S L J P LANDE G') WRITE(LOUT,200) (I,EV(I)/CC/HH*EE,INT(G(I)),LABEL(I), * ION(I),QNS(I),QNL(I),QNJ(I),IQNP(I),GLAND(I),I=1,NK) 200 FORMAT(I2,1X,F12.3,1X,I3,1X,A,I3,1X,F4.1, * 1X,F4.1,1X,F4.1,1X,I1,1X,F6.2) C QN=QNORM*1.E8/CC WRITE(LOUT,300) 300 FORMAT(/' RADIATIVE TRANSITIONS') WRITE(LOUT,400) (JRAD(KR),IRAD(KR),CONVL(ALAMB(KR)),F(KR),A(KR), * NQ(KR),QMAX(KR),Q0(KR),QN*ALAMB(KR),IWIDE(KR),KR=1,NLINE) 400 FORMAT(' J I LAMBDA',8X,'F',10X,'A',6X,'NQ',6X,'QMAX', * 8X,'Q0',3X,'QNORM MA',' IWIDE'/ * (1X,I2,I3,0P,F10.3,1P,2E11.3,I4,0P,2F10.2,F11.3,4X,L1)) DO 550 KR=NLINE+1,NRAD WRITE(LOUT,500) JRAD(KR),IRAD(KR),CONVL(ALAMB(KR)),F(KR), * NQ(KR),QMAX(KR),Q0(KR),QN*ALAMB(KR) 500 FORMAT(/1X,I2,I3,0P,F10.3,1P,E11.3,11X,I4,0P,3F10.2) IF(Q0(KR).LT.0.0 .OR. QMAX(KR).LT.0.0) THEN WRITE(LOUT,540) (Q(NY,KR),ALFAC(NY,KR-NLINE),NY=1,NQ(KR)) 540 FORMAT(0P,F16.3,1P,E11.3) ENDIF 550 CONTINUE C IF(ICALL.EQ.1) THEN IF(NRFIX.GT.0) THEN WRITE(LOUT,600) 600 FORMAT(/' FIXED TRANSITIONS'/' J I LAMBDA',7X,'A0',8X, * 'TRAD',5X,'ITRAD') ELSE WRITE(LOUT,610) 610 FORMAT(/' NO FIXED TRANSITIONS') ENDIF C DO 800 KF=1,NRFIX CLAM=HCE/(EV(JFX(KF))-EV(IFX(KF))) IF(IPHO(KF).EQ.0) THEN WRITE(LOUT,700) JFX(KF),IFX(KF),CLAM,A0(KF), * TRAD(KF),ITRAD(KF) 700 FORMAT(2I3,F10.3,1P,E11.3,0P,F11.3,I5,' BOUND-BOUND') ELSE WRITE(LOUT,710) JFX(KF),IFX(KF),CLAM,A0(KF), * TRAD(KF),ITRAD(KF) 710 FORMAT(2I3,F10.3,1P,E11.3,0P,F11.3,I5,' PHOTOIONIZATION') ENDIF 800 CONTINUE ENDIF C C TRANSITION TYPES C WRITE(LOUT,*)'' WRITE(LOUT,720)'TRANSITION TYPES' WRITE(LOUT,720) * 'E1=1, E2=2, M1=-1, E1(SPIN-F)=3, SPIN-F:-3 OTHER=0' WRITE(LOUT,720)'USED FOR EVALUATING COLLISION TYPES:' WRITE(LOUT,720)'WHEN .LE. 0, ASSUME STRONG COUPLING' 720 FORMAT(A) 711 FORMAT(1X,I4,'-',I4,1X,'(',A25,1X,'-',A25,')',4X,I5) DO 703 I=2,NK DO 704 J=1,I-1 WRITE(LOUT,711)I,J, LABEL(I),LABEL(J),ITTYPE(I,J) 704 CONTINUE 703 CONTINUE C WRITE(LOUT,900) 900 FORMAT(////1X) RETURN END C C**************************************************************** C