C C PURPOSE: ADMINISTERS CALLING FOR SYNTHESIS OF M1 LINES ALONG ONE LOS C C INPUTS: IY, IZ: INDICES OF POINTS IN X AND Y GRID C C OUTPUTS: C C COMMON: C C COMMENTS: OCTOBER 6, 1999, P. JUDGE C SUBROUTINE M1SYNTH(IY,IZ) C C SUBROUTINE FOR THE SYNTHESIS OF FORBIDDEN LINE STOKES C PARAMETERS, ALONG A GIVEN LOS. C INCLUDE 'PREC' INCLUDE 'PARAM' INCLUDE 'CGRID' INCLUDE 'CATOM' INCLUDE 'CATMOS' INCLUDE 'CATMO2' INCLUDE 'CSLINE' INCLUDE 'CORON' INCLUDE 'CCONST' INCLUDE 'CINPUT' INCLUDE 'CINTS' INCLUDE 'CLU' C DIMENSION AA(MJTOT,MJTOT),BB(MJTOT) DIMENSION T0(0:3,0:2) LOGICAL DISK,IGNORE C CALL CPTIME('M1SYNT',0,0,2) DO KR=1,NLINE DO M=0,4 DO NY=1,NQ(KR) EMERGE(KR,M,NY)=ZERO END DO END DO END DO C C SKIP IF LOS INTERSECTS THE DISK C DISK=.FALSE. RRR=GZ*GZ+GY*GY IF(RRR .LE. ONE) DISK= .TRUE. C C LOOP OVER THE LOS COORDINATE C GXSTEP = (GXMAX-GXMIN)/(NGX-1) DO I=1,NGX DO KR=1,NLINE DO M=0,4 DO NY=1,NQ(KR) EMISS(KR,M,NY)=ZERO END DO END DO END DO GX=FLOAT(I-1)*GXSTEP+GXMIN WTX=RSUNCM*GXSTEP IF(I .EQ. 1 .OR. I .EQ. NGX) WTX=0.5*WTX C C CALCULATE SOLAR PARAMETERS (HEIGHT, DENSITY, TEMPERATURE, C MICROTURBULENCE, MAGNETIC FIELD IN CORONA) C CALL CORONA C C IGNORE THOSE LOCATIONS WHERE LINE OF SIGHT IS EITHER C 1. ON THE DISK C 2. HAS ELECTRON DENSITY BELOW SMALL N C 3. HAS SMALL ION FRACTIONS C IGNORE= DISK .OR. (ED .LT. SMALLN) .OR. * (TOTN .LT. 10.**(ABND-12.)*SMALLN) CALL WATMOS(I,IY,IZ,IGNORE) IF(.NOT. IGNORE) THEN CALL PROFIL C C LTE POPULATIONS AND COLLISIONAL RATES TO BE STORED C IF(ICOLL .NE. 0) THEN CALL LTEPOP CALL COLCAL ENDIF C C BUILD AND SOLVE STATISTICAL EQUILIBRIUM EQUATIONS C CALL SE0_BUILD(NDIM) CALL SOLVE(NDIM,AA,BB) IF(IDEBUG.EQ.1) WRITE(LOUT,100) 'M1SYNTH: TEMP, ED',TEMP,ED 100 FORMAT(A,1P,2(1X,E9.2)) CALL SE0_COPY(NDIM,BB) C C SOLVE FOR EMERGENT STOKES PROFILES C CALL T0TENS(T0) C DO KR=1,NLINE IF ((ALAMB(KR).GE.WLMIN).AND.(ALAMB(KR).LE.WLMAX)) * CALL EMISSION(KR,T0) END DO CALL TRAP(WTX) CALL WDEBUG ENDIF END DO CALL CPTIME('M1SYNT',0,1,2) RETURN END