C C PURPOSE: WRITES EMERGENT STOKES PROFILES TO FILE C C INPUTS: C C OUTPUTS: C C COMMON: CSLINE, CATOM, CSLINE, CLU C C RESTRICTIONS: THIS SHOULD BE REPLACED BY UNFORMATTED OUTPUT C C COMMENTS: OCTOBER 6, 1999, P. JUDGE C SUBROUTINE OUTS(J,K) C INCLUDE 'PREC' INCLUDE 'PARAM' INCLUDE 'GRDPAR' INCLUDE 'CSLINE' INCLUDE 'CATOM' INCLUDE 'CINPUT' INCLUDE 'CGRID' INCLUDE 'CCONST' INCLUDE 'CLU' DIMENSION SUMS(MLINE,0:4) DATA ICALL/0/ SAVE ICALL C IF(ICALL .EQ. 0) THEN KOUNT=0 DO KR=1,NLINE IF ((ALAMB(KR) .GE. WLMIN).AND.(ALAMB(KR) .LE. WLMAX)) THEN KOUNT=KOUNT+1 ENDIF ENDDO WRITE(LOUT,2004) KOUNT 2004 FORMAT('1 STOKES DATA OUTPUT'// * ' TOTAL NUMBER OF LINES OUTPUTTED ',I8) DO KR=1,NLINE WW=CONVL(ALAMB(KR)) IF ((WW .GE. WLMIN) .AND. (WW .LE. WLMAX)) THEN WRITE (LOUT,*) 'LINE ', KR, WW WRITE (LOUT,1000) 'DELTA-WAVELENGTHS [ANGSTROM]',NQ(KR) WRITE (LOUT,1001) (DLAMB(Q(NY,KR),KR),NY=1,NQ(KR)) ENDIF END DO IF(IWLINE .GT. 0) THEN WRITE(LOUT,*) * 'FULL EMERGENT STOKES PROFILES' ELSE WRITE(LOUT,*) * 'FREQUENCY-INTEGRATED EMERGENT STOKES DATA ONLY' ENDIF ICALL=ICALL+1 ENDIF C C WW IS THE WEIGHT NEEDED TO INTEGRATE OVER WAVELENGTH C QN=QNORM*1.E5/CC DO KR=1,NLINE IF ((ALAMB(KR) .GE. WLMIN) .AND. (ALAMB(KR) .LE. WLMAX)) THEN WW=ALAMB(KR)*QN/(1.0+QN) DO IM=0,4 IF(IWLINE .GT. 0) WRITE (LOUT,1002) * (EMERGE(KR,IM,NY),NY=1,NQ(KR)) SUMS(KR,IM)=0. DO NY=1,NQ(KR)-1 SIGN=+1. ADD=EMERGE(KR,IM,NY) IF(IM .GE. 3 .AND. Q(NY,KR) .LT. 0.) SIGN=-1. SUMS(KR,IM)=SUMS(KR,IM) + SIGN*ADD*WQ(NY,KR)*WW ENDDO END DO WRITE(LOUT,1003) (SUMS(KR,IM),IM=0,4) ENDIF END DO 1000 FORMAT(1X,A,1X,I4) 1001 FORMAT(10(1X,F7.3)) 1002 FORMAT(4(1P,10(1X,E10.3),0P/)) 1003 FORMAT(5(1P,1X,E10.3),0P/) RETURN END