*DECK D2PBRA SUBROUTINE D2PBRA( IPDAT,IPINP,IPHEL,STAVEC,DEB,SIGNAT,IPRINT ) * *----------------------------------------------------------------------- * *Purpose: * Recover information from the INFO data block for a complete branch * and write it in the IPHEL file . The format of this file is described * in the DRAG2PARCS: manual. This routine write sequentially the IPHEL * file, branch after branch * *Author(s): * J. Taforeau * *Parameters: input * IPDAT address of info data block * IPINP file unit of the input file GENPMAXS.inp * IPHEL file unit of the HELIOS.dra file * STAVEC various parameters associated with the IPDAT structure * DEB flag for D2PGEN * SIGNAT signature of the object containing cross sections * IPRINT control the printing on screen * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPDAT INTEGER IPINP,IPHEL,STAVEC(40),DEB,IPRINT CHARACTER*16 SIGNAT *---- * LOCAL VARIABLES *---- INTEGER GRID,ITBRAN,NVAR,i,j,k INTEGER NSF,NGP,NXS,NBU,FLPRIN,LMER INTEGER STAIDX(STAVEC(2)),PKIDX(STAVEC(2)) INTEGER IUPS,FA_K,NADF,NCDF,NPIN,NCOLA,NROWA,XESM REAL XS(STAVEC(1),STAVEC(3),STAVEC(4)) ! TABLE FOR XS REAL ADF(STAVEC(13),STAVEC(1),STAVEC(4)) REAL FLXL(STAVEC(1),STAVEC(4)) REAL FLXR(STAVEC(1),STAVEC(4)) REAL CURL(STAVEC(1),STAVEC(4)) REAL CURR(STAVEC(1),STAVEC(4)) REAL CDF(STAVEC(15),STAVEC(1),STAVEC(4)) REAL GFF(STAVEC(8),STAVEC(9),STAVEC(1),STAVEC(4)) REAL SCAT(STAVEC(1)*STAVEC(1),STAVEC(4)) REAL BURN(STAVEC(4)),XSC(3),DATSRC(5) REAL DIV(3,STAVEC(4)) REAL ND(2,STAVEC(4)) CHARACTER(len=4) BRANCH,JOB(4) CHARACTER*12 FILNAM CHARACTER COM CHARACTER*16 JOBTIT CHARACTER JOBOPT(16) CHARACTER*3 ADF_T CHARACTER*1 DER REAL FC1(5) REAL FC2(8) REAL FC3(7) REAL FC4(3) REAL VERS,SFAC,BFAC LOGICAL :: LTH = .FALSE. LOGICAL :: LADF = .FALSE. LOGICAL :: LXES = .FALSE. LOGICAL :: LCDF = .FALSE. LOGICAL :: LGFF = .FALSE. LOGICAL :: LDET = .FALSE. ! INITIALIZATION OF VARIABLES NGP=STAVEC(1) NVAR=STAVEC(2) NXS=STAVEC(3) NBU=STAVEC(4) GRID=STAVEC(5) NCOLA=STAVEC(8) NROWA=STAVEC(9) NPART=STAVEC(10) NSF=STAVEC(11) NCF=STAVEC(12) NADF=STAVEC(13) NCDF=STAVEC(15) NGFF=STAVEC(16) NPIN=STAVEC(17) LMER=STAVEC(21) IF(IPRINT > 0) THEN WRITE(6,*) WRITE(6,*) "**** WRITING CURRENT BRANCH IN HELIOS FILE ****" ENDIF ! RECOVER INFORMATION FROM INFO DATA BLOCK CALL LCMSIX(IPDAT,' ',0) CALL LCMSIX(IPDAT,'HELIOS_HEAD',1) CALL LCMGET(IPDAT,'FILE_CONT_1',FC1) CALL LCMGET(IPDAT,'FILE_CONT_2',FC2) CALL LCMGET(IPDAT,'FILE_CONT_3',FC3) CALL LCMGET(IPDAT,'FILE_CONT_4',FC4) CALL LCMGET(IPDAT,'XS_CONT',XSC) CALL LCMSIX(IPDAT,' ',0) CALL LCMSIX(IPDAT,'GENPMAXS_INP',1) CALL LCMGET(IPDAT,'DAT_SRC',DATSRC) CALL LCMGTC(IPDAT,'JOB_OPT',4,4,JOB) CALL LCMGET(IPDAT,'VERSION',VERS) CALL LCMSIX(IPDAT,' ',0) CALL LCMSIX(IPDAT,'BRANCH_INFO',1) CALL LCMGET(IPDAT,'PRINT',FLPRIN) CALL LCMGET(IPDAT,'STATE_INDEX',STAIDX) CALL LCMGET(IPDAT,'BRANCH_IT',ITBRAN) CALL LCMGTC(IPDAT,'BRANCH',4,BRANCH) CALL LCMSIX(IPDAT,' ',0) CALL LCMSIX(IPDAT,'SAPHYB_INFO',1) CALL LCMGET(IPDAT,'PKIDX',PKIDX) CALL LCMGET(IPDAT,'BURN',BURN) i=1 DO j=1,4 DO k=1,4 JOBOPT(i)= JOB(j)(k:k) i=i+1 ENDDO ENDDO IF(JOBOPT(1)=='T') THEN LADF = .TRUE. CALL LCMGTC(IPDAT,'ADF_TYPE',3,ADF_T) ENDIF IF(JOBOPT(2)=='T') LXES = .TRUE. IF(JOBOPT(8)=='T') LDET = .TRUE. IF((JOBOPT(5)=='T').OR.(JOBOPT(7)=='T').OR. > (JOBOPT(9)=='T').OR.(JOBOPT(13)=='T').OR.(JOBOPT(12)=='T'))THEN LTH =.TRUE. ENDIF IF(JOBOPT(10)=='T') LCDF = .TRUE. IF(JOBOPT(11)=='T') LGFF = .TRUE. ! WRITE THE CURRENT BRANCH IN THE HELIOS.DRA FILE IF(FLPRIN==1) THEN ! RECOVER CROSS SECTIONS FROM THE TEMPORARY FILE CALL READXS (IPDAT, XS, SCAT, ND, DIV, NGP, > NXS, ADF, CDF, GFF, NBU, NADF, > DATSRC, GRID, NCDF, NCOLA, NROWA, LADF, > LCDF, LGFF, LXES, LDET, SIGNAT, LMER, > IPRINT, ADF_T, FLXL, FLXR, CURL, CURR) ! WRITE IN HELIOS.DRA THE SET OF BURNUP POINTS CALL SETBU (IPHEL,BRANCH,ITBRAN,XSC,BURN,NBU, IPRINT) ! WRITE IN HELIOS.DRA THE SET OF CROSS SECTIONS CALL SETXS ( IPHEL, BRANCH, ITBRAN, XS, NGP, NXS, > NBU, BURN, DATSRC, LXES, LDET,IPRINT) ! WRITE IN HELIOS.DRA THE ELEMENT OF THE SCATTERING MATRIX CALL SETSCT(IPHEL,BRANCH,ITBRAN,SCAT,NGP,NBU,BURN, IPRINT) IF(LADF.AND.(LMER.EQ.0)) THEN CALL SETADF( IPHEL, BRANCH, ITBRAN, ADF, NADF, NGP, > NBU, BURN, IPRINT, ADF_T, FLXR, FLXL, > CURL, CURR) ENDIF IF(DATSRC(3)==1.0) THEN IF(LXES) THEN ! WRITE IN HELIOS.DRA THE NUMBRE DENSITIES FOR XENON AND ! SAMARIUM CALL SETND (IPHEL,BRANCH,ITBRAN, ND,NBU,BURN, IPRINT) ENDIF IF((GRID<2).AND.(SIGNAT.EQ.'L_SAPHYB'))THEN ! WRITE IN HELIOS.DRA THE DIVERS INFORMATION CALL SETDIV(IPHEL,BRANCH,ITBRAN,DIV,NBU,BURN,IPRINT) ENDIF IF(LTH) THEN ! WRITE IN HELIOS.DRA THE T:H INVARIANT DATA BLOCK CALL SETTH ( IPHEL, BRANCH, ITBRAN, BURN, NBU, JOBOPT, > NGP, IPDAT, IPRINT ) ENDIF IF(LCDF) THEN CALL SETCDF( IPHEL, BRANCH, ITBRAN, CDF, NCDF, NGP, > NBU, BURN, IPRINT ) ENDIF IF(LGFF) THEN IF ((NCOLA .NE. NPIN) .OR. (NROWA .NE.NPIN)) THEN WRITE (6,*) "@D2PBRA: NUMBER OF PIN IN MCO (NPIN= ",NPIN, > ") INCOHERENT WITH ncols AND nrows (",NCOLA,') IN D2P: INPUT' CALL XABORT ('') ENDIF CALL SETGFF( IPHEL, BRANCH, ITBRAN, GFF, NCOLA, NROWA, > NPART, NGP, NBU, BURN, NGFF, IPRINT, > VERS) ENDIF ENDIF ! SIGNATURE OF THE END OF A BRANCH (MANDATORY FOR GENPMAXS ! CODE) WRITE(IPHEL,*) WRITE(IPHEL,30)'*********************************************' WRITE(IPHEL,30)'* Normal End, No warning messages issued *' WRITE(IPHEL,30)'* *' WRITE(IPHEL,30)'* Total CPU time used = *' WRITE(IPHEL,30)'*********************************************' 30 FORMAT(25X,A) ENDIF ! UPDATE OF THE INFO DATA BLOCK CALL LCMSIX(IPDAT,' ',0) CALL LCMSIX(IPDAT,'GENPMAXS_INP',1) CALL LCMPUT(IPDAT,'FLAG',1,1,1) IF(IPRINT > 0) THEN WRITE(6,*) "******** UPDATING the GENPMAXS.INP FILE *********" ENDIF ! UPDATE OF THE GENPMAXS.INP FILE (MANY ARGUMENTS IN THIS CALL ! ARE NOT USED IN D2PGEN) CALL D2PGEN( IPINP, IPDAT, STAVEC, JOBTIT, FILNAM, DER, > VERS, COM, JOBOPT, IUPS, FA_K, SFAC, > BFAC, DEB, XESM, FC1 , FC2, FC3, > FC4, XSC, IPRINT ) IF(IPRINT > 0) THEN WRITE(6,*)"********* SELECTING A NEW BRANCH CALCULATION *****" ENDIF CALL D2PSEL ( IPDAT, IPINP, STAVEC,BRANCH, ITBRAN, STAIDX, > NVAR, JOBOPT, DEB, FC1 , FC2, FC3, > FC4, XSC, IPRINT ) WRITE(6,*) "********* BRANCH SELECTED *****" END SUBROUTINE SETBU(IPHEL,BRANCH,ITBRAN,XSC,BURN,NBU,IPRINT) * *----------------------------------------------------------------------- * *Purpose: * Write in the HELIOS.dra file the inforamtion about burnup points and * XSC card (sides in assembly (NSIDES), * corners in assembly (NCORNERS), VFCM). * This routine write sequentially the HELIOS.dra file, branch after * branch. * *parameters: input * IPHEL file unit of the HELIOS.dra file * BRANCH nature of the current branch ( CR, DC, CB, TC, TM etc ) * ITBRAN index of the current branch * XSC content of the XS_CONT card * BURN set of burnup points * NBU number of bunup points * IPRINT control the printing on screen * *----------------------------------------------------------------------- * *---- * SUBROUTINE ARGUMENTS *---- INTEGER NBU,ITBRAN,IPHEL,IPRINT REAL XSC(3),BURN (NBU) CHARACTER BRANCH*4 *---- * LOCAL VARIABLES *---- ! number of sides and corners in assembly INTEGER NSIDE, NCORNER NSIDE = NINT(XSC(1)) NCORNER = NINT(XSC(2)) ! XS_CONT CARD (Cf DRAG2PARCS Manual for details on HELIOS format) IF (IPRINT>5) WRITE(6,*) 'SETBU: WRITE BURNUP INFO' ! HEADER OF XS_CONT card WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : KINF' WRITE(IPHEL,*) 'List Title(s) 1) ===========================' WRITE(IPHEL,*) ' 2) %STAT_xxxx' WRITE(IPHEL,*) ' 3) ===========================' WRITE(IPHEL,*) ' 4)%XS_CONT' WRITE(IPHEL,*) ' 5)Meaning : NBN,NSIDE,NCORNER,' 1 //'VFCM' ! RIEGO block of HELIOS.dra file CALL SET_RIEGO(IPHEL) ! Set the content of XS_CONT in HELIOS.dra WRITE(IPHEL,'(25X,4A14)') ' NBN', 1 ' NSIDE',' NCORNER',' VFCM' WRITE(IPHEL,200) 'Label E','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.', 1 '1-.-E-.-.' WRITE(IPHEL,'(I4,1X,A,I4,A,A,I4,A,I5,3I12,ES12.5E2)') 1 1,BRANCH(1:2),ITBRAN,' ',BRANCH(1:2),ITBRAN,':', 2 0,NBU,NSIDE,NCORNER, 3 XSC(3) WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' ! BURNUP INFORMATION ! HEADER OF Burnup card WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : KINF' WRITE(IPHEL,*) 'List Title(s) 1) ===========================' WRITE(IPHEL,*) ' 2) %XS_STAT' WRITE(IPHEL,*) ' 3) ===========================' WRITE(IPHEL,*) ' 4)Meaning : Bunrup' ! RIEGO block of HELIOS.dra file CALL SET_RIEGO(IPHEL) WRITE(IPHEL,'(30X,A6)') 'BURNUP' WRITE(IPHEL,210) 'Label E','.-.-E-.-.' ! LOOP over burnup points DO IT=1, NBU WRITE(IPHEL,220) IT,BRANCH(1:2),ITBRAN,' ', 1 BRANCH(1:2),ITBRAN,':',NINT(BURN(IT)),BURN(IT)/1000.0 ENDDO WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' ! format of HELIOS.dra file 200 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A) 210 FORMAT(6X,A,12X,A) 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5,6X,F6.3) END SUBROUTINE READXS (IPDAT, XS, SCAT, ND, DIV, NGP, > NXS, ADF, CDF, GFF, NBU, NADF, > DATSRC, GRID, NCDF, NCOLA, NROWA, LADF, > LCDF, LGFF, LXES, LDET, SIGNAT, LMER, > IPRINT, ADF_T, FLXL, FLXR, CURL, CURR) * *----------------------------------------------------------------------- * *Purpose: * Recover cross section from the INFO data block. * *parameters: input * IPDAT address of info data block * XS table of cross sections * SCAT scattering matrix * ND number densities for xenon and samarium * DIV divers info directory * NGP number of energy groups * NXS number of cross sections * NBU number of burnup points * ADF assembly dicontinuity factor * NADF number of surfaces in assembly * NCDF number of corners in assembly * NCOLA number of pin in assembly along x-axis * NROWA number of pin in assembly along y-axis * GRID type of gridding for branching calculation * LADF flag for assembly discontinuity factors * LCDF flag for corner discontinuity factors * LGFF flag for group form factors * LXES flag for microscopic cross sections * DAT SRC array containing the DATA source (reflector of fuel) * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPDAT INTEGER NGP,NBU,NXS,NADF,GRID,NCDF,LMER REAL DATSRC(5) REAL XS(NGP,NXS,NBU) REAL SCAT(NGP*NGP,NBU) REAL ND(2,NBU) REAL DIV(3,NBU) REAL ADF(NADF,NGP,NBU) REAL FLXL(NGP,NBU) REAL FLXR(NGP,NBU) REAL CURL(NGP,NBU) REAL CURR(NGP,NBU) REAL CDF(NCDF,NGP,NBU) REAL GFF(NCOLA,NROWA,NGP,NBU) REAL ADFMOY(NGP,NBU) LOGICAL LADF,LXES,LCDF,LGFF,LDET CHARACTER*16 SIGNAT *---- * LOCAL VARIABLES *---- TYPE(C_PTR) IPTH,KPTH INTEGER BU CHARACTER*3 ADF_T IF(IPRINT>5) WRITE(6,*) 'READXS: RECOVER INFO DATA BLOCK' ! LOOP over burnup points DO BU=1, NBU CALL LCMSIX(IPDAT,' ',0) CALL LCMSIX(IPDAT,'BRANCH_INFO',1) IPTH=LCMGID(IPDAT,'CROSS_SECT') KPTH=LCMDIL(IPTH,BU) CALL LCMSIX(KPTH,'MACROLIB_XS',1) CALL LCMGET(KPTH,'XTR',XS(1:NGP,1,BU)) CALL LCMGET(KPTH,'ABSORPTION',XS(1:NGP,2,BU)) CALL LCMGET(KPTH,'X_NU_FI',XS(1:NGP,3,BU)) CALL LCMGET(KPTH,'KAPPA_FI',XS(1:NGP,4,BU)) IF(LXES)CALL LCMGET(KPTH,'SFI',XS(1:NGP,7,BU)) IF(LADF) THEN IF (ADF_T.EQ.'DRA')THEN CALL LCMGET(KPTH,'ADF',ADF(:,:,BU)) ELSE IF(ADF_T.EQ.'GEN')THEN CALL LCMGET(KPTH,'FLXL',FLXL(:,BU)) CALL LCMGET(KPTH,'FLXR',FLXR(:,BU)) CALL LCMGET(KPTH,'CURR',CURR(:,BU)) CALL LCMGET(KPTH,'CURL',CURL(:,BU)) ENDIF ENDIF IF(LCDF)CALL LCMGET(KPTH,'CDF',CDF(:,:,BU)) IF(LGFF)CALL LCMGET(KPTH,'GFF',GFF(:,:,:,BU)) CALL LCMGET(KPTH,'SCAT',SCAT(1:NGP*NGP,BU)) IF(DATSRC(3)==1) THEN IF((LXES).OR.(LDET)) THEN CALL LCMSIX(KPTH,' ',2) CALL LCMSIX(KPTH,'MICROLIB_XS',1) IF(LDET) CALL LCMGET(KPTH,'DET',XS(1:NGP,8,BU)) IF (LXES) THEN CALL LCMGET(KPTH,'XENG',XS(1:NGP,5,BU)) CALL LCMGET(KPTH,'SMNG',XS(1:NGP,6,BU)) CALL LCMGET(KPTH,'XEND',ND(1,BU)) CALL LCMGET(KPTH,'SMND',ND(2,BU)) ENDIF ENDIF IF((GRID<2).and. (SIGNAT.EQ.'L_SAPHYB')) THEN CALL LCMSIX(IPDAT,' ',0) CALL LCMSIX(IPDAT,'BRANCH_INFO',1) IPTH=LCMGID(IPDAT,'DIVERS') KPTH=LCMDIL(IPTH,BU) CALL LCMGET(KPTH,'KEFF',DIV(1,BU)) CALL LCMGET(KPTH,'KINF',DIV(2,BU)) CALL LCMGET(KPTH,'B2',DIV(3,BU)) ENDIF ENDIF ENDDO IF (LMER.EQ.1) THEN DO I=1,NGP DO BU=1,NBU ADFMOY(I,BU)=SUM(ADF(1:NADF,I,BU))/NADF ENDDO ENDDO DO I=1,NGP DO BU=1,NBU SCAT(I,BU)=SCAT(I,BU)/ADFMOY(NGP-1+1,BU) SCAT(I+NGP,BU)=SCAT(I+NGP,BU)/ADFMOY(NGP-I+1,BU) XS(I,1,BU)=XS(I,1,BU)*ADFMOY(I,BU) XS(I,2:NXS,BU)=XS(I,2:NXS,BU)/ADFMOY(I,BU) ENDDO ENDDO ENDIF CALL LCMSIX(IPDAT,' ',0) END SUBROUTINE SETXS( IPHEL, BRANCH, ITBRAN, XS, NGP, NXS, > NBU, BURN, DATSRC, LXES, LDET, IPRINT) * *----------------------------------------------------------------------- * *Purpose: * Write in the HELIOS.dra file the cross sections for a banch * (including all burnup points). * This routine write sequentially the HELIOS.dra file, branch after * branch. * *parameters: input * IPHEL file unit of the HELIOS.dra file * BRANCH nature of the current branch ( CR, DC, CB, TC, TM etc ) * ITBRAN index of the current branch * XS table of cross sections * NGP number of energy groups * NXS number of cross sections * NBU number of burnup points * BURN set of burnup points * IPRINT control the printing on screen * DATSRC array containing the DATA source (reflector of fuel) * LXES flag for presence of micoscopic cross sections * *----------------------------------------------------------------------- * *---- * SUBROUTINE ARGUMENTS *---- INTEGER IPHEL,NBU,NXS,NGP,ITBRAN ! REAL XS(NGP,NXS,NBU),BURN (NBU),DATSRC(3) REAL XS(NGP,NXS,NBU),BURN (NBU),DATSRC(5) CHARACTER(len=4) BRANCH,XS_name LOGICAL LXES,LDET *---- * LOCAL VARIABLES *---- INTEGER XST ! INDEX OF CROSS SECTIONS REAL FA_KIND LOGICAL :: LXS = .TRUE. IF(IPRINT>5) WRITE(6,*) 'SETXS: WRITE INFO FOR A BANCH' FA_KIND=DATSRC(3) ! LOOP OVER CROSS SECTIONS TYPE DO XST=1, NXS LXS = .TRUE. SELECT CASE (XST) CASE (1) XS_name = 'STR' ! TRANSPORT XS CASE (2) XS_name = 'SAB' ! ABSORPTION XS CASE (3) XS_name = 'SNF' ! NU SIGMA FISSION XS CASE (4) XS_name = 'SKF' ! KAPPA FISSION XS CASE (5) IF(.NOT. LXES) LXS=.FALSE. XS_name = 'XENG' ! XE MICROSCOPIC ABSORPTION XS CASE (6) IF(.NOT. LXES) LXS=.FALSE. XS_name = 'SMNG' ! SM MICROSCOPIC ABSORPTION XS CASE (7) IF(.NOT. LXES) LXS=.FALSE. XS_name = 'SFI' ! FISSION XS CASE (8) IF(.NOT. LDET) LXS=.FALSE. XS_name = 'DET' ! DETECTOR XS END SELECT IF(LXS) THEN ! LABEL FOR XS TYPE WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,110) XS_name WRITE(IPHEL,120) XS_name 110 FORMAT(29H List Title(s) 1) %XS_PRIN %,A) 120 FORMAT(34H Meaning : (.-.-E-G-.) G-th Group ,A, 1 15H cross sections) CALL SET_RIEGO(IPHEL) ! LOOP OVER ENERGY GROUPS ! CREATION OF LABEL FOR CROSS SECTIONS DO IT=1, NGP IF(IT==1) THEN WRITE(IPHEL,'(27X,A4,A2)',advance='no') XS_name,'Xs' ELSE IF(IT==NGP .OR. IT==8 ) THEN WRITE(IPHEL,'(5X,A4,A2)')XS_name,'Xs' ELSE WRITE(IPHEL,'(5X,A4,A2)',advance='no')XS_name,'Xs' ENDIF ENDDO DO IT=1, NGP IF(IT==1) THEN WRITE(IPHEL,'(6X,A,12X,A,I1,A)',advance='no') 1 'Label E','.-.-E-',IT,'-.' ELSE IF(IT==NGP .OR. IT==8 ) THEN WRITE(IPHEL,'(3X,A,I1,A)') 1 '.-.-E-',IT,'-.' ELSE WRITE(IPHEL,'(3X,A,I1,A)',advance='no') 1 '.-.-E-',IT,'-.' ENDIF ENDDO ! STORE XS DATA IN HELIOS.DRA FILE ! LOOP OVER BURNUP POINTS DO NB=1, NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) DO NG=1, NGP IF(NG == 1) THEN WRITE(IPHEL,'(ES12.5E2)',advance='no') XS(NG,XST,NB) ELSE IF(NG.NE.NGP) THEN WRITE(IPHEL,'(ES12.5E2)',advance='no') XS(NG,XST,NB) ELSE WRITE(IPHEL,'(ES12.5E2)') XS(NG,XST,NB) ENDIF ENDDO ! NG ENDDO ! NB 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' ENDIF ENDDO ! XST END SUBROUTINE SETADF( IPHEL, BRANCH, ITBRAN, ADF, NADF, NGP, > NBU, BURN, IPRINT,ADF_T, FLXR, FLXL, > CURL, CURR ) *----------------------------------------------------------------------- * *Purpose: * Write in the HELIOS.dra file the cross sections for a banch * (including all burnup points). * This routine write sequentially the HELIOS.dra file, branch after * branch. * *parameters: input * IPHEL file unit of the HELIOS.dra file * BRANCH nature of the current branch ( CR, DC, CB, TC, TM etc ) * ITBRAN index of the current branch * ADF Assembly discontinuity factor * NADF number of Assembly discontinuity factor * NGP number of energy groups * NBU number of burnup points * BURN set of burnup points * IPRINT control the printing on screen * *----------------------------------------------------------------------- * *---- * SUBROUTINE ARGUMENTS *---- INTEGER IPHEL,NBU,NGP,NADF,ITBRAN,NIT,IPRINT REAL ADF(NADF,NGP,NBU),BURN (NBU) REAL FLXR(NGP,NBU),FLXL(NGP,NBU) REAL CURR(NGP,NBU),CURL(NGP,NBU), BNO(NGP,NBU) CHARACTER*3 ADF_T CHARACTER BRANCH*4 *---- * LOCAL ARGUMENTS *---- INTEGER IT,ITA REAL ADF_TMP(NADF,NGP,NBU) CHARACTER*4 BOUND CHARACTER*12 LABEL,XSPRIN IF(IPRINT>5) WRITE(6,*) 'SETADF: RECOVER ADF INFO' IF (ADF_T.EQ.'DRA') THEN NIT=0 IF((NADF.NE.1) .AND. (NADF.NE.4)) THEN WRITE(6,*) "NUMBER OF ADF : ",NADF CALL XABORT (" NUMBER OF ADF MUST BE 4 (SEL/GET/DRA) OR 1 " > //"(DRA)") ELSE IF(NADF == 4) THEN ! CASE FOR SEL OR GET ADF ! REARRANGEMENT OF ADF ORDER TO MATCH HELIOS iN CASE OD SEL OR ! GET ADF ! SAPHYB SURF => SIDE ! 1 N ! 2 E ! 3 S ! 4 W ! HELIOS SURF => SIDE ! 1 W ! 2 S ! 3 E ! 4 N ADF_TMP(:,:,:)=ADF(:,:,:) ADF(1,:,:)=ADF_TMP(4,:,:) ADF(2,:,:)=ADF_TMP(3,:,:) ADF(3,:,:)=ADF_TMP(2,:,:) ADF(4,:,:)=ADF_TMP(1,:,:) ENDIF NIT = NGP*NADF ! LABEL FOR XS TYPE : ADF WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,*) 'List Title(s) 1) %XS_PRIN %SDF 2' WRITE(IPHEL,*)'2) Meaning : (F-.-E-G-.) F-Face, G-Group' IF(NADF==4) THEN WRITE(IPHEL,*)'3) F=1/2/3/4 denotes W/S/E/N Side' ELSE WRITE(IPHEL,*)'3) F=1 denotes average ADF' ENDIF CALL SET_RIEGO(IPHEL) ! LOOP OVER ENERGY GROUPS ! CREATION OF LABEL FOR CROSS SECTIONS ngrp=1 nsurf=0 DO ITA=1,NIT,7 ! ITA NITTMP=MIN(NIT-ITA+1,7) ngrpb=ngrp nsurfb=nsurf DO IT=1,NITTMP IF((IT==1).AND.(IT.LT.NITTMP)) THEN WRITE(IPHEL,'(30X,A6)',advance='no') 'SideDF' ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN WRITE(IPHEL,'(30X,A6)') 'SideDF' ELSE IF(IT.EQ.NITTMP) THEN WRITE(IPHEL,'(6X,A6)')'SideDF' ELSE WRITE(IPHEL,'(6X,A6)',advance='no')'SideDF' ENDIF ENDDO DO IT=1,NITTMP nsurf=nsurf+1 IF(nsurf.GT.NADF) THEN nsurf=1 ngrp=ngrp+1 ENDIF IF((IT==1).AND.(IT.LT.NITTMP)) THEN WRITE(IPHEL,'(6X,A,14X,I1,A,I1,A)',advance='no') > 'Label E',nsurf,'-.-E-',ngrp,'-.' ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN WRITE(IPHEL,'(6X,A,14X,I1,A,I1,A)') > 'Label E',nsurf,'-.-E-',ngrp,'-.' ELSE IF(IT.EQ.NITTMP) THEN WRITE(IPHEL,'(3X,I1,A,I1,A)') nsurf,'-.-E-',ngrp,'-.' ELSE WRITE(IPHEL,'(3X,I1,A,I1,A)',advance='no') > nsurf,'-.-E-',ngrp,'-.' ENDIF ENDDO ! STORE XS DATA IN HELIOS.DRA FILE ! LOOP OVER BURNUP POINTS DO NB=1,NBU ngrp=ngrpb nsurf=nsurfb WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) DO IT=1,NITTMP nsurf=nsurf+1 IF(nsurf.GT.NADF) THEN nsurf=1 ngrp=ngrp+1 ENDIF ! in xs_helios_read.f90 ! l1015 READ(XS_set_unit,hfnF5) rvector(1:RIEGO%how_many_data) ! in xs_heliosM.f90 ! l104 hfnF5='( X,8F13.5) ' IF(IT.EQ.NITTMP) THEN WRITE(IPHEL,'(5X,F7.5)') ADF(nsurf,ngrp,NB) ELSE WRITE(IPHEL,'(5X,F7.5)',advance='no') ADF(nsurf,ngrp,NB) ENDIF ENDDO ENDDO WRITE(IPHEL,*) ENDDO WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' ELSE IF (ADF_T.EQ.'GEN') THEN DO I=1,4 SELECT CASE (I) CASE(1) XSPRIN='%PHW 1' BOUND='West' LABEL='FluxWest' BNO=FLXL CASE(2) XSPRIN='%PHE 1' BOUND='East' LABEL='FluxEast' BNO=FLXR CASE(3) XSPRIN='%JNW 1' BOUND='West' LABEL='JnetWest' BNO=CURL CASE(4) XSPRIN='%JNE 1' BOUND='East' LABEL='JnetEast' BNO=CURR END SELECT WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,*) 'List Title(s) 1) %XS_PRIN ',XSPRIN WRITE(IPHEL,'(16X,3A)')'2) Meaning : (E-.-E-G-.) ', > BOUND,'-Face, G-Group' CALL SET_RIEGO(IPHEL) WRITE(IPHEL,'(31X,A8,4X,A8)') LABEL,LABEL WRITE(IPHEL,'(18X,A)') 'Label E 1-.-E-1-. 1-.-E-2-.' DO NB=1,NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(ES12.5E2,1X,ES11.4E2)') BNO(:,NB) WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' ENDDO ENDDO ENDIF 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) END SUBROUTINE SETCDF( IPHEL, BRANCH, ITBRAN, CDF, NCDF, NGP, > NBU, BURN, IPRINT ) * *----------------------------------------------------------------------- * *Purpose: * Write in the HELIOS.dra file the cross sections for a banch * (including all burnup points). * This routine write sequentially the HELIOS.dra file, branch after * branch. * *parameters: input * IPHEL file unit of the HELIOS.dra file * BRANCH nature of the current branch ( CR, DC, CB, TC, TM etc ) * ITBRAN index of the current branch * CDF Corner discontinuity factor * NCDF number of corner discontinuity factor * NGP number of energy groups * NBU number of burnup points * BURN set of burnup points * IPRINT control the printing on screen * *----------------------------------------------------------------------- * *---- * SUBROUTINE ARGUMENTS *---- INTEGER IPHEL,NBU,NGP,NCDF,ITBRAN,NIT,IPRINT REAL CDF(NCDF,NGP,NBU),BURN (NBU) CHARACTER BRANCH*4 *---- * LOCAL ARGUMENTS *---- INTEGER IT,ITA IF(IPRINT>5) WRITE(6,*) 'SETCDF: RECOVER CDF INFO' NIT = NGP*NCDF ! LABEL FOR XS TYPE : CDF WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,*) 'List Title(s) 1) %XS_PRIN %CDF' WRITE(IPHEL,*)'2) Meaning : (F-.-E-G-.) F-Face, G-Group' IF(NCDF==1) THEN WRITE(IPHEL,*)'3) F=1 denotes average CDF' ELSE WRITE(IPHEL,*)'3) F= custom' ENDIF CALL SET_RIEGO(IPHEL) ! LOOP OVER ENERGY GROUPS ! CREATION OF LABEL FOR CROSS SECTIONS ngrp=1 nsurf=0 DO ITA=1,NIT,7 ! ITA NITTMP=MIN(NIT-ITA+1,7) ngrpb=ngrp nsurfb=nsurf DO IT=1,NITTMP IF((IT==1).AND.(IT.LT.NITTMP)) THEN WRITE(IPHEL,'(30X,A6)',advance='no') 'CornDF' ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN WRITE(IPHEL,'(30X,A6)') 'CornDF' ELSE IF(IT.EQ.NITTMP) THEN WRITE(IPHEL,'(6X,A6)')'CornDF' ELSE WRITE(IPHEL,'(6X,A6)',advance='no')'CornDF' ENDIF ENDDO DO IT=1,NITTMP nsurf=nsurf+1 IF(nsurf.GT.NCDF) THEN nsurf=1 ngrp=ngrp+1 ENDIF IF((IT==1).AND.(IT.LT.NITTMP)) THEN WRITE(IPHEL,'(6X,A,15X,I1,A,I1,A)',advance='no') > 'Label E',nsurf,'-.-E-',ngrp,'-.' ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN WRITE(IPHEL,'(6X,A,15X,I1,A,I1,A)') > 'Label E',nsurf,'-.-E-',ngrp,'-.' ELSE IF(IT.EQ.NITTMP) THEN WRITE(IPHEL,'(2X,I1,A,I1,A)') nsurf,'-.-E-',ngrp,'-.' ELSE WRITE(IPHEL,'(2X,I1,A,I1,A)',advance='no') > nsurf,'-.-E-',ngrp,'-.' ENDIF ENDDO ! STORE XS DATA IN HELIOS.DRA FILE ! LOOP OVER BURNUP POINTS DO NB=1,NBU ngrp=ngrpb nsurf=nsurfb WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) DO IT=1,NITTMP nsurf=nsurf+1 IF(nsurf.GT.NCDF) THEN nsurf=1 ngrp=ngrp+1 ENDIF ! in xs_helios_read.f90 l1015 READ(XS_set_unit,hfnF5) rvector(1:RIEGO ! in xs_heliosM.f90 l104 hfnF5='( X,8F13.5) ' IF(IT.EQ.NITTMP) THEN WRITE(IPHEL,'(5X,F7.5)') CDF(nsurf,ngrp,NB) ELSE WRITE(IPHEL,'(5X,F7.5)',advance='no') CDF(nsurf,ngrp,NB) ENDIF ENDDO ENDDO WRITE(IPHEL,*) ENDDO 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' END SUBROUTINE SETGFF( IPHEL, BRANCH, ITBRAN, GFF, NCOLA, NROWA, > NPART, NGP, NBU, BURN, NGFF , IPRINT, > VERS) * *----------------------------------------------------------------------- * *Purpose: * Write in the HELIOS.dra file the cross sections for a banch * (including all burnup points). * This routine write sequentially the HELIOS.dra file, branch after * branch. * *parameters: input * IPHEL file unit of the HELIOS.dra file * BRANCH nature of the current branch ( CR, DC, CB, TC, TM etc ) * ITBRAN index of the current branch * GFF Group form factor * NCOLA number of pin in assembly along x-axis * NROWA number of pin in assembly along y-axis * NPART symmetry level of assembly * 0 1 2 3 * whole half quarter eight * PARCS Version 32.17 and GenPMAXS 6.1 * 123XXXX 1...... 123X... 1...... * XXXXXXX 23..... XXXX... 23..... * XXXXXXX XXX.... XXXX... XXX.... * XXXXXXX XXXX... XXXn... XXXn... * XXXXXXX XXXXX.. ....... ....... * XXXXXXX XXXXXX. ....... ....... * XXXXXXn XXXXXXn ....... ....... * Note: Helios format is different from the documentation * provided in GenPMAXS. * Version 32.18 and GenPMAXS 6.2 * 123XXXX 1...... ....... ....... * XXXXXXX 23..... ....... ....... * XXXXXXX XXX.... ....... ....... * XXXXXXX XXXX... ...123X ...1... * XXXXXXX XXXXX.. ...XXXX ...23.. * XXXXXXX XXXXXX. ...XXXX ...XXX. * XXXXXXn XXXXXXn ...XXXn ...XXXn * Note: Helios format is the same as in the documentation * provided in GenPMAXS. * NGP number of energy groups * NBU number of burnup points * BURN set of burnup points * IPRINT control the printing on screen * VERS version of PARCS to be used * *----------------------------------------------------------------------- * *---- * SUBROUTINE ARGUMENTS *---- INTEGER IPHEL,NBU,NGP,ITBRAN,NIT,IPRINT,NGFF REAL GFF(NCOLA,NROWA,NGP,NBU),BURN (NBU),VERS CHARACTER BRANCH*4 *---- * LOCAL ARGUMENTS *---- INTEGER IT,ITA,ipxn,ipyn IF(IPRINT>5) WRITE(6,*) 'SETGFF: RECOVER GFF INFO' NIT = NGP*NCOLA*NROWA NPIN2 = NCOLA*NROWA NCOLA2= 1 ipxn=1 ipyn=1 IF((NPART.GE.1).AND.(NCOLA.NE.NROWA))THEN CALL XABORT('@D2PBRA: NPART > 0 and NCOLA.NE.NROWA') ENDIF IF(NPART.EQ.1)THEN NIT=NGP*NCOLA*(NCOLA+1)/2 NPIN2 = NCOLA*(NCOLA+1)/2 ELSEIF(NPART.EQ.2)THEN NCOLA2=CEILING(REAL(NCOLA)/2) NIT=NGP*NCOLA2*NCOLA2 NPIN2 = NCOLA2*NCOLA2 ELSEIF(NPART.EQ.3)THEN NCOLA2=CEILING(REAL(NCOLA)/2) NIT=NGP*NCOLA2*(NCOLA2+1)/2 NPIN2 = NCOLA2*(NCOLA2+1)/2 ENDIF IF((VERS.GE.3.2018).AND.(NPART.GE.2))THEN ipxn=CEILING(REAL(NCOLA)/2) ipyn=CEILING(REAL(NCOLA)/2) NCOLA2=NCOLA ENDIF IF (NGFF.NE.NPIN2) THEN WRITE (6,*) '@D2PBRA: INCOHERENT NUMBER OF GFF IN MCO (', > NGFF,') AND COMPUTED PART OF ASSEMBLY (PART =', > NPART,').' CALL XABORT ('') ENDIF ! LABEL FOR XS TYPE: GFF WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,*) 'List Title(s) 1) %XS_GFF %GFF 1 ' WRITE(IPHEL,*)'2) Meaning : (F-.-E-G-.) F-Face, G-Group' WRITE(IPHEL,*)'3) F=1 to NPIN*NPIN average GFF' CALL SET_RIEGO(IPHEL) ! LOOP OVER ENERGY GROUPS ! CREATION OF LABEL FOR CROSS SECTIONS ngrp=1 nsurf=0 ipx=ipxn-1 ipy=ipyn DO ITA=1,NIT,7 ! ITA NITTMP=MIN(NIT-ITA+1,7) ngrpb=ngrp nsurfb=nsurf ipxb=ipx ipyb=ipy DO IT=1,NITTMP IF((IT==1).AND.(IT.LT.NITTMP)) THEN WRITE(IPHEL,'(33X,A6)',advance='no') 'GNorRR' ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN WRITE(IPHEL,'(33X,A6)') 'GNorRR' ELSE IF(IT.EQ.NITTMP) THEN WRITE(IPHEL,'(8X,A6)')'GNorRR' ELSE WRITE(IPHEL,'(8X,A6)',advance='no')'GNorRR' ENDIF ENDDO DO IT=1,NITTMP nsurf=nsurf+1 IF(nsurf.GT.NPIN2) THEN nsurf=1 ngrp=ngrp+1 ENDIF IF((IT==1).AND.(IT.LT.NITTMP)) THEN WRITE(IPHEL,'(6X,A,12X,I3,A,I1,A)',advance='no') > 'Label E',nsurf,'-.-E-',ngrp,'-.' ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN WRITE(IPHEL,'(6X,A,12X,I3,A,I1,A)') > 'Label E',nsurf,'-.-E-',ngrp,'-.' ELSE IF(IT.EQ.NITTMP) THEN WRITE(IPHEL,'(1X,I3,A,I1,A)') nsurf,'-.-E-',ngrp,'-.' ELSE WRITE(IPHEL,'(1X,I3,A,I1,A)',advance='no') > nsurf,'-.-E-',ngrp,'-.' ENDIF ENDDO ! STORE XS DATA IN HELIOS.DRA FILE ! LOOP OVER BURNUP POINTS DO NB=1,NBU ngrp=ngrpb nsurf=nsurfb ipx=ipxb ipy=ipyb WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) DO IT=1,NITTMP ipx=ipx+1 IF(((NPART.EQ.0).AND.(ipx.GT.NCOLA)).OR. > ((NPART.EQ.2).AND.(ipx.GT.NCOLA2)).OR. > (((NPART.EQ.1).OR.(NPART.EQ.3)).AND.(ipx.GT.ipy)))THEN ipx=ipxn ipy=ipy+1 ENDIF nsurf=nsurf+1 IF(nsurf.GT.NPIN2) THEN nsurf=1 ngrp=ngrp+1 ipy=ipxn ipx=ipyn ENDIF ! in xs_helios_read.f90 l1015 READ(XS_set_unit,hfnE4) rvector(1:RIEGO ! in xs_heliosM.f90 l104 hfnF5='( X,8F13.5) ' ! l114 hfnE4=hfnE5 ! l115 hfnE4(11:11)='4' IF(IT.EQ.NITTMP) THEN WRITE(IPHEL,'(5X,F7.4)') GFF(ipx,ipy,ngrp,NB) ELSE WRITE(IPHEL,'(5X,F7.4)',advance='no') GFF(ipx,ipy,ngrp,NB) ENDIF ENDDO ENDDO WRITE(IPHEL,*) ENDDO 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' END SUBROUTINE SETSCT(IPHEL,BRANCH,ITBRAN,SCAT,NGP,NBU,BURN,IPRINT) * *----------------------------------------------------------------------- * *Purpose: * Write in the HELIOS.dra file the scattering cross sections for a banch * (including all burnup points). * This routine write sequentially the HELIOS.dra file, branch after * branch. * *parameters: input * IPHEL file unit of the HELIOS.dra file * BRANCH nature of the current branch ( CR, DC, CB, TC, TM etc ) * ITBRAN index of the current branch * SCAT table of elements of scattering matrix * NGP number of energy groups * NBU number of burnup points * BURN set of burnup points * *----------------------------------------------------------------------- * *---- * SUBROUTINE ARGUMENTS *---- INTEGER IPHEL,NBU,NGP,ITBRAN,IPRINT REAL SCAT(NGP*NGP,NBU),BURN (NBU) CHARACTER BRANCH*2 *---- * LOCAL ARGUMENTS *---- INTEGER IT,G,I REAL SCATTMP(8,NBU) CHARACTER*45 LABEL CHARACTER*45 LABELE CHARACTER*210 :: TOTLABELE = '' CHARACTER*210 :: TOTLABEL = '' IF(IPRINT>5) WRITE(6,*) 'SETSCT: WRITE SCATTERING INFO' ! LABEL FOR SCATTERING XS WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,110) '%SCT' WRITE(IPHEL,*)'Meaning : (.-.-E-G-O) From O to G-th Group scat' CALL SET_RIEGO(IPHEL) IT=1 ITT=1 I=0 ! CREATION OF HEADER FOR SCATTERING BLOCK IN HELIOS.DRA FILE DO G=1,NGP DO J=1, NGP IF (IT==1) THEN TOTLABELE = '' TOTLABEL = '' WRITE(LABELE,'(6X,A7,14X)') 'Label E' TOTLABELE=TOTLABELE(1:len( trim(TOTLABELE) )) 1 // LABELE ENDIF IF (IT==1) THEN WRITE(LABEL,'(25X,A)')'ScattMatrix' WRITE(LABELE,'(12X,A,I1,A,I1)') 1 '1-.-E-',G,'-',J ELSE WRITE(LABEL,'(1X,A)')'ScattMatrix' WRITE(LABELE,'(3X,A,I1,A,I1)') 1 '1-.-E-',G,'-',J ENDIF SCATTMP(IT,:)=SCAT(ITT,:) TOTLABEL=TOTLABEL(1:len( trim(TOTLABEL) )) > //LABEL TOTLABELE=TOTLABELE(1:len( trim(TOTLABELE) )) > //LABELE IF ((IT==8).OR.(ITT==NGP*NGP)) THEN WRITE(IPHEL,'(A)') TOTLABEL WRITE(IPHEL,'(A)') TOTLABELE DO NB=1, NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(8(ES12.5E2))')SCATTMP(1:IT,NB) ENDDO WRITE (IPHEL,*) TOTLABELE = '' TOTLABEL = '' IT=1 ELSE IT=IT+1 ENDIF ITT=ITT+1 ENDDO ENDDO ! DO JT=1, NGP ! IF(IT==1 .and. JT==1) THEN ! WRITE(IPHEL,'(28X,A)',advance='no') 'ScattMatrix' ! ELSE IF((IT==(NGP).and.JT==(NGP)) .OR. JT==7 ) THEN ! WRITE(IPHEL,'(3X,A)')'ScattMatrix' ! ELSE ! WRITE(IPHEL,'(3X,A)',advance='no')'ScattMatrix' ! ENDIF ! ENDDO ! DO IT=1, NGP ! DO JT=1, NGP ! IF(IT==1 .and. JT==1) THEN ! WRITE(IPHEL,'(6X,A,14X,A,I1,A,I1)',advance='no') ! 1 'Label E','1-.-E-',JT,'-',IT ! ELSE IF((IT==(NGP).and.JT==(NGP)) .OR. JT==8 ) THEN ! WRITE(IPHEL,'(5X,A,I1,A,I1)') ! 1 '1-.-E-',JT,'-',IT ! ELSE ! WRITE(IPHEL,'(5X,A,I1,A,I1)',advance='no') ! 1 '1-.-E-',JT,'-',IT ! ENDIF ! ENDDO ! ENDDO ! ! DO NB=1, NBU ! WRITE(IPHEL,220,advance='no') NB,'t',BRANCH(1:2), ! 1 ITBRAN,'(s',BRANCH(1:2),ITBRAN,'):',NINT(BURN(NB)) ! DO IG=1, NGP*NGP ! IF(IG == 1) THEN ! WRITE(IPHEL,'(3X,ES11.5E2)',advance='no') SCAT(IG,NB) ! ELSE IF(IG.EQ.NGP*NGP) THEN ! WRITE(IPHEL,'(3X,ES11.5E2)') SCAT(IG,NB) ! ELSE IF(IG.EQ.8 ) THEN ! WRITE(IPHEL,'(3X,ES11.5E2)') SCAT(IG,NB) ! ELSE ! WRITE(IPHEL,'(3X,ES11.5E2)',advance='no') SCAT(IG,NB) ! ENDIF ! ENDDO ! ENDDO 110 FORMAT(28H List Title(s) 1) %XS_SCT ,A) 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' END SUBROUTINE SETND(IPHEL,BRANCH,ITBRAN,ND,NBU,BURN,IPRINT) * *----------------------------------------------------------------------- * *Purpose: * Write in the HELIOS.dra file the scattering cross sections for a banch * (including all burnup points). * This routine write sequentially the HELIOS.dra file, branch after * branch. * *parameters: input * IPHEL file unit of the HELIOS.dra file * BRANCH nature of the current branch ( CR, DC, CB, TC, TM etc ) * ITBRAN index of the current branch * NGP number of energy groups * NBU number of burnup points * ND number densities for Xenon and samarium : KEFF , KINF, B2 * BURN set of burnup points * *----------------------------------------------------------------------- * *---- * SUBROUTINE ARGUMENTS *---- INTEGER IPHEL,NBU,ITBRAN,IPRINT REAL ND(2,NBU),BURN (NBU) CHARACTER BRANCH*2 *---- * LOCAL ARGUMENTS *---- INTEGER NB IF(IPRINT>5) WRITE(6,*) 'SETND: WRITE HEADER FOR XENON DENSITY' ! CREATION OF HEADER FOR XENON DENSITY WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,*) 'List Title(s) 1) %XS_XESM %XEND' WRITE(IPHEL,*)'Meaning : Xe-135 Number Density [/cm.barn]' CALL SET_RIEGO(IPHEL) WRITE(IPHEL,'(31X,A)') 'nXe' WRITE(IPHEL,'(6X,A,12X,A)') 'Label E','1-1-E-.-.' ! LOOP OVER BUNRNUP DO NB=1,NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(ES12.5E2)') ND(1,NB) ENDDO WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' ! CREATION OF HEADER FOR SAMARIUM DENSITY WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,*) 'List Title(s) 1) %XS_XESM %SMND' WRITE(IPHEL,*)'Meaning : SM-149 Number Density [/cm.barn]' CALL SET_RIEGO(IPHEL) WRITE(IPHEL,'(27X,A)') 'nSm' WRITE(IPHEL,'(6X,A,12X,A)') 'Label E','1-1-E-.-.' ! LOOP OVER BUNRNUP DO NB=1,NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(ES12.5E2)') ND(2,NB) ENDDO WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) END SUBROUTINE SETDIV(IPHEL,BRANCH,ITBRAN,DIV,NBU,BURN,IPRINT) * *----------------------------------------------------------------------- * *Purpose: * Write in the HELIOS.dra file the scattering cross sections for a banch * (including all burnup points). * This routine write sequentially the HELIOS.dra file, branch after * branch. * *parameters: input * IPHEL file unit of the HELIOS.dra file * BRANCH nature of the current branch ( CR, DC, CB, TC, TM etc ) * ITBRAN index of the current branch * NGP number of energy groups * NBU number of burnup points * DIV conttnent of DIV table : KEFF , KINF, B2 * BURN set of burnup points * *----------------------------------------------------------------------- * *---- * SUBROUTINE ARGUMENTS *---- INTEGER IPHEL,NBU,ITBRAN,IPRINT REAL DIV(3,NBU),BURN (NBU) CHARACTER BRANCH*2 *---- * LOCAL ARGUMENTS *---- INTEGER NB REAL M2 IF(IPRINT>5) WRITE(6,*) 'SETDIV: WRITE HEADER FOR DIVERS INFO' ! CREATION OF HEADER FOR DIVERS INFO (B2, KEFF, KINF) WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : KINF' WRITE(IPHEL,*) 'List Title(s) 1) %XS_PRIN %KINF' WRITE(IPHEL,*)' Meaning : K-eff, K-inf, M^2, B^2 [cm^-2] ' CALL SET_RIEGO(IPHEL) WRITE(IPHEL,'(27X,A,10X,A,6X,A,6X,A)') 'K-EFF','KINF', 1 'MigrArea','CritArea' WRITE(IPHEL,'(6X,A,12X,A,5X,A,5X,A,5X,A)') 1 'Label E','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.' ! LOOP OVER BURNUP POINTS DO NB=1,NBU M2=(DIV(2,NB)-1)/(DIV(3,NB)) WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(5X,F7.5,5X,F7.5,ES12.5E2,ES12.5E2)') 1 DIV(1,NB),DIV(2,NB),M2,DIV(3,NB) ENDDO WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) END SUBROUTINE SETTH( IPHEL, BRANCH, ITBRAN, BURN, NBU, JOBOPT, > NGP, IPDAT, IPRINT ) * *----------------------------------------------------------------------- * *Purpose: * Write in the HELIOS.dra file the invaraint TH DATA for a banch * (including all burnup points). * This routine write sequentially the HELIOS.dra file, branch after * branch. * *----------------------------------------------------------------------- * USE GANLIB TYPE(C_PTR) IPDAT,IPTH,KPTH INTEGER :: DIM_LAMBDA = 6 INTEGER NGP,ILONG INTEGER ITYLCM,NBU,ITBRAN CHARACTER (len=4) BRANCH,DLAY CHARACTER JOBOPT(16) INTEGER :: BU = 1 REAL BURN(NBU) REAL YLDXe(NBU),YLDPm(NBU),YLDI(NBU) REAL OVERV(NGP,NBU),CHI(NGP,NBU),LAMBDA(6,NBU),BETA(6,NBU) LOGICAL :: LAMB = .FALSE. LOGICAL :: LCHI = .FALSE. LOGICAL :: LYLD = .FALSE. LOGICAL :: LINV = .FALSE. LOGICAL :: LBET = .FALSE. IF(IPRINT>5) WRITE(6,*) 'SETTH: WRITE TH DATA' ! RECOVER FLAG INFORMATION IF(JOBOPT(5)=='T') LCHI = .TRUE. IF(JOBOPT(7)=='T') LINV = .TRUE. IF(JOBOPT(9)=='T') LYLD = .TRUE. IF(JOBOPT(13)=='T') LAMB = .TRUE. IF(JOBOPT(12)=='T') LBET = .TRUE. IF(NGP>2)THEN CALL XABORT('@D2P: NGP > 2 NOT IMPLEMENTED FOR T/H BLOCK') ENDIF CALL LCMSIX(IPDAT,' ',0) IPTH=LCMGID(IPDAT,'TH_DATA') DO BU=1,NBU KPTH=LCMDIL(IPTH,BU) IF(LCHI) THEN IF(BU ==1) THEN CALL LCMLEN(KPTH,'CHI',ILONG,ITYLCM) IF (ILONG .NE. NGP) THEN CALL XABORT (' MORE THAN 2 (NGP) VALUES FOR CHI RECORD') ENDIF ENDIF CALL LCMGET(KPTH,'CHI',CHI(1:NGP,BU)) ENDIF IF(LINV) THEN CALL LCMGET(KPTH,'OVERV',OVERV(1:NGP,BU)) ENDIF IF(LYLD) THEN CALL LCMGET(KPTH,'YLDPm',YLDPm(BU)) CALL LCMGET(KPTH,'YLDXe',YLDXe(BU)) CALL LCMGET(KPTH,'YLDI',YLDI(BU)) ENDIF IF(LAMB)THEN IF(BU == 1) THEN CALL LCMLEN(KPTH,'LAMBDA',ILONG,ITYLCM) IF (ILONG .NE. DIM_LAMBDA) THEN CALL XABORT('MORE THAN 6 (NDLAY) VALUES FOR LAMBDA RECORD') ENDIF ENDIF CALL LCMGET(KPTH,'LAMBDA',LAMBDA(1:DIM_LAMBDA,BU)) ENDIF IF(LBET)THEN IF(BU == 1) THEN CALL LCMLEN(KPTH,'BETA',ILONG,ITYLCM) IF (ILONG .NE. DIM_LAMBDA) THEN CALL XABORT('MORE THAN 6 (NDLAY) VALUES FOR BETA RECORD') ENDIF ENDIF CALL LCMGET(KPTH,'BETA',BETA(1:DIM_LAMBDA,BU)) ENDIF ENDDO IF(LCHI) CALL SET_CHI(IPHEL,BRANCH,ITBRAN,BURN,CHI,NGP,NBU) IF(LINV) CALL SET_OVERV(IPHEL,BRANCH,ITBRAN,BURN,OVERV,NGP,NBU) IF(LYLD) CALL SET_YIELD(IPHEL,BRANCH,ITBRAN,BURN,YLDPm,YLDXe, > YLDI,NBU) IF(LAMB) THEN DLAY='LAMB' CALL SET_DLAY(IPHEL,BRANCH,ITBRAN,BURN,LAMBDA,DIM_LAMBDA,DLAY, > NBU) ENDIF IF(LBET) THEN DLAY='BETA' CALL SET_DLAY(IPHEL,BRANCH,ITBRAN,BURN,BETA,DIM_LAMBDA,DLAY,NBU) ENDIF END SUBROUTINE SET_CHI(IPHEL,BRANCH,ITBRAN,BURN,CHI,DIM_CHI,NBU) INTEGER DIM_CHI,NBU,ITBRAN,NB REAL CHI(DIM_CHI,NBU),BURN(NBU) CHARACTER (len=4) BRANCH WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,*) 'List Title(s) 1) %XS_PRIN %CHI' WRITE(IPHEL,*) 'Meaning :(.-.-E-G-.) G-th Group Fission Spect' CALL SET_RIEGO(IPHEL) WRITE(IPHEL,'(31X,A3,11X,A3)') 'chi','chi' WRITE(IPHEL,'(6X,A,12X,A,5X,A)') 'Label E','1-.-E-1-.','1-.-E-2-.' ! LOOP OVER burnup points DO NB=1,NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(ES12.5E2,ES12.5E2)') 1 CHI(1:DIM_CHI,NB) ENDDO WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) END SUBROUTINE SET_OVERV(IPHEL,BRANCH,ITBRAN,BURN,OVERV,NG,NBU) INTEGER NG,NBU,ITBRAN,NB REAL OVERV(NG,NBU),BURN(NBU) CHARACTER (len=4) BRANCH WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,*) 'List Title(s) 1) %XS_PRIN %VEL' WRITE(IPHEL,*) 'Meaning :' WRITE(IPHEL,*) '(.-.-E-G-.) G-th Group Neutron Velocity [m/s]' CALL SET_RIEGO(IPHEL) WRITE(IPHEL,'(31X,A3,11X,A3)') 'vel','vel' WRITE(IPHEL,'(6X,A,12X,A,5X,A)') 'Label E','.-.-E-1-.','.-.-E-2-.' ! LOOP OVER burnup points DO NB=1,NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(ES12.5E2,ES12.5E2)') 1 (1/(OVERV(1:NG,NB))) ENDDO WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) END SUBROUTINE SET_YIELD(IPHEL,BRANCH,ITBRAN,BURN,YLDPm,YLDXe,YLDI, 1 NBU) INTEGER NBU,ITBRAN,NB,I,iXe,iPm,iI REAL YLDPm(NBU), YLDXe(NBU),YLDI(NBU),BURN(NBU) REAL YLD(NBU) CHARACTER (len=4) BRANCH CHARACTER (len=5) YIELD CHARACTER (len=6) MEANING CHARACTER (len=10 ) LABEL DO I=1, 3 SELECT CASE (I) CASE(1) YIELD='YLDXE' MEANING='Xe-135' LABEL='YieldXe135' DO iXe=1,NBU YLD(iXe)=YLDXe(iXe) ENDDO CASE(2) YIELD='YLDID' MEANING=' I-135' LABEL=' YieldI135' DO iI=1,NBU YLD(iI)=YLDI(iI) ENDDO CASE(3) YIELD='YLDPM' MEANING='Pr-149' LABEL='YieldPm149' DO iPm=1,NBU YLD(iPm)=YLDPm(iPm) ENDDO END SELECT WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' WRITE(IPHEL,*) 'List Title(s) 1) %XS_XESM %',YIELD WRITE(IPHEL,*) 'Meaning : Effective ,',MEANING,' Yield' CALL SET_RIEGO(IPHEL) WRITE(IPHEL,'(29X,A10)') LABEL WRITE(IPHEL,'(6X,A,12X,A)') 'Label E','1-.-E-1-.' ! LOOP OVER burnup points DO NB=1,NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(ES12.5E2)') YLD(NB) ENDDO WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) ENDDO END SUBROUTINE SET_DLAY(IPHEL,BRANCH,ITBRAN,BURN,VECT,DIM_LAMBDA, 1 DLAY,NBU) INTEGER DIM_LAMBDA,NBU,ITBRAN,NB REAL VECT(DIM_LAMBDA,NBU),BURN(NBU) CHARACTER (len=4) BRANCH,DLAY CHARACTER (len=6) LABEL IF(DLAY.EQ.'LAMB') THEN LABEL="lambda" ELSE LABEL="beta " ENDIF IF(DIM_LAMBDA.GT.8) THEN WRITE (6,*) "@D2PBRA: NB OF DELAY NEUTRON GROUPS:",DIM_LAMBDA CALL XABORT("MAX EIGHT DELAY NEUTRON GROUPS ARE ALLOWED") ENDIF WRITE(IPHEL,'()') WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA' WRITE(IPHEL,*) 'Labels Array : PrintVector' IF(LABEL=="lambda")THEN WRITE(IPHEL,*) 'List Title(s) 1) %XS_BETA %DCAYB 1' WRITE(IPHEL,*) 'Meaning : Decay Cst of the Delayed Neutron /s' ELSE WRITE(IPHEL,*) 'List Title(s) 1) %XS_BETA %BETA 1 ' WRITE(IPHEL,*) 'Meaning : Delayed Neutron Fraction' ENDIF WRITE(IPHEL,*) ' (.-.-E-G-.) From 0 To 6-th Group' CALL SET_RIEGO(IPHEL) IF(DIM_LAMBDA.EQ.6) THEN WRITE(IPHEL,'(31X,A6,6X,A6,6X,A6,6X,A6,6X,A6,6X,A6)') > LABEL,LABEL,LABEL,LABEL,LABEL,LABEL WRITE(IPHEL,200) > 'Label E','.-.-E-1-.','.-.-E-2-.','.-.-E-3-.','.-.-E-4-.', > '.-.-E-5-.','.-.-E-6-.' ! LOOP OVER burnup points DO NB=1,NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(ES12.5E2,5(ES12.5E2))') > VECT(1:DIM_LAMBDA,NB) ENDDO ELSE IF(DIM_LAMBDA.EQ.8) THEN WRITE(IPHEL,'(26X,A6,6X,A6,6X,A6,6X,A6,6X,A6,6X,A6,6X,A6)') > LABEL,LABEL,LABEL,LABEL,LABEL,LABEL,LABEL WRITE(IPHEL,210) > 'Label E','.-.-E-1-.','.-.-E-2-.','.-.-E-3-.','.-.-E-4-.', > '.-.-E-5-.','.-.-E-6-.','.-.-E-7-.' ! LOOP OVER burnup points DO NB=1,NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(ES12.5E2,6(ES12.5E2))') VECT(1:7,NB) ENDDO WRITE(IPHEL,*) WRITE(IPHEL,'(26X,A6)') 'lambda' WRITE(IPHEL,'(6X,A,12X,A)') 'Label E',LABEL DO NB=1, NBU WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2), 1 ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB)) WRITE(IPHEL,'(ES12.5E2)') VECT(DIM_LAMBDA,NB) ENDDO ENDIF WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>' 200 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A,3X,A,3X,A) 210 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A,3X,A,3X,A,3X,A) 220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5) END