C
C PURPOSE: BUILD STATISTICAL EQUILIBRIUM MATRIX
C
C INPUTS: NDIM (pretty sure this is an output!! SG)
C
C OUTPUTS:
C
C COMMON:
C
C COMMENTS: OCTOBER 6, 1999, P. JUDGE
C 
	SUBROUTINE SE0_BUILD(NDIM)

C  THIS SUBROUTINES BUILDS THE COEFFICIENT MATRIX OF THE STATISTICAL
C  EQUILIBRIUM EQUATIONS IN THE B-FRAME, ONCE THE B-DIRECTION IN THE
C  S-FRAME, AND THE HEIGHT OVER THE LIMB OF THE SCATTERER ARE GIVEN.
C  A CYLINDRICALLY SYMMETRIC, UNPOLARIZED RADIATION FIELD IS ASSUMED.
C  QUANTUM COHERENCES ARE NEGLECTED.

	INCLUDE 'PREC'
	INCLUDE 'PARAM'
	INCLUDE 'CATOM'
	INCLUDE 'CSE'
	INCLUDE 'CINTS'
C added next 6jul22
	INCLUDE 'CINPUT'
	INCLUDE 'CLU'
C       
C	DIMENSION DUM(MJTOT,MJTOT)
	LOGICAL LEQK
C       
C       CALCULATE TENSORS OF RADIATION FIELD FOR ALL POSSIBLE TRANSITIONS
C       
C	WRITE (LOUT,*) 'RADIATION TENSORS'
C       
C	CALL CPTIME('SE0_BUILD',0,0,1)
C	CALL CPTIME('SE0:FIELDB',0,0,1)
	DO IJ=1,NK
	   DO IJ1=1,NK
C       
C       ENUMERATE RADIATIVELY
C       PERMITTED TRANSITIONS
C       
	      KR=KRAD(IJ,IJ1)				
	      IF (KR.NE.0) THEN 
		 CALL FIELDB(KR)
	      END IF
	   END DO
	END DO
C	CALL CPTIME('SE0:FIELDB',0,1,1)
C       
C       BUILD COEFFICIENT MATRIX  SCOEFF(I,I1)
C       
C	CALL CPTIME('SE0:R&C',0,0,1)
	I=0
	IZ=0
	DO IJ=1,NK
	   CALL R1(IJ,R1COEFF)
	   C1TMP0=CE(IJ,IZ)
	   CALL C2(IJ,C2COEFF)
	   CALL C6(NK,IJ,C6COEFF)
C Note stepping by 2 added with 6jul22 version
	   DO K=0,NINT(TWO*AJ(IJ)),2
C       
C       ROW NUMBER
C       
	      I=I+1
	      IF (K.NE.0) THEN
		 WEIGHT(I)=ZERO
	      ELSE
		 WEIGHT(I)=SQRT(TWO*AJ(IJ)+ONE)
	      END IF			
	      C1TMPK=CE(IJ,K)
	      C1COEFF=C1TMP0-C1TMPK
	      I1=0
	      DO IJ1=1,NK
		 KR=KRAD(IJ,IJ1)
		 CALL R4(IJ,IJ1,K,R4COEFF)
		 IF (IJ1.LT.IJ) CALL C3(IJ,IJ1,K,C3COEFF)
		 IF (IJ1.GT.IJ) CALL C5(IJ,IJ1,K,C5COEFF)
C Note stepping by 2 added with 6jul22 version
		 DO K1=0,NINT(TWO*AJ(IJ1)),2
		    LEQK=K1.EQ.K
C       
C       COLUMN NUMBER
C       
		    I1=I1+1					
		    SCOEFF(I,I1)=ZERO
C       
C       R(1,2,6), C(1,2,6),
C       -> IJ1=IJ
C       
		    IF (IJ1.EQ.IJ) THEN			
		       IZ=0
		       CALL R2(IJ,K,K1,IZ,R2COEFF)
		       CALL R6(NK,IJ,K,K1,IZ,R6COEFF)
		       SCOEFF(I,I1)=-R2COEFF-R6COEFF+SCOEFF(I,I1)
		       IF (LEQK) SCOEFF(I,I1)=-R1COEFF-C1COEFF-C2COEFF-C6COEFF
     * 		    +SCOEFF(I,I1)
      
		    END IF
		    IF (IJ1.LT.IJ) THEN
		       IF (KR.NE.0) THEN
			  IZ=0
			  CALL R3(KR,IJ,IJ1,K,K1,IZ,R3COEFF)
			  SCOEFF(I,I1)=R3COEFF+SCOEFF(I,I1)
		       END IF
		       IF (LEQK) SCOEFF(I,I1)=C3COEFF+SCOEFF(I,I1)
		    END IF
		    IF (IJ1.GT.IJ) THEN
		       IF (KR.NE.0) THEN
			  IZ=0
			  CALL R5(KR,IJ,IJ1,K,K1,IZ,R5COEFF)
			  SCOEFF(I,I1)=R5COEFF+SCOEFF(I,I1)
		       END IF
		       IF (LEQK) SCOEFF(I,I1)=R4COEFF+C5COEFF+SCOEFF(I,I1)
		    END IF
		 END DO
	      END DO
	   END DO
	END DO
C debug statement added 6jul22
	if(IDEBUG .GT. 0) WRITE(LOUT,*)' SE0_BUILD MADE A  ',I,' X ',I1, 'MATRIX'
	IF (I.NE.I1) CALL STOP('SE_BUILD: SCOEFF IS NOT SQUARE')
	NDIM=I
C	CALL CPTIME('SE0:R&C',0,1,1)
C	CALL CPTIME('SE0_BUILD',0,1,1)
	RETURN
	END
