*DECK PIJWPR
      SUBROUTINE PIJWPR(LOPT,NREG,NSOUT,SIGTAL,PROB,SIGVOL,MSYM)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Print-out for probability matrices.
*
*Copyright:
* Copyright (C) 1991 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): R. Roy, G. Marleau
*
*Parameters: input
* LOPT    print-out form:
*         <= 0 print all PSS/PVS/PVV
*         >  0 print only PVV
* NREG    total number of regions.
* NSOUT   number of outer surface.
* SIGTAL  albedo-cross section vector.
* PROB    collision probabilities
* SIGVOL  region volumes.
* MSYM    matrix format:
*         = 1  symmetric matrix;
*         = 0  non-symmetric full matrix;
*
*Comments:
*  Format of compress probability matrix
*    NPLEN=(NREG+NSOUT+2)*(NREG+NSOUT+1)/2
*    IND(I,J)=MAX(I+NSOUT+1,J+NSOUT+1)
*            *(MAX(I+NSOUT+1,J+NSOUT+1)-1)/2
*            +MIN(I+NSOUT+1,J+NSOUT+1)
*    IS=-NSOUT,-1; JS=-NSOUT,IS; I=IND(IS,JS)
*      PROB(I)=VOLSUR(IS)*PSS(IS,JS)
*    IV=1,NREG; JS=-NSOUT,-1;    I=IND(IV,JS)
*      SIGT(IV).GT.0.0
*        PROB(I)=SIGT(IV)*VOLSUR(IV)*PVS(IV,JS)
*      SIGT(IV).EQ.0.0
*        PROB(I)=VOLSUR(IV)*PVS(IV,JS)
*     IV=1,NREG; JV=1,IV;       I=IND(IV,JV)
*       SIGT(IV).GT.0.0 AND SIGT(JV).GT.0.0
*         PROB(I)=SIGT(IV)*SIGT(JV)*VOLSUR(IV)*PVV(IV,JV)
*       SIGT(IV).GT.0.0 AND SIGT(JV).EQ.0.0
*         PROB(I)=SIGT(IV)*VOLSUR(IV)*PVV(IV,JV)
*       SIGT(IV).EQ.0.0 AND SIGT(JV).GT.0.0
*         PROB(I)=SIGT(JV)*VOLSUR(IV)*PVV(IV,JV)
*       SIGT(IV).EQ.0.0 AND SIGT(JV).EQ.0.0
*         PROB(I)=VOLSUR(IV)*PVV(IV,JV)
*
*-----------------------------------------------------------------------
*
      IMPLICIT            NONE
      INTEGER           IUNOUT,   LOPT,   NREG,  NSOUT,   MSYM,
     >                     IND,      I,      J,   NSUR,   NVOL,
     >                   NSURC,  NSURM,  NVOLC,  NVOLM,     IP,     IR,
     >                      JR,    III
      PARAMETER        (IUNOUT=6)
      REAL              SIGTAL(-NSOUT:NREG), BILANP(10), XSJR, WPR,
     >                  VPR(10), SIGVOL(NREG), COF
      DOUBLE PRECISION  PROB(*)
*
      IND(I,J) = MAX(I+NSOUT+1,J+NSOUT+1)*(MAX(I+NSOUT+1,J+NSOUT+1)-1)/2
     >         + MIN(I+NSOUT+1,J+NSOUT+1)
*
      WPR(I,J)= REAL(PROB( IND(I,J) ) / PROB( IND(I,0) ))
