diff options
Diffstat (limited to 'Dragon/src/FMTDFD.f')
| -rw-r--r-- | Dragon/src/FMTDFD.f | 170 |
1 files changed, 170 insertions, 0 deletions
diff --git a/Dragon/src/FMTDFD.f b/Dragon/src/FMTDFD.f new file mode 100644 index 0000000..a740180 --- /dev/null +++ b/Dragon/src/FMTDFD.f @@ -0,0 +1,170 @@ +*DECK FMTDFD + SUBROUTINE FMTDFD(NENTRY,KENTRY,IPRINT,IKFLU ,NTREG , + > NREG ,NGROUP,NDIM ,VOLUME,KEYFLX) +* +*----------------------------------------------------------------------- +* +*Purpose: +* To process the angular fluxes and generate the directional +* flux file. +* +*Copyright: +* Copyright (C) 2008 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 +* NENTRY number of data structures transfered to this module. +* KENTRY data structure pointer. +* IPRINT print level. +* IKFLU pointer to the FLUX data structure. +* NTREG number of regions for problem. +* NREG number of unknowns for problem. +* NGROUP number of groups for problem. +* NDIM number of dimensions of problem. +* VOLUME regional volumes. +* KEYFLX index for regional fluxes in unknown vector. +* +*---------- +* + USE GANLIB + IMPLICIT NONE +*---- +* Subroutine arguments +*---- + INTEGER NENTRY + TYPE(C_PTR) KENTRY(NENTRY) + INTEGER IPRINT,IKFLU + INTEGER NREG,NTREG,NGROUP,NDIM,KEYFLX(NTREG) + REAL VOLUME(NTREG) +*---- +* Local parameters +*---- + INTEGER IOUT + CHARACTER NAMSBR*6 + PARAMETER (IOUT=6,NAMSBR='FMTDFD') + INTEGER ILCMUP,ILCMDN + PARAMETER (ILCMUP=1,ILCMDN=2) +*---- +* Local variables +*---- + INTEGER ILONG,ITYLCM + TYPE(C_PTR) IPU,JPU + INTEGER IFPU,IGROUP,IR,NFLUX,IFTT + CHARACTER*12 NAMFLX(2) +*---- +* Allocatable arrays +*---- + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: AFLUX +*---- +* Work storage allocation +*---- + ALLOCATE(AFLUX(NREG,2,NGROUP)) +*---- +* Initialize FLUX vectors +*---- + NFLUX=1 + NAMFLX(1)='FLUX ' + IPU=KENTRY(IKFLU) + CALL LCMLEN(IPU,'AFLUX',ILONG,ITYLCM) + write(6,*) 'FLUXADJOINT ',ILONG,ITYLCM + IF(ILONG .EQ. -1) THEN + NFLUX=2 + NAMFLX(2)='ADJOINT ' + ENDIF + IF(IPRINT .GE. 10) THEN + WRITE(IOUT,6000) NAMSBR,NGROUP,NDIM,NTREG,NREG + WRITE(IOUT,6008) + WRITE(IOUT,6012) (NAMFLX(IFTT),IFTT=1,NFLUX) + ENDIF +*---- +* Get information from FLUX data structure. +* 1. Angular flux +* 2. Angular adjoint +*---- + JPU=LCMGID(IPU,'FLUX') + DO IGROUP=1,NGROUP + CALL LCMGDL(JPU,IGROUP,AFLUX(1,1,IGROUP)) + ENDDO + IF(NFLUX .GT. 1) THEN + JPU=LCMGID(IPU,'AFLUX') + DO IGROUP=1,NGROUP + CALL LCMGDL(JPU,IGROUP,AFLUX(1,1,IGROUP)) + ENDDO + ENDIF +*---- +* Create output file +*---- + IFPU=FILUNIT(KENTRY(1)) + WRITE(IFPU,1000) NGROUP,NDIM,NREG,NFLUX + WRITE(IFPU,1001) (NAMFLX(IFTT),IFTT=1,NFLUX) +*---- +* Print volumes +*---- + WRITE(IFPU,1002) (VOLUME(IR),IR=1,NREG) +*---- +* Print angular flux +*---- + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6003) + ENDIF + DO IGROUP=1,NGROUP + WRITE(IOUT,6002) IGROUP + WRITE(IOUT,1002) (AFLUX(IR,1,IGROUP),IR=1,NREG) + WRITE(IFPU,1002) (AFLUX(IR,1,IGROUP),IR=1,NREG) + ENDDO +*---- +* Print scalar flux +*---- + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6004) + DO IGROUP=1,NGROUP + WRITE(IOUT,6002) IGROUP + WRITE(IOUT,1002) (AFLUX(KEYFLX(IR),1,IGROUP),IR=1,NTREG) + WRITE(IFPU,1002) (AFLUX(KEYFLX(IR),1,IGROUP),IR=1,NTREG) + ENDDO + ENDIF +*---- +* Print angular adjoint +*---- + IF(NFLUX .GT. 1) THEN + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6005) + ENDIF + DO IGROUP=1,NGROUP + WRITE(IOUT,6002) IGROUP + WRITE(IOUT,1002) (AFLUX(IR,2,IGROUP),IR=1,NREG) + WRITE(IFPU,1002) (AFLUX(IR,2,IGROUP),IR=1,NREG) + ENDDO + ENDIF +*---- +* Work storage deallocation +*---- + DEALLOCATE(AFLUX) +*---- +* Processing finished, return +*---- + RETURN +*---- +* Formats +*---- + 1000 FORMAT(5I10) + 1001 FORMAT(5(A12,2X)) + 1002 FORMAT(1P,5E20.10) + 6000 FORMAT('Output from routine ',A6/ + > 'Number of groups =',I5/ + > 'Number of dimens =',I5/ + > 'Number of regions =',I5/ + > 'Number of unknowns=',I5) + 6002 FORMAT('Group = ',I5) + 6003 FORMAT('Direct angular flux per region ') + 6004 FORMAT('Scalar flux per region integrated from angular flux') + 6005 FORMAT('Adjoint angular flux per region') + 6008 FORMAT('Flux record types') + 6012 FORMAT(5(A12,2X)) + END |