*DECK PIJI2D
      SUBROUTINE PIJI2D(NREG,NSOUT,NSLINE,NCOR,NSBG,
     >                  SWVOID,SIGTAL,NPSYS,WEIGHT,
     >                  SEGLEN,NRSEG,SEGPAT,DPR,
     >                  MKI0,BIN0,PAS0,L0,
     >                  MKI1,BIN1,PAS1,XLM1,L1,
     >                  MKI2,BIN2,PAS2,XLM2)
C
C-------------------------    PIJI2D    -------------------------------
C
C 1- SUBROUTINE STATISTICS:
C     NAME     : PIJI2D
C     LEVEL    : 2 (CALLED BY 'EXCELP')
C     USE      : INTEGRATION FOR GENERAL 2D ISOTROPIC B.C. TRACKING
C                * WITH BICKLEY FUNCTIONS OF ORDER 1,2,3 => USUAL PIJ
C                * WITH BICKLEY FUNCTIONS OF ORDER 3,4,5 => FOR   PIJK
C     MODIFIED : 94-05-18 (I.P., TO ALLOW *PIJK* CALLS)
C     MODIFIED : 94-05-03 (R.R., TO ALLOW *PIJK* CALLS)
C     MODIFIED : 91-07-12 (R.R.)
C     MODIFIED : 91-05-10 (G.M.)
C     AUTHOR   : G. MARLEAU
C
C 2- PARAMETERS:
C  INPUT
C     NREG    : TOTAL NUMBER OF REGIONS                I
C     NSOUT   : NUMBER OF OUTER SURFACE                I
C     NSLINE  : number of segemnts on line             
C     NCOR    : MAXIMUM NUMBER OF CORNERS              I
C     NSBG    : NUMBER OF SUBGROUP                     I
C     SWVOID  : FLAG TO INDICATE IF THERE ARE VOIDS    L
C     SIGTAL  : ALBEDO-CROSS SECTION VECTOR            R(-NSOUT:NREG,
C               IS=-NSOUT,-1; SIGTAL(IS)=ALBEDO(-IS)    NSBG)
C               IV=1,NREG ;   SIGTAL(IV)=SIGT(IV)
C     NPSYS   : NON-CONVERGED ENERGY GROUP INDICES.    I(NSBG)
C     WEIGHT  : line weight 
C     SEGLEN  : LENGTH OF TRACK              R(NSLINE)
C     NRSEG   : REGION CROSSED BY TRACK      I(NSLINE)
C     MKI0,BIN0,PAS0,XLM0,L0: QUADRATIC BICKLEY TABLE ORDER N
C     MKI1,BIN1,PAS1,XLM1,L1: QUADRATIC BICKLEY TABLE ORDER N+1
C     MKI2,BIN2,PAS2,XLM2,L2: QUADRATIC BICKLEY TABLE ORDER N+2
C
C  OUTPUT
C     DPR     : COLLISION PROBABILITIES      D(-NSOUT:NREG,
C                                              -NSOUT:NREG,NSBG)
C               VALUES ARE COMPUTED ONLY FOR ONE DIRECTION P(I->J)
C
C  WORK
C     SEGPAT  : OPTICAL PATH OF TRACK        R(NSLINE)
C
C  3-INTERNAL PARAMETERS
C     PI      : NUMERICAL VALUE OF PI                  D
C
C-------------------------    PIJI2D    -------------------------------
C
      IMPLICIT NONE
C----
C PARAMETERS
C----
      REAL             PI
      PARAMETER       (PI=3.1415926535897932)
C----
C INTERNAL FUNCTIONS
C----
      REAL             CBIN0,CBIN1,CBIN2
C----
C VARIABLES
C----
      INTEGER          NREG,NSOUT,NSLINE,NCOR,NSBG
      INTEGER          NRSEG(NSLINE),NPSYS(NSBG)
      LOGICAL          SWVOID
      REAL             SIGTAL(-NSOUT:NREG,NSBG),WEIGHT,SEGLEN(NSLINE),
     >                 SEGPAT(NSLINE)
      DOUBLE PRECISION DPR(-NSOUT:NREG,-NSOUT:NREG,NSBG)
      INTEGER          MKI0,L0,MKI1,L1,MKI2
      REAL             BIN0(0:MKI0,3),PAS0,
     >                 BIN1(0:MKI1,3),PAS1,XLM1,
     >                 BIN2(0:MKI2,3),PAS2,XLM2
C----
C  Local variables
C----
      INTEGER          IL,ISBG,ISD,ISF,NSEG,ISEG,IREG,
     >                 LPOS,ICSEG,JCSEG,JSEG,IR1
      REAL             FLOG0,FLOG1,ZREF1,ZREF2,ZREF3,XPOS,
     >                 ZINTP,X3,ZI,X
C----
C  QUADRATIC INTERPOLATION IN BICKLEY TABLES
C----
      CBIN0(IL,X)=       BIN0(IL,1)+X*(BIN0(IL,2)+X*BIN0(IL,3))
      CBIN1(IL,X)=       BIN1(IL,1)+X*(BIN1(IL,2)+X*BIN1(IL,3))
      CBIN2(IL,X)=       BIN2(IL,1)+X*(BIN2(IL,2)+X*BIN2(IL,3))
