*DECK FLU SUBROUTINE FLU(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) * *----------------------------------------------------------------------- * *Purpose: * Multigroup flux solution in a lattice. * *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/output * NENTRY number of LCM objects or files used by the operator. * HENTRY name of each LCM object or file. * HENTRY(1) create or modification type(L_FLUX). * HENTRY(I) for I>1: * read-only type(L_MACROLIB or L_LIBRARY); * read-only type(L_TRACK); * read-only sequential binary tracking file; * read-only type(L_PIJ); * optional read-only type(L_FLUX) for unperturbed solution; * optional read-only type(L_SOURCE) for fixed sources. * IENTRY type of each LCM object or file: * =1 LCM memory object; =2 XSM file; =3 sequential binary file; * =4 sequential ascii file. * JENTRY access of each LCM object or file: * =0 the LCM object or file is created; * =1 the LCM object or file is open for modifications; * =2 the LCM object or file is open in read-only mode. * KENTRY LCM object address or file unit number. * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY) TYPE(C_PTR) KENTRY(NENTRY) CHARACTER HENTRY(NENTRY)*12 *---- * LOCAL VARIABLES *---- PARAMETER(IOUT=6,NSTATE=40,NLEAK=7,NSDIR=6) TYPE(C_PTR) IPFLUX,IPTRK,IPMACR,IPSYS,IPFLUP,IPSOU CHARACTER TEXT12*12,TITLE*72,CMODUL*12,HSIGN*12,COPTIO*4, 1 CXDOOR*12,TYPE10*10,HISO10*10,CREBAL*3,CHLEAK*3,HTYPE(0:5)*8, 2 CLEAK(NLEAK)*6,CSDIR(NSDIR)*1,HPTRK*12,HPMACR*12,HPSYS*12, 3 HPFLUP*12,HPGPT*12,HSMG*131,REDUC(4)*3 LOGICAL LTABLE,REC,LEAKSW,LFORW DOUBLE PRECISION REFKEF INTEGER ISTATE(NSTATE) REAL B2(4) *---- * ALLOCATABLE ARRAYS *---- INTEGER, ALLOCATABLE, DIMENSION(:) :: MATCOD,KEYFLX,IMERG REAL, ALLOCATABLE, DIMENSION(:) :: VOL *---- * DATA STATEMENTS *---- SAVE HTYPE,CLEAK,CSDIR DATA (HTYPE(JJ),JJ=0,5)/' SOURCE',' GPT',' K-INF', > ' K-EFF','BUCKLING',' LEAKAGE'/ DATA (CLEAK(JJ),JJ=1,NLEAK) > /'PNLR',' PNL','SIGS','ALBS','HETE','ECCO','TIBERE'/ DATA (CSDIR(III),III=1,NSDIR) > /'-','X','Y','Z','R','G'/ DATA (REDUC(JJ),JJ=1,4) > /'ON ','OFF','ON ','OFF'/ *---- * BICKLEY FLAG *---- SAVE IBICKL DATA IBICKL/0/ *---- * PARAMETER VALIDATION. *---- IF(NENTRY.LE.1) CALL XABORT('FLU: TWO PARAMETERS EXPECTED.') IPFLUX=KENTRY(1) REC=(JENTRY(1).EQ.1) IF(REC) THEN CALL LCMGTC(IPFLUX,'SIGNATURE',12,HSIGN) IF(HSIGN.NE.'L_FLUX') THEN TEXT12=HENTRY(1) CALL XABORT('FLU: SIGNATURE OF '//TEXT12//' IS '//HSIGN// 1 '. L_FLUX EXPECTED.') ENDIF ELSE HSIGN='L_FLUX' CALL LCMPTC(IPFLUX,'SIGNATURE',12,HSIGN) ENDIF IFTRAK=0 IPMACR=C_NULL_PTR IPTRK=C_NULL_PTR IPSYS=C_NULL_PTR IPSOU=C_NULL_PTR IPFLUP=C_NULL_PTR HPTRK=' ' HPMACR=' ' HPSYS=' ' DO 10 I1=2,NENTRY LTABLE=(IENTRY(I1).EQ.1).OR.(IENTRY(I1).EQ.2) IF((IENTRY(I1).EQ.3).AND.(JENTRY(I1).EQ.2)) THEN IFTRAK=FILUNIT(KENTRY(I1)) ELSE IF(LTABLE.AND.(JENTRY(I1).EQ.2)) THEN CALL LCMGTC(KENTRY(I1),'SIGNATURE',12,HSIGN) IF((HSIGN.EQ.'L_TRACK').AND.(.NOT.C_ASSOCIATED(IPTRK))) THEN IPTRK=KENTRY(I1) HPTRK=HENTRY(I1) ELSE IF((HSIGN.EQ.'L_MACROLIB').AND.(.NOT.C_ASSOCIATED(IPMACR))) 1 THEN IPMACR=KENTRY(I1) HPMACR=HENTRY(I1) ELSE IF((HSIGN.EQ.'L_LIBRARY').AND.(.NOT.C_ASSOCIATED(IPMACR))) 1 THEN CALL LCMLEN(KENTRY(I1),'MACROLIB',ILONG,ITYLCM) IF(ILONG.NE.0) THEN IPMACR=KENTRY(I1) HPMACR=HENTRY(I1) CALL LCMSIX(IPMACR,'MACROLIB',1) ENDIF ELSE IF((HSIGN.EQ.'L_PIJ').AND.(.NOT.C_ASSOCIATED(IPSYS))) THEN IPSYS=KENTRY(I1) HPSYS=HENTRY(I1) ELSE IF((HSIGN.EQ.'L_FLUX').AND.(.NOT.C_ASSOCIATED(IPFLUP))) 1 THEN IPFLUP=KENTRY(I1) HPFLUP=HENTRY(I1) ELSE IF((HSIGN.EQ.'L_SOURCE').AND.(.NOT.C_ASSOCIATED(IPSOU))) 1 THEN IPSOU=KENTRY(I1) HPGPT=HENTRY(I1) ELSE WRITE(HSMG,'(20HFLU: UNKNOWN OBJECT ,A,14H OF SIGNATURE ,A, 1 5H (1).)') TRIM(HENTRY(I1)),TRIM(HSIGN) CALL XABORT(HSMG) ENDIF ELSE WRITE(HSMG,'(20HFLU: UNKNOWN OBJECT ,A,1H.)') TRIM(HENTRY(I1)) CALL XABORT(HSMG) ENDIF 10 CONTINUE IF(.NOT.C_ASSOCIATED(IPTRK)) THEN CALL XABORT('FLU: NO TRACKING OBJECT AT RHS.') ELSE IF(.NOT.C_ASSOCIATED(IPMACR)) THEN CALL XABORT('FLU: NO MACROLIB OBJECT AT RHS.') ELSE IF(.NOT.C_ASSOCIATED(IPSYS)) THEN CALL XABORT('FLU: NO SYSTEM OBJECT AT RHS.') ENDIF *---- * RECOVER GENERAL TRACKING INFORMATION. *---- ISTATE(:NSTATE)=0 CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE) NREG= ISTATE(1) NUN= ISTATE(2) LEAKSW= ISTATE(3).EQ.0 IGP4= ISTATE(4) NSOUT= ISTATE(5) *---- * RECOVER MACROLIB PARAMETERS. *---- CALL LCMPTC(IPFLUX,'LINK.MACRO',12,HPMACR) ISTATE(:NSTATE)=0 CALL LCMGET(IPMACR,'STATE-VECTOR',ISTATE) NGRP= ISTATE(1) NMAT= ISTATE(2) NANIS= ISTATE(3)-1 NIFIS= ISTATE(4) ITRANC= ISTATE(6) LFORW = (ISTATE(13).EQ.0) IF(IGP4.GT.NMAT) THEN WRITE(HSMG,'(45HFLU: THE NUMBER OF MIXTURES IN THE TRACKING (, 1 I5,55H) IS GREATER THAN THE NUMBER OF MIXTURES IN THE MACROLI, 2 3HB (,I5,2H).)') IGP4,NMAT CALL XABORT(HSMG) ENDIF *---- * RECOVER INFORMATION FROM L_PIJ OBJECT. *---- ITPIJ=2 IPHASE=1 IF(C_ASSOCIATED(IPSYS)) THEN CALL LCMGTC(IPSYS,'LINK.MACRO',12,TEXT12) IF(HPMACR.NE.TEXT12) THEN WRITE(HSMG,'(37H FLU: INVALID MACROLIB OBJECT NAME ='',A12, 1 18H'', EXPECTED NAME='',A12,2H''.)') HPMACR,TEXT12 CALL XABORT(HSMG) ENDIF CALL LCMGTC(IPSYS,'LINK.TRACK',12,TEXT12) IF(HPTRK.NE.TEXT12) THEN WRITE(HSMG,'(37H FLU: INVALID TRACKING OBJECT NAME ='',A12, 1 18H'', EXPECTED NAME='',A12,2H''.)') HPTRK,TEXT12 CALL XABORT(HSMG) ENDIF CALL LCMPTC(IPFLUX,'LINK.TRACK',12,HPTRK) CALL LCMPTC(IPFLUX,'LINK.SYSTEM',12,HPSYS) CALL LCMGET(IPSYS,'STATE-VECTOR',ISTATE) ITPIJ=ISTATE(1) IPHASE=ISTATE(5) IF(ISTATE(8).NE.NGRP) CALL XABORT('FLU: INVALID NUMBER OF ENE' 1 //'RGY GROUPS.') IF(ISTATE(10).GT.NMAT) CALL XABORT('FLU: INVALID NUMBER OF MI' 1 //'XTURES.') IF(LEAKSW) THEN IF((ISTATE(2).EQ.0).OR.(ISTATE(3).EQ.0)) LEAKSW=.FALSE. ENDIF ELSE CALL LCMPTC(IPFLUX,'LINK.TRACK',12,HPTRK) ENDIF *---- * INITIALISE/READ ITERATIONS PARAMETERS *---- IF(NREG.EQ.0) CALL XABORT('FLU: NREG = 0') ALLOCATE(IMERG(NMAT)) CALL FLUGPI(IPFLUX,IPMACR,ITYPEC,MAXOUT,MAXINR,EPSOUT,EPSUNK, 1 EPSINR,IREBAL,IFRITR,IACITR,COPTIO,ILEAK,B2,NGRP,NREG,NMAT, 2 NIFIS,LEAKSW,REFKEF,ITPIJ,IPRINT,REC,INITFL,NMERG,IMERG) IF(IPHASE.EQ.2) THEN IF((ILEAK.GE.7).AND.(ITPIJ.LT.3)) CALL XABORT('FLU: HETEROGE'// > 'NEOUS BUCKLING CALCULATIONS REQUIRE PIJK EVALUATION IN ASM:') ENDIF *---- * RECOVER TRACKING FILE INFORMATION. *---- CALL LCMGTC(IPTRK,'TRACK-TYPE',12,CMODUL) CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE) IF(IPHASE.EQ.1) THEN CXDOOR=CMODUL ELSE CXDOOR='TRAFIC' IF(.NOT.C_ASSOCIATED(IPSYS)) CALL XABORT('FLU: NO PIJ OBJECT A' 1 //'T RHS.') ENDIF IF(CXDOOR.EQ.'MCCG') THEN NLF=ISTATE(6) NANI=ISTATE(6) ELSE IF(CXDOOR.EQ.'BIVAC') THEN NLF=MAX(1,ISTATE(14)) NANI=MAX(1,ISTATE(16)) ELSE IF(CXDOOR.EQ.'TRIVAC') THEN NLF=MAX(1,ISTATE(30)) NANI=MAX(1,ISTATE(32)) ELSE IF(CXDOOR.EQ.'SN') THEN NLF=ISTATE(15) NANI=MAX(1,ISTATE(16)) ELSE NLF=1 NANI=1 ENDIF IF(ITYPEC.EQ.1) THEN IF(.NOT.C_ASSOCIATED(IPFLUP)) CALL XABORT('FLU: NO UNPERTURBED' 1 //'FLUX OBJECT AT RHS.') CALL LCMGTC(IPFLUP,'TRACK-TYPE',12,TEXT12) IF(TEXT12.NE.CMODUL) THEN WRITE(HSMG,'(44HFLU: INCONSISTENT UNPERTURBED FLUX TRACK-TYP, 1 10HE AT RHS (,A,3H). ,A,10H EXPECTED.)') TRIM(TEXT12), 2 TRIM(CMODUL) CALL XABORT(HSMG) ENDIF IF(.NOT.C_ASSOCIATED(IPSOU)) CALL XABORT('FLU: NO SOURCE OBJEC' 1 //'T AT RHS.') CALL LCMGTC(IPSOU,'TRACK-TYPE',12,TEXT12) IF(TEXT12.NE.CMODUL) THEN WRITE(HSMG,'(44HFLU: INCONSISTENT SOURCE OBJECT TRACK-TYPE A, 1 7HT RHS (,A,3H). ,A,10H EXPECTED.)') TRIM(TEXT12),TRIM(CMODUL) CALL XABORT(HSMG) ENDIF ENDIF IF(REC) THEN CALL LCMGTC(IPFLUX,'TRACK-TYPE',12,TEXT12) IF(TEXT12.NE.CMODUL) THEN WRITE(HSMG,'(44HFLU: INCONSISTENT FLUX OBJECT TRACK-TYPE AT , 1 5HRHS (,A,3H). ,A,10H EXPECTED.)') TRIM(TEXT12),TRIM(CMODUL) CALL XABORT(HSMG) ENDIF ENDIF CALL LCMPTC(IPFLUX,'TRACK-TYPE',12,CMODUL) *---- * CHECK FOR THE ANISOTROPY SETTINGS COHERENCE *---- IF((ITRANC.NE.0).AND.(NANI.GT.1)) THEN WRITE(IOUT,6400) CXDOOR,NANI ITRANC=0 ENDIF *---- * RECOVER TABULATED FUNCTIONS FOR THE METHOD OF CHARACTERISTICS. *---- IF((CXDOOR.EQ.'MCCG').AND.(IBICKL.EQ.0)) THEN CALL XDRTA2 IBICKL=1 ENDIF *---- * THE NUMBER OF UNKNOWNS OF A CURRENT-BASED MULTICELL ITERATION IS * INCREASED TO HOLD INTERFACE CURRENT COMPONENTS. *---- IF(IPHASE.EQ.1) THEN IF(CXDOOR.EQ.'SYBIL') NUN=NUN+ISTATE(9) IF((CXDOOR.EQ.'EXCELL').AND.(ISTATE(7).EQ.5)) NUN=NUN+ISTATE(28) ENDIF *---- * THE NUMBER OF UNKNOWNS IS MULTIPLIED BY 2 WITH THE ECCO-TYPE * ISOTROPIC STREAMING MODEL AND BY 4 FOR PIJ AND 8 FOR MOC WITH THE * TIBERE ANISOTROPIC STREAMING MODEL. THE EXTRA-LOCATIONS ARE USED TO * STORE THE HETEROGENEOUS FUNDAMENTAL CURRENT VALUES. *---- IF(ILEAK.EQ.6) NUN=NUN*2 IF(ILEAK.GE.7) THEN IF (CXDOOR.EQ.'MCCG')THEN NUN=NUN*8 ELSE NUN=NUN*4 ENDIF ENDIF *---- * PRINT REQUIRED INFORMATION *---- IF(IPRINT.GE.1) THEN IF(LFORW) THEN TYPE10=' DIRECT' ELSE TYPE10=' ADJOINT' ENDIF IF(NLF.EQ.1 ) THEN HISO10=' ISOTROPIC' ELSE HISO10=' ANISOTROP' ENDIF WRITE(IOUT,6010) HTYPE(ITYPEC),TYPE10,HISO10 IF(ITYPEC.EQ.3) THEN WRITE(IOUT,6011) COPTIO,CLEAK(MOD(ILEAK,10)),' IMPOSED' IF(ILEAK.LT.7) THEN WRITE(IOUT,6012) B2(4) ELSE WRITE(IOUT,6013) B2(1),B2(2),B2(3) ENDIF ELSE IF(ITYPEC.GT.3) THEN IF(ILEAK.LT.7) THEN WRITE(IOUT,6011) COPTIO,CLEAK(ILEAK),'G SEARCH' WRITE(IOUT,6012) B2(4) ELSE WRITE(IOUT,6011) COPTIO,CLEAK(7),CSDIR(ILEAK/10)//' SEARCH' WRITE(IOUT,6013) B2(1),B2(2),B2(3) ENDIF ENDIF CREBAL='ON ' IF(IREBAL.EQ.0) CREBAL='OFF' CHLEAK='ON ' IF(LEAKSW) CHLEAK='OFF' WRITE(IOUT,6000) CXDOOR,NGRP,NREG,NUN,NMERG,MAXOUT,MAXINR, > IFRITR,IACITR,CREBAL,REDUC(ITPIJ),CHLEAK, > EPSOUT,EPSUNK,EPSINR IF(ITRANC.GT.0) WRITE(IOUT,6100) ENDIF *---- * RECOVER SPECIFIC TRACKING INFORMATION. *---- IF(CXDOOR.EQ.'MCCG') THEN CALL LCMGET(IPTRK,'MCCG-STATE',ISTATE) NFUNL=ISTATE(19) NLIN=ISTATE(20) ELSE IF(CXDOOR.EQ.'SN') THEN CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE) NFUNL=ISTATE(7) NLIN=ISTATE(8) NDIM=ISTATE(9) NLIN=NLIN**NDIM NLIN=NLIN*ISTATE(35) ELSE NFUNL=1 NLIN=1 ENDIF ALLOCATE(MATCOD(NREG),VOL(NREG),KEYFLX(NREG*NLIN*NFUNL)) KEYFLX(:NREG*NLIN*NFUNL)=0 CALL LCMLEN(IPTRK,'MATCOD',ILNLCM,ITYLCM) IF(ILNLCM.NE.NREG) 1 CALL XABORT( 'FLU: INCOMPATIBLE NUMBER OF REGIONS.') CALL LCMGET(IPTRK,'MATCOD',MATCOD) CALL LCMGET(IPTRK,'VOLUME',VOL) IF((CXDOOR.EQ.'MCCG').OR.(CXDOOR.EQ.'SN')) THEN CALL LCMGET(IPTRK,'KEYFLX$ANIS',KEYFLX) ELSE CALL LCMGET(IPTRK,'KEYFLX',KEYFLX) ENDIF CALL LCMLEN(IPTRK,'TITLE',ILNLCM,ITYLCM) IF( ILNLCM.GT.0 )THEN CALL LCMGTC(IPTRK,'TITLE',72,TITLE) ELSE TITLE='*** NO TITLE PROVIDED ***' ENDIF *---- * COMPUTE THE FLUX. *---- IF(ITYPEC.EQ.1) THEN * FIXED SOURCE EIGENVALUE PROBLEM CALL FLUGPT(IPRINT,IPFLUX,IPTRK,IPMACR,IPFLUP,IPSOU,IFTRAK, 1 IPSYS,IPHASE,ITPIJ,CXDOOR,TITLE,INITFL,LFORW,LEAKSW,IREBAL, 2 NGRP,NMAT,NIFIS,NANIS,NLF,NLIN,NFUNL,COPTIO,NUN,MAXINR,EPSINR, 3 MAXOUT,EPSUNK,EPSOUT,IFRITR,IACITR,ILEAK,NREG,NSOUT,MATCOD, 4 KEYFLX,VOL,REFKEF,NMERG,IMERG) ELSE CALL FLUDRV(IPRINT,IPFLUX,IPTRK,IPMACR,IPSOU,IFTRAK,IPSYS, 1 IPHASE,ITPIJ,CXDOOR,ITRANC,TITLE,B2,INITFL,LFORW,LEAKSW,IREBAL, 2 NGRP,NMAT,NIFIS,NANIS,NLF,NLIN,NFUNL,COPTIO,NUN,MAXINR,EPSINR, 3 MAXOUT,EPSUNK,EPSOUT,IFRITR,IACITR,ITYPEC,ILEAK,NREG,NSOUT, 4 MATCOD,KEYFLX,VOL,REFKEF,NMERG,IMERG) ENDIF *---- * RELEASE GENERAL TRACKING INFORMATION. *---- DEALLOCATE(IMERG) DEALLOCATE(KEYFLX,VOL,MATCOD) CALL LCMSIX(IPMACR,' ',0) RETURN * 6000 FORMAT(' FLUX SOLUTION DOOR = ** ',A6,' **'/ > ' NB. OF GROUPS =',I10/ > ' NB. OF REGIONS =',I10/ > ' NB. OF UNKNOWNS PER GROUP =',I10/ > ' NB. OF LEAKAGE ZONES =',I10/ > ' MAX. OUTER ITERATIONS =',I10/ > ' MAX. THERMAL ITERATIONS =',I10/ > ' ACCELERATION SCHEME =(',I2,' FREE,',I2,' ACCELERATED)'/ > ' REBALANCING OPTION = ',A3/ > ' SELF-SCATTERING REDUCTION = ',A3/ > ' FUNDAMENTAL MODE = ',A3/ > ' EIGENVALUE TOLERANCE = ',1P,E10.3/ > ' UNKNOWN OUTER TOLERANCE = ',E10.3/ > ' UNKNOWN INNER TOLERANCE = ',E10.3/) 6010 FORMAT(////' P. I. M. SOLUTION TO TRANSPORT EQUATION',// > ' CALCULATION TYPE =',2X,A8/ > ' FORWARD/BACKWARD OPTION =',A10/ > ' (AN)ISOTROPY OPTION =',A10) 6011 FORMAT(' LEAKAGE TYPE =',6X,A4/ > ' LEAKAGE OPTION =',6X,A6/ > ' BUCKLING =',2X,A8) 6012 FORMAT(' INITIAL TOTAL BUCKLING =',1P,E13.5) 6013 FORMAT(' INITIAL BUCKLING - X =',1P,E13.5/ > ' INITIAL BUCKLING - Y =',1P,E13.5/ > ' INITIAL BUCKLING - Z =',1P,E13.5) 6100 FORMAT(/' USE TRANSPORT CORRECTED CROSS-SECTIONS') 6400 FORMAT(//' *** WARNING: DOOR ',A12,'IS USED WITH AN ANISOTROPY', > ' LEVEL FROM L_TRACK =',I2,' AND WITH A TRANSPORT CORRECTION S', > 'ET IN LIB:.'/15X,'--> THE TRANSPORT CORRECTION IS DISABLED.'/) END