*
*NOTE:
*     IF( SIGT(I).NE.0.0 )THEN
*        PROB(IND(I,0)= SIGT(I) * VOLSUR(I)
*     ELSE
*        PROB(IND(I,0)= VOLSUR(I)
*     ENDIF
*
      NSUR= -NSOUT
      NVOL=  NREG
*
      WRITE(IUNOUT,'(24H REGIONAL CROSS SECTIONS)')
      WRITE(IUNOUT,'(5(1X,6HREGION,5X,16HCROSS SECTION   ))')
      WRITE(IUNOUT,'(5(1X,I6,3X,E15.7))') (JR,SIGTAL(JR),JR=1,NVOL)
      IF(MSYM .EQ. 0) THEN
        WRITE(IUNOUT,'(5(1X,6HREGION,5X,16HVOLUMES         ))')
        WRITE(IUNOUT,'(5(1X,I6,3X,E15.7))') 
     >  (JR,SIGVOL(JR),JR=1,NVOL)
      ELSE
        WRITE(IUNOUT,'(5(1X,6HREGION,5X,16HSURFACE/VOLUMES ))')
        WRITE(IUNOUT,'(5(1X,I6,3X,E15.7))') 
     >  (JR,PROB(IND(JR,0)),JR=-NSOUT,NVOL)
      ENDIF
      IF( LOPT.LE.0 )THEN
         NSURC = -1
         DO 40 IP  = 1, (9 - NSUR) / 10
            NSURM= MAX( NSUR, NSURC-9 )
            WRITE(IUNOUT,'(30H0  SURFACE CONSERVATION LAWS: ,
     >                     31H( P.S<-S + P.V<-S = 1 + ERR.S ) ,
     >                     31H FOR XS.TOTAL=0, REDUCED P.V<-S ,
     >                     11H IS PRINTED )')
            WRITE(IUNOUT,'(1X,8H(P.S<-S),1X,10( A5,    I6,:)/)')
     >               (' SUR ',-IR,IR= NSURC, NSURM, -1)
            DO 10 IR  =NSURC, NSURM, -1
               BILANP(IR-NSURM+1)= 0.0
   10       CONTINUE
            DO 25 JR = -1,  NSUR, -1
               WRITE(IUNOUT,'(5H SUR ,I4,1X,10F11.8)')
     >                          -JR, (WPR(IR,JR),IR=NSURC,NSURM,-1)
               DO 20 IR  = NSURC, NSURM, -1
                  BILANP(IR-NSURM+1)=  BILANP(IR-NSURM+1)
     >                              +  WPR(IR,JR)
   20          CONTINUE
   25       CONTINUE
            WRITE(IUNOUT,'(1X,8H(P.V<-S) )')
            DO 35 JR  =  1,  NVOL,  1
               IF( SIGTAL(JR).EQ.0.0 ) THEN
                  WRITE(IUNOUT,'(5H VOL ,I4,1X,3H 0*,10(F8.5,:,3H 0*))')
     >                      JR,(WPR(IR,JR),IR=NSURC,NSURM,-1)
                  XSJR= 0.0
               ELSE
                  WRITE(IUNOUT,'(5H VOL ,I4,1X,10F11.8)')
     >                      JR,(WPR(IR,JR),IR=NSURC,NSURM,-1)
                  XSJR= 1.0
               ENDIF
               DO 30 IR  = NSURC, NSURM, -1
                  BILANP(IR-NSURM+1)= BILANP(IR-NSURM+1)
     >                              + XSJR * WPR(IR,JR)
   30          CONTINUE
   35       CONTINUE
            WRITE(IUNOUT,'(1H )')
            WRITE(IUNOUT,'(5H SUM ,5X,10F11.8)')
     >                          (BILANP(IR-NSURM+1),IR=NSURC,NSURM,-1)
            NSURC = NSURC - 10
   40    CONTINUE
      ENDIF
      NVOLC =  1
      DO 90 IP  = 1, (9 + NVOL) / 10
         NVOLM= MIN( NVOL, NVOLC+9 )
         IF( LOPT.LE.0 )THEN
            WRITE(IUNOUT,'(30H0  VOLUME  CONSERVATION LAWS: ,
     >                     31H( P.S<-V + P.V<-V = 1 + ERR.V ) ,
     >                     31H FOR XS.TOTAL=0, REDUCED P.V<-V ,
     >                     11H IS PRINTED )')
         ELSE
            WRITE(IUNOUT,'(30H0  VOLUME  CONSERVATION LAWS: ,
     >                     32H( SUM OF P.V<-V = 1 + ESCAPE.V ) ,
     >                     31H FOR XS.TOTAL=0, REDUCED P.V<-V ,
     >                     11H IS PRINTED )')
         ENDIF
         DO 50 IR  = NVOLC, NVOLM,   1
            BILANP(IR-NVOLC+1)= 0.0
   50    CONTINUE
         IF( LOPT.LE.0 )THEN
            WRITE(IUNOUT,'(1X,8H(P.S<-V),1X,10( A5 ,  I6,:)/)')
     >                    (' VOL ',IR,IR=NVOLC,NVOLM, 1)
            DO 65 JR = -1,  NSUR, -1
               WRITE(IUNOUT,'(5H SUR ,I4,1X,10F11.8)')
     >         -JR, (WPR(IR,JR),IR=NVOLC,NVOLM, 1)
            DO 60 IR  = NVOLC, NVOLM,   1
               BILANP(IR-NVOLC+1)= BILANP(IR-NVOLC+1)
     >                           + WPR(IR,JR)
   60       CONTINUE
   65       CONTINUE
            WRITE(IUNOUT,'(1X,8H(P.V<-V) )')
         ELSE
            WRITE(IUNOUT,'(1X,8H(P.V<-V),1X,10( A5 ,  I6,:)/)')
     >                    (' VOL ',IR,IR=NVOLC,NVOLM, 1)
         ENDIF
*
         IF(LOPT.GT.0.AND.MSYM.EQ.0)THEN
*
*        PRINTING OF PIJK" FULL MATRIX
*
         COF=1.5
         DO 70 JR =  1,  NVOL,  1
            IF( SIGTAL(JR).EQ.0.0 )THEN
              DO 75 IR=NVOLC, NVOLM, 1
               III=JR+NREG*(IR-1)
               VPR(IR-NVOLC+1)=COF*REAL(PROB(III))/SIGVOL(IR)
   75         CONTINUE
               WRITE(IUNOUT,'(5H VOL ,I4,1X,3H 0*,10(F8.5,:,3H 0*))')
     >         JR,(VPR(IR-NVOLC+1),IR=NVOLC,NVOLM,1)
            ELSE
              DO 76 IR=NVOLC, NVOLM, 1
               III=JR+NREG*(IR-1)
               VPR(IR-NVOLC+1)=COF*REAL(PROB(III))/SIGVOL(IR)
               BILANP(IR-NVOLC+1)=BILANP(IR-NVOLC+1)+VPR(IR-NVOLC+1)
   76         CONTINUE
               WRITE(IUNOUT,'(5H VOL ,I4,1X,10F11.8)')
     >         JR,(VPR(IR-NVOLC+1),IR=NVOLC,NVOLM,1)
            ENDIF
   70    CONTINUE
         WRITE(IUNOUT,'(1H )')
         WRITE(IUNOUT,'(5H SUM ,5X,10F11.8)')
     >                         (BILANP(IR-NVOLC+1),IR=NVOLC,NVOLM, 1)
*
         ELSE
*
         DO 85 JR =  1,  NVOL,  1
            IF( SIGTAL(JR).EQ.0.0 )THEN
               WRITE(IUNOUT,'(5H VOL ,I4,1X,3H 0*,10(F8.5,:,3H 0*))')
     >         JR,(WPR(IR,JR),IR=NVOLC,NVOLM,1)
               XSJR= 0.0
            ELSE
               WRITE(IUNOUT,'(5H VOL ,I4,1X,10F11.8)')
     >         JR,(WPR(IR,JR),IR=NVOLC,NVOLM,1)
               XSJR= 1.0
            ENDIF
         DO 80 IR  = NVOLC, NVOLM,   1
            BILANP(IR-NVOLC+1)= BILANP(IR-NVOLC+1)
     >                        + XSJR*WPR(IR,JR)
   80    CONTINUE
   85    CONTINUE
         WRITE(IUNOUT,'(1H )')
         WRITE(IUNOUT,'(5H SUM ,5X,10F11.8)')
     >                         (BILANP(IR-NVOLC+1),IR=NVOLC,NVOLM, 1)
         ENDIF
         NVOLC = NVOLC + 10
   90 CONTINUE
*
      RETURN
      END