C----
C  LOGARITHMIC DIVERGENCE FOR KI1 AND KI2
C  FOR KI1 -> X*LOG(X)        FOR K<L0 AND L0>0
C  FOR KI2 -> -X**2*LOG(X)/2. FOR K<L1 AND L1>0
C----
      FLOG0=FLOAT(L0/MAX(1,L0))
      FLOG1=-0.5*FLOAT(L1/MAX(1,L1))
*----
*  Process track required
*----
      NSEG=NSLINE-2*NCOR
      ZI=0.0
      DO 2001 ISBG=1,NSBG
        IF(NPSYS(ISBG).EQ.0) GO TO 2001
        ZREF3=CBIN2(0,0.0)*WEIGHT
        ZREF2=CBIN1(0,0.0)*WEIGHT
        ZREF1=CBIN0(0,0.0)*WEIGHT
C----
C  CONVERT SEGMENT LENGHT TO PATH LENGTH
C----
        ICSEG=NCOR
        DO 210 ISEG=1,NSEG
          ICSEG=ICSEG+1
          IREG=NRSEG(ICSEG)
          SEGPAT(ISEG)=SEGLEN(ICSEG)*SIGTAL(IREG,ISBG)
          DPR(IREG,IREG,ISBG)=DPR(IREG,IREG,ISBG)+ZREF2*SEGPAT(ISEG)
 210    CONTINUE
C----
C  INTEGRATION
C----
        XPOS=0.0
        ZINTP=ZREF3
C----
C  INTEGRATE OVER FIRST REGION AND COMPUTE PVS, PSS
C----
        ICSEG=NCOR+1
        DO 220 ISEG=1,NSEG
          IREG=NRSEG(ICSEG)
          IR1=NRSEG(NCOR+1)
          XPOS=XPOS+SEGPAT(ISEG)
          LPOS=MIN(NINT(XPOS*PAS2),MKI2)
          ZI=WEIGHT*CBIN2(LPOS,XPOS)
          X3=ZI-ZINTP
          DPR(IR1,IREG,ISBG)=DPR(IR1,IREG,ISBG)+X3
          DO 225 ISD=1,NCOR
            DPR(IREG,NRSEG(ISD),ISBG)=DPR(IREG,NRSEG(ISD),ISBG)-X3
 225      CONTINUE
          IF(XPOS.GT.XLM2) GO TO 221
          ZINTP=ZI
          ICSEG=ICSEG+1
 220    CONTINUE
 221    CONTINUE
        IR1=NRSEG(NCOR+1)
        DO 226 ISF=NSLINE-NCOR+1,NSLINE
          DPR(IR1,NRSEG(ISF),ISBG)=DPR(IR1,NRSEG(ISF),ISBG)-ZI
          DO 227 ISD=1,NCOR
            DPR(NRSEG(ISD),NRSEG(ISF),ISBG)=
     >      DPR(NRSEG(ISD),NRSEG(ISF),ISBG)+ZI
 227      CONTINUE
 226    CONTINUE
        ICSEG=NCOR+2
        DO 230 ISEG=2,NSEG
          XPOS=0.0
          ZINTP=ZREF3
          JCSEG=ICSEG
          DO 240 JSEG=ISEG,NSEG
            XPOS=XPOS+SEGPAT(JSEG)
            LPOS=MIN(NINT(XPOS*PAS2),MKI2)
            ZI=WEIGHT*CBIN2(LPOS,XPOS)
            X3=ZI-ZINTP
            DPR(NRSEG(ICSEG-1),NRSEG(JCSEG),ISBG)=
     >          DPR(NRSEG(ICSEG-1),NRSEG(JCSEG),ISBG)-X3
            DPR(NRSEG(ICSEG),NRSEG(JCSEG),ISBG)=
     >          DPR(NRSEG(ICSEG),NRSEG(JCSEG),ISBG)+X3
            IF(XPOS.GT.XLM2) GO TO 241
            ZINTP=ZI
            JCSEG=JCSEG+1
 240      CONTINUE
 241      CONTINUE
          DO 235 ISF=NSLINE-NCOR+1,NSLINE
            DPR(NRSEG(ICSEG),NRSEG(ISF),ISBG)=
     >            DPR(NRSEG(ICSEG),NRSEG(ISF),ISBG)-ZI
            DPR(NRSEG(ICSEG-1),NRSEG(ISF),ISBG)=
     >            DPR(NRSEG(ICSEG-1),NRSEG(ISF),ISBG)+ZI
 235      CONTINUE
          ICSEG=ICSEG+1
 230    CONTINUE
        ICSEG=NCOR+NSEG
        DO 236 ISF=NSLINE-NCOR+1,NSLINE
          DPR(NRSEG(ICSEG),NRSEG(ISF),ISBG)=
     >          DPR(NRSEG(ICSEG),NRSEG(ISF),ISBG)+ZREF3
 236    CONTINUE
