diff options
Diffstat (limited to 'Dragon/src/FLU.f')
| -rw-r--r-- | Dragon/src/FLU.f | 452 |
1 files changed, 452 insertions, 0 deletions
diff --git a/Dragon/src/FLU.f b/Dragon/src/FLU.f new file mode 100644 index 0000000..31c14ec --- /dev/null +++ b/Dragon/src/FLU.f @@ -0,0 +1,452 @@ +*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 |