*DECK SYB7QG SUBROUTINE SYB7QG (IMPX,NCURR,MNA4,NRD,NSECT,LSECT,NREG,ZZR,ZZI, 1 HSIDE,RAYRE,SIGTR,TRONC,VOL,PIJ,PVS,PSS) * *----------------------------------------------------------------------- * *Purpose: * Compute the one-group collision, leakage and transmission * probabilities in a hexagonal sectorized cell. * *Copyright: * Copyright (C) 2002 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): A. Hebert * *Parameters: input * IMPX print parameter (equal to zero for no print). * NCURR type of interface current approximation: * =1 DP-0; =3 DP-1 interface currents. * MNA4 number of angles in (0,$\\pi$/2). * NRD one plus the number of tubes in the cell. * NSECT number of sectors. * LSECT type of sectorization: * =-999 no sectorization / processed as a sectorized cell; * =-101 X-type sectorization of the coolant; * =-1 X-type sectorization of the cell. * NREG number of regions. * ZZR real tracking elements. * ZZI integer tracking elements. * HSIDE length of the hexagon sides. * RAYRE radius of the tubes. * SIGTR total macroscopic cross section. * TRONC voided block criterion. * *Parameters: output * VOL volumes. * PIJ volume to volume reduced probability. * PVS volume to surface probabilities. * PSS surface to surface probabilities in the following order: * PSS(i,j) is the probability from surface i to surface j. * *Comments: * hexagone surface identification. * side 2 * xxxxxxxx * x x * side 3 x x side 1 * x x * x x * side 4 x x side 6 * xxxxxxxx * side 5 * *---- * SUBROUTINE ARGUMENTS *---- INTEGER IMPX,NCURR,MNA4,NRD,NSECT,LSECT,NREG,ZZI(*) REAL ZZR(*),HSIDE,RAYRE(NRD-1),SIGTR(NREG),TRONC,VOL(NREG), 1 PIJ(NREG,NREG),PVS(NREG,6*NCURR),PSS(6*NCURR,6*NCURR) *---- * LOCAL VARIABLES *---- PARAMETER (SIGVID=1.0E-10,NSURFQ=6) INTEGER IPER(3) REAL QSS(135) INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NUMREG REAL, ALLOCATABLE, DIMENSION(:) :: VOLINT,WORKIJ,G REAL, ALLOCATABLE, DIMENSION(:,:,:) :: PSIX LOGICAL, ALLOCATABLE, DIMENSION(:) :: LGFULL *---- * DATA STATEMENT AND INLINE FUNCTIONS *---- SAVE IPER DATA IPER/1,3,2/ INC(IC,IH)=(IC-1)*NCURR+IPER(IH) INQ(IH,JH,IS)=(IS-1)*NCURR*NCURR+(IH-1)*NCURR+JH *---- * SCRATCH STORAGE ALLOCATION *---- ALLOCATE(NUMREG(NSECT,NRD)) ALLOCATE(VOLINT(NRD),WORKIJ(0:(NREG+6)*(NREG+7)/2-1), 1 PSIX(0:5,NCURR,NREG),G(NREG+6)) ALLOCATE(LGFULL(NREG)) *---- * COMPUTE THE VOLUMES *---- CALL SYB7VO(NRD,HSIDE,RAYRE,VOLINT) IND=0 DO 30 I=1,NRD-1 IF(ABS(LSECT).GT.100) THEN IND=IND+1 DO 10 ISEC=1,NSECT NUMREG(ISEC,I)=IND 10 CONTINUE ELSE IF(LSECT.EQ.-1) THEN NUMREG(1,I)=IND+5 NUMREG(2,I)=IND+6 NUMREG(3,I)=IND+1 NUMREG(4,I)=IND+2 NUMREG(5,I)=IND+3 NUMREG(6,I)=IND+4 IND=IND+6 ELSE DO 20 ISEC=1,NSECT IND=IND+1 NUMREG(ISEC,I)=IND 20 CONTINUE ENDIF 30 CONTINUE IF(LSECT.EQ.-999) THEN IND=IND+1 DO 40 ISEC=1,NSECT NUMREG(ISEC,I)=IND 40 CONTINUE ELSE IF((LSECT.EQ.-1).OR.(LSECT.EQ.-101)) THEN NUMREG(1,I)=IND+5 NUMREG(2,I)=IND+6 NUMREG(3,I)=IND+1 NUMREG(4,I)=IND+2 NUMREG(5,I)=IND+3 NUMREG(6,I)=IND+4 IND=IND+6 ELSE DO 50 ISEC=1,NSECT IND=IND+1 NUMREG(ISEC,I)=IND 50 CONTINUE ENDIF DO 60 I=1,NREG VOL(I)=0.0 60 CONTINUE DO 75 IR=1,NRD DO 70 IS=1,NSECT IND=NUMREG(IS,IR) VOL(IND)=VOL(IND)+VOLINT(IR)/6.0 70 CONTINUE 75 CONTINUE *---- * CHECK FOR VOIDED REGIONS *---- DO 80 IR=1,NREG IF(VOL(IR) .GT. 0.) THEN DR=SQRT(VOL(IR)) ELSE DR=0.0 ENDIF LGFULL(IR)=(SIGTR(IR)*DR).GT.TRONC IF(SIGTR(IR).LE.SIGVID) SIGTR(IR)=SIGVID 80 CONTINUE *---- * COMPUTE COLLISION, DP-0 ESCAPE AND DP-0 TRANSMISSION PROBABILITIES *---- MZIS=ZZI(1) MZRS=ZZI(2) CALL SYBUQV(ZZR(MZRS),ZZI(MZIS),NSURFQ,NREG,SIGTR,MNA4,LGFULL, 1 WORKIJ) *---- * STAMM'LER RENORMALIZATION *---- DO 90 IR=1,NSURFQ G(IR)=HSIDE/4.0 90 CONTINUE DO 100 IR=1,NREG G(6+IR)=SIGTR(IR)*VOL(IR) 100 CONTINUE * FIRST APPLY THE ORTHONORMALIZATION FACTOR: DO 110 I=0,(NSURFQ+NREG)*(NSURFQ+NREG+1)/2-1 WORKIJ(I)=WORKIJ(I)*ZZR(MZRS)*ZZR(MZRS) 110 CONTINUE * * THEN PERFORM STAMM'LER NORMALIZATION: CALL SYBRHL(IMPX,NSURFQ,NREG,G,WORKIJ) * IIJ=NSURFQ*(NSURFQ+1)/2-1 DO 130 JR=1,NREG IIJ=IIJ+NSURFQ DO 120 IR=1,JR-1 AUX=WORKIJ(IIJ+IR)/(SIGTR(IR)*SIGTR(JR)) PIJ(IR,JR)=AUX/VOL(IR) PIJ(JR,IR)=AUX/VOL(JR) 120 CONTINUE IIJ=IIJ+JR AUX=WORKIJ(IIJ)/(SIGTR(JR)*SIGTR(JR)) PIJ(JR,JR)=AUX/VOL(JR) 130 CONTINUE *---- * PIS AND PSS CALCULATION *---- IF(NCURR.GT.1) THEN * PERFORM A DP-1 CALCULATION USING THE TRACKING. CALL SYBUQ0(ZZR(MZRS),ZZI(MZIS),NSURFQ,NREG,SIGTR,MNA4, 1 LGFULL,PSIX(0,1,1),QSS) * DO 160 JS=0,NSURFQ-1 DO 150 IH=1,NCURR DO 140 IR=1,NREG ZNOR=G(JS+1)+G(NSURFQ+IR) PSIX(JS,IH,IR)=ZNOR*PSIX(JS,IH,IR)/SIGTR(IR)/VOL(IR) 140 CONTINUE 150 CONTINUE 160 CONTINUE IIQ=1 DO 190 JS=0,NSURFQ-1 DO 180 IS=0,JS-1 ZNOR=G(IS+1)+G(JS+1) DO 170 IH=1,NCURR*NCURR QSS(IIQ)=ZNOR*QSS(IIQ) IIQ=IIQ+1 170 CONTINUE 180 CONTINUE 190 CONTINUE DO 210 IIQ=1,135,9 DO 200 IIS=1,8,2 QSS(IIQ+IIS)=-QSS(IIQ+IIS) 200 CONTINUE 210 CONTINUE ELSE * RECOVER PSI AND PSS INFORMATION FROM DP-0 PIJ CALCULATION. IIQ=1 IIJ=0 DO 230 JS=0,NSURFQ-1 DO 220 IS=0,JS-1 QSS(IIQ)=4.0*WORKIJ(IIJ) IIQ=IIQ+NCURR*NCURR IIJ=IIJ+1 220 CONTINUE IIJ=IIJ+1 230 CONTINUE IIJ=NSURFQ*(NSURFQ+1)/2 DO 250 IR=1,NREG DO 240 JS=0,NSURFQ-1 PSIX(JS,1,IR)=WORKIJ(IIJ+JS)/SIGTR(IR)/VOL(IR) 240 CONTINUE IIJ=IIJ+NSURFQ+IR 250 CONTINUE ENDIF *---- * LOAD THE EURYDICE CP ARRAYS *---- DO 270 I=1,NREG DO 260 IH=1,NCURR SGN=1.0 IF(IH.EQ.2) SGN=-1.0 PVS(I,INC(1,IH))=SGN*PSIX(2,IH,I) PVS(I,INC(2,IH))=SGN*PSIX(3,IH,I) PVS(I,INC(3,IH))=SGN*PSIX(4,IH,I) PVS(I,INC(4,IH))=SGN*PSIX(5,IH,I) PVS(I,INC(5,IH))=SGN*PSIX(0,IH,I) PVS(I,INC(6,IH))=SGN*PSIX(1,IH,I) 260 CONTINUE 270 CONTINUE DO 290 I=1,6*NCURR DO 280 J=1,6*NCURR PSS(I,J)=0.0 280 CONTINUE 290 CONTINUE DO 310 IH=1,NCURR DO 300 JH=1,NCURR PSS(INC(2,IH),INC(1,JH))=QSS(INQ(IH,JH,6))/HSIDE PSS(INC(3,IH),INC(1,JH))=QSS(INQ(IH,JH,9))/HSIDE PSS(INC(4,IH),INC(1,JH))=QSS(INQ(JH,IH,13))/HSIDE PSS(INC(5,IH),INC(1,JH))=QSS(INQ(JH,IH,2))/HSIDE PSS(INC(6,IH),INC(1,JH))=QSS(INQ(JH,IH,3))/HSIDE PSS(INC(1,IH),INC(2,JH))=QSS(INQ(JH,IH,6))/HSIDE PSS(INC(3,IH),INC(2,JH))=QSS(INQ(IH,JH,10))/HSIDE PSS(INC(4,IH),INC(2,JH))=QSS(INQ(IH,JH,14))/HSIDE PSS(INC(5,IH),INC(2,JH))=QSS(INQ(JH,IH,4))/HSIDE PSS(INC(6,IH),INC(2,JH))=QSS(INQ(JH,IH,5))/HSIDE PSS(INC(1,IH),INC(3,JH))=QSS(INQ(JH,IH,9))/HSIDE PSS(INC(2,IH),INC(3,JH))=QSS(INQ(JH,IH,10))/HSIDE PSS(INC(4,IH),INC(3,JH))=QSS(INQ(IH,JH,15))/HSIDE PSS(INC(5,IH),INC(3,JH))=QSS(INQ(JH,IH,7))/HSIDE PSS(INC(6,IH),INC(3,JH))=QSS(INQ(JH,IH,8))/HSIDE PSS(INC(1,IH),INC(4,JH))=QSS(INQ(JH,IH,13))/HSIDE PSS(INC(2,IH),INC(4,JH))=QSS(INQ(JH,IH,14))/HSIDE PSS(INC(3,IH),INC(4,JH))=QSS(INQ(JH,IH,15))/HSIDE PSS(INC(5,IH),INC(4,JH))=QSS(INQ(JH,IH,11))/HSIDE PSS(INC(6,IH),INC(4,JH))=QSS(INQ(JH,IH,12))/HSIDE PSS(INC(1,IH),INC(5,JH))=QSS(INQ(IH,JH,2))/HSIDE PSS(INC(2,IH),INC(5,JH))=QSS(INQ(JH,IH,4))/HSIDE PSS(INC(3,IH),INC(5,JH))=QSS(INQ(IH,JH,7))/HSIDE PSS(INC(4,IH),INC(5,JH))=QSS(INQ(IH,JH,11))/HSIDE PSS(INC(6,IH),INC(5,JH))=QSS(INQ(IH,JH,1))/HSIDE PSS(INC(1,IH),INC(6,JH))=QSS(INQ(IH,JH,3))/HSIDE PSS(INC(2,IH),INC(6,JH))=QSS(INQ(IH,JH,5))/HSIDE PSS(INC(3,IH),INC(6,JH))=QSS(INQ(JH,IH,8))/HSIDE PSS(INC(4,IH),INC(6,JH))=QSS(INQ(IH,JH,12))/HSIDE PSS(INC(5,IH),INC(6,JH))=QSS(INQ(JH,IH,1))/HSIDE 300 CONTINUE 310 CONTINUE *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(LGFULL) DEALLOCATE(G,PSIX,WORKIJ,VOLINT) DEALLOCATE(NUMREG) RETURN END