C----
C  FOR VOID REGIONS RESET PROBABILITIES
C----
        IF(SWVOID) THEN
          ICSEG=NCOR+1
          DO 300 ISEG=1,NSEG
            IF(SIGTAL(NRSEG(ICSEG),ISBG).NE.0.0) GO TO 301
            XPOS=0.0
            DPR(NRSEG(ICSEG),NRSEG(ICSEG),ISBG)=
     >          DPR(NRSEG(ICSEG),NRSEG(ICSEG),ISBG)
     >         + 0.5*ZREF1*SEGLEN(ICSEG)*SEGLEN(ICSEG)
            ZINTP=ZREF2*SEGLEN(ICSEG)
            JCSEG=ICSEG+1
            DO 310 JSEG=ISEG+1,NSEG
              IF(SIGTAL(NRSEG(JCSEG),ISBG).EQ.0.0) THEN
                LPOS=MIN(NINT(XPOS*PAS0),MKI0)
                IF(LPOS.LT.L0.AND.XPOS.NE.0.0) THEN
                  ZI=WEIGHT*SEGLEN(ICSEG)*SEGLEN(JCSEG)*
     >              (CBIN0(LPOS,XPOS)+FLOG0*XPOS*LOG(XPOS))
                ELSE
                  ZI=WEIGHT*SEGLEN(ICSEG)*SEGLEN(JCSEG)*CBIN0(LPOS,XPOS)
                ENDIF
                X3=0.5*ZI
              ELSE
                XPOS=XPOS+SEGPAT(JSEG)
                LPOS=MIN(NINT(XPOS*PAS1),MKI1)
                IF(LPOS.LT.L1.AND.XPOS.NE.0.0) THEN
                  ZI=WEIGHT*SEGLEN(ICSEG)*
     >              (CBIN1(LPOS,XPOS)+FLOG1*XPOS*XPOS*LOG(XPOS))
                ELSE
                  ZI=WEIGHT*SEGLEN(ICSEG)*CBIN1(LPOS,XPOS)
                ENDIF
                X3=ZINTP-ZI
                ZINTP=ZI
              ENDIF
              DPR(NRSEG(ICSEG),NRSEG(JCSEG),ISBG)=
     >            DPR(NRSEG(ICSEG),NRSEG(JCSEG),ISBG)+X3
              IF(XPOS.GT.XLM1) GO TO 311
              JCSEG=JCSEG+1
 310        CONTINUE
 311        CONTINUE
            DO 320 ISF=NSLINE-NCOR+1,NSLINE
              DPR(NRSEG(ICSEG),NRSEG(ISF),ISBG)=
     >              DPR(NRSEG(ICSEG),NRSEG(ISF),ISBG)+ZINTP
 320        CONTINUE
            XPOS=0.0
            ZINTP=ZREF2*SEGLEN(ICSEG)
            JCSEG=ICSEG-1
            DO 330 JSEG=ISEG-1,1,-1
              IF(SIGTAL(NRSEG(JCSEG),ISBG).EQ.0.0) THEN
                LPOS=MIN(NINT(XPOS*PAS0),MKI0)
                IF(LPOS.LT.L0.AND.XPOS.NE.0.0) THEN
                  ZI=WEIGHT*SEGLEN(ICSEG)*SEGLEN(JCSEG)*
     >              (CBIN0(LPOS,XPOS)+FLOG0*XPOS*LOG(XPOS))
                ELSE
                  ZI=WEIGHT*SEGLEN(ICSEG)*SEGLEN(JCSEG)*CBIN0(LPOS,XPOS)
                ENDIF
                X3=0.5*ZI
              ELSE
                XPOS=XPOS+SEGPAT(JSEG)
                LPOS=MIN(NINT(XPOS*PAS1),MKI1)
                IF(LPOS.LT.L1.AND.XPOS.NE.0.0) THEN
                  ZI=WEIGHT*SEGLEN(ICSEG)*
     >              (CBIN1(LPOS,XPOS)+FLOG1*XPOS*XPOS*LOG(XPOS))
                ELSE
                  ZI=WEIGHT*SEGLEN(ICSEG)*CBIN1(LPOS,XPOS)
                ENDIF
                X3=ZINTP-ZI
                ZINTP=ZI
              ENDIF
              DPR(NRSEG(ICSEG),NRSEG(JCSEG),ISBG)=
     >            DPR(NRSEG(ICSEG),NRSEG(JCSEG),ISBG)+X3
              IF(XPOS.GT.XLM1) GO TO 331
              JCSEG=JCSEG-1
 330        CONTINUE
 331        CONTINUE
            DO 340 ISD=1,NCOR
              DPR(NRSEG(ICSEG),NRSEG(ISD),ISBG)=
     >              DPR(NRSEG(ICSEG),NRSEG(ISD),ISBG)+ZINTP
 340        CONTINUE
 301        CONTINUE
            ICSEG=ICSEG+1
 300      CONTINUE
        ENDIF
 2001 CONTINUE
C----
C  RETURN
C----
      RETURN
      END
