summaryrefslogtreecommitdiff
path: root/Dragon/src/FMTDFD.f
blob: a740180eedc540fc41fe864a6f271991a73e904a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
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