diff options
Diffstat (limited to 'Dragon/src/TRFICF.f')
| -rw-r--r-- | Dragon/src/TRFICF.f | 123 |
1 files changed, 123 insertions, 0 deletions
diff --git a/Dragon/src/TRFICF.f b/Dragon/src/TRFICF.f new file mode 100644 index 0000000..291e471 --- /dev/null +++ b/Dragon/src/TRFICF.f @@ -0,0 +1,123 @@ +*DECK TRFICF + SUBROUTINE TRFICF(KPSYS,IFTRAK,IPRNTF,NGEFF,NGIND,IDIR,NREGIO, + > NUNKNO,MATCOD,VOLUME,KEYFLX,FUNKNO,SUNKNO, + > TITRE) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Solve N-group transport equation for fluxes using the scattering +* modified collision probability matrix. +* +*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): G. Marleau +* +*Parameters: input +* KPSYS pointer to the pij matrices (L_PIJ signature). KPSYS is +* an array of directories. +* IFTRAK not used. +* IPRNTF print selection for flux modules. +* NGEFF number of energy groups processed in parallel. +* NGIND energy group indices assign to the NGEFF set. +* IDIR directional collision probability flag: +* =0 for pij or wij; +* =k for pijk or wijk k=1,2,3. +* NREGIO number of regions considered. +* NUNKNO number of unknown in the system. +* MATCOD mixture code in region. +* VOLUME volume of region. +* KEYFLX flux elements in unknown system. +* SUNKNO source for system of unknown. +* TITRE title. +* +*Parameters: input/output +* FUNKNO unknown vector solved for. +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) KPSYS(NGEFF) + CHARACTER TITRE*72 + INTEGER NGEFF,NGIND(NGEFF),IFTRAK,IPRNTF,IDIR,NREGIO,NUNKNO, + > MATCOD(NREGIO),KEYFLX(NREGIO) + REAL VOLUME(NREGIO),FUNKNO(NUNKNO,NGEFF), + > SUNKNO(NUNKNO,NGEFF) +*---- +* LOCAL VARIABLES +*---- + PARAMETER (IUNOUT=6) + CHARACTER CNS(0:3)*1,NAMLCM*12,NAMMY*12 + INTEGER ILCMLN + LOGICAL EMPTY,LCM + SAVE CNS +*---- +* ALLOCATABLE ARRAYS +*---- + TYPE(C_PTR) CPMAT_PTR + REAL, POINTER, DIMENSION(:) :: CPMAT +*---- +* DATA STATEMENTS +*---- + DATA CNS /'-','1','2','3'/ +*---- +* RECOVER TRAFIC SPECIFIC PARAMETERS +*---- + IF(IPRNTF.GT.2) WRITE(IUNOUT,'(//9H TRFICF: ,A72)') TITRE + CALL LCMINF(KPSYS(1),NAMLCM,NAMMY,EMPTY,ILONG,LCM) + IF(IFTRAK.LT.0) CALL XABORT('TRFICF: EXPECTING IFTRAK>=0') + IF(MATCOD(1).LT.0) CALL XABORT('TRFICF: EXPECTING MATCOD(1)>=0') + IF(VOLUME(1).LT.0.0) CALL XABORT('TRFICF: EXPECTING VOLUME(1)>=0') +*---- +* MAIN LOOP OVER ENERGY GROUPS. +*---- + IF(.NOT.LCM) THEN + ALLOCATE(CPMAT(NREGIO*NREGIO),STAT=IER) + IF(IER.NE.0) CALL XABORT('TRFICF: CANNOT ALLOCATE CPMAT.') + ENDIF + DO 60 II=1,NGEFF + IF(IPRNTF.GT.2) WRITE(IUNOUT,'(/25H TRFICF: PROCESSING GROUP,I5, + 1 6H WITH ,A,1H.)') NGIND(II),'TRAFIC' +*---- +* READ SCATTERING MODIFIED COLLISION PROBABILITIES +*---- + CALL LCMLEN(KPSYS(II),'DRAGON'//CNS(IDIR)//'PCSCT',ILCMLN,ITYLCM) + IF((ILCMLN.GT.0).AND.LCM) THEN + CALL LCMGPD(KPSYS(II),'DRAGON'//CNS(IDIR)//'PCSCT',CPMAT_PTR) + CALL C_F_POINTER(CPMAT_PTR,CPMAT,(/ NREGIO*NREGIO /)) + ELSE IF(ILCMLN.GT.0) THEN + CALL LCMGET(KPSYS(II),'DRAGON'//CNS(IDIR)//'PCSCT',CPMAT) + ELSE + CALL XABORT('TRFICF: RECORD DRAGON'//CNS(IDIR)// + > 'PCSCT ABSENT FROM LCM') + ENDIF +*---- +* SOLVE TRANSPORT EQUATION +*---- + JCPMAT=0 + DO 30 I=1,NREGIO + FUNKNO(KEYFLX(I),II)=0.0 + 30 CONTINUE + DO 50 I=1,NREGIO + IPOS=KEYFLX(I) + DO 40 J=1,NREGIO + JPOS=KEYFLX(J) + JCPMAT=JCPMAT+1 + FUNKNO(JPOS,II)=FUNKNO(JPOS,II)+SUNKNO(IPOS,II)*CPMAT(JCPMAT) + 40 CONTINUE + 50 CONTINUE +*---- +* END OF LOOP OVER ENERGY GROUPS +*---- + 60 CONTINUE + IF(.NOT.LCM) DEALLOCATE(CPMAT) + RETURN + END |