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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
*DECK DETCDRV
SUBROUTINE DETCDRV(IPDET,NGRP,NEL,NUN,NX,NY,NZ,MESHX,MESHY,MESHZ,
1 KEYF,FLUX,IPRT,KC,DT,LHEX,LSIMEX,LNORM,VNORM,LPARAB)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Driver for the module DETECT:
*
*Copyright:
* Copyright (C) 2010 Ecole Polytechnique de Montreal.
*
*Author(s):
* E. Varin, M. Guyot
*
*Parameters:
* IPDET pointer to the library object
* NGRP number of energy groups
* NEL number of finite elements
* NUN number of unknowns
* NX number of x mesh-splitted elements
* NY number of y mesh-splitted elements
* NZ number of z mesh-splitted elements
* MESHX
* MESHY
* MESHZ
* KEYF keyflux recover from L_TRACk object
* FLUX flux for each mesh-splitted elements
* IPRT printing index
* KC calculation type reference
* DT time step
* LHEX =.TRUE. if hexagonal detectors are present
* LSIMEX =.TRUE. if keyword SIMEX is present
* LNORM =.TRUE. if keyword NORM is present
* VNORM real used for normalization
* LPARAB =.TRUE. if parabolic interpolation is performed
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPDET
INTEGER IPRT,KC,NGRP,NEL,NX,NY,NZ,KEYF(NEL),NUN
LOGICAL LHEX,LSIMEX,LNORM,LPARAB
REAL FLUX(NUN,NGRP),DT,MESHX(NX+1),MESHY(NY+1),MESHZ(NZ+1),
1 VNORM
*----
* LOCAL VARIABLES
*----
INTEGER NSTATE,IOUT
PARAMETER (NSTATE=40,IOUT=6)
INTEGER ILONG,ITYLCM,INFO(2),NREP,ITHEX,NHEX,J
REAL DEVPOS(6),PLNL,REF,RESP,VLAMDA,XMULT,TLG
CHARACTER NXTYP*12,FIRST*12,NXDET*12,FIRST1*12
LOGICAL LREGUL
INTEGER, ALLOCATABLE, DIMENSION(:) :: IHEX
REAL, ALLOCATABLE, DIMENSION(:) :: SPEC,REP,FRACT,NVCST,PDD,APD,
1 BPD
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(SPEC(NGRP))
*
IF(IPRT.GE.1) THEN
IF(KC.EQ.0) THEN
WRITE(IOUT,*) 'DETECT: CALCULATION TYPE REFERENCE, KC = ',KC
ELSE
WRITE(IOUT,*) 'DETECT: CALCULATION TYPE NORMAL, KC = ',KC
ENDIF
WRITE(IOUT,*) 'DETECT: TIME STEP USED, DT = ',DT
ENDIF
CALL LCMSIX(IPDET,' ',0)
NXTYP = ' '
CALL LCMNXT(IPDET,NXTYP)
FIRST = NXTYP
10 CALL LCMNXT(IPDET,NXTYP)
CALL LCMLEN(IPDET,NXTYP,ILONG,ITYLCM)
IF (ITYLCM.EQ.0) THEN
CALL LCMSIX(IPDET,NXTYP,1)
CALL LCMGET(IPDET,'INFORMATION',INFO)
CALL LCMGET(IPDET,'SPECTRAL',SPEC)
NREP = INFO(2)
ALLOCATE(REP(NREP))
IF( NXTYP(1:5).EQ.'PLATN' )THEN
ALLOCATE(FRACT(NREP-1),NVCST(NREP-2),PDD(NREP-2),APD(NREP-2),
1 BPD(NREP-2))
CALL LCMGET(IPDET,'FRACTION',FRACT)
CALL LCMGET(IPDET,'INV-CONST',NVCST)
ENDIF
NXDET = ' '
CALL LCMNXT(IPDET,NXDET)
FIRST1 = NXDET
20 CALL LCMNXT(IPDET,NXDET)
CALL LCMLEN(IPDET,NXDET,ILONG,ITYLCM)
IF (ITYLCM.EQ.0) THEN
IF(IPRT.GT.3) WRITE(IOUT,*) 'NAME DETECTOR ',NXDET
CALL LCMSIX(IPDET,NXDET,1)
IF(LHEX) THEN
CALL LCMLEN(IPDET,'NHEX',NHEX,ITHEX)
IF(NHEX.EQ.0) CALL XABORT('@DETCDRV: HEXAGON NUMBERS'
+ //' NOT PRESENT IN DETECT')
ALLOCATE(IHEX(NHEX))
CALL LCMGET(IPDET,'NHEX',IHEX)
ENDIF
CALL LCMGET(IPDET,'POSITION',DEVPOS)
CALL LCMGET(IPDET,'RESPON',REP)
IF(LSIMEX.AND.NXTYP.EQ.'VANAD_REGUL') THEN
CALL DETINT(NX,NY,NZ,NEL,NUN,LPARAB,MESHX,MESHY,MESHZ,
+ KEYF,FLUX,NGRP,DEVPOS,RESP,IPRT)
ELSE
CALL DETFLU(LHEX,NX,NY,NZ,NEL,NUN,MESHX,MESHY,MESHZ,KEYF,
+ FLUX,NGRP,SPEC,DEVPOS,NHEX,IHEX,RESP,IPRT)
ENDIF
*----
* DETECTOR RESPONSE CALCULATION
*----
IF(.NOT.LNORM)THEN
PLNL = REP(1)
REF = REP(2)
IF(NXTYP.EQ.'VANAD_REGUL')THEN
*----
* VANADIUM RESPONSE CALCULATION
*----
IF(LSIMEX) THEN
REF = RESP
ELSE
IF(KC.EQ.1) THEN
VLAMDA = 1./225.
XMULT = 1.0 + VLAMDA*DT
XMULT = 1.0/XMULT
RESP = XMULT*(PLNL+DT*VLAMDA*RESP)
REF = PLNL
ELSE
REF = RESP
ENDIF
ENDIF
ELSEIF(NXTYP(1:5).EQ.'PLATN')THEN
*----
* PLATINIUM RESPONSE CALCULATION
*----
LREGUL = .FALSE.
DO 30 J=1,NREP-2
PDD(J) = REP(J)
30 CONTINUE
IF(NXTYP.EQ.'PLATN_REGUL')THEN
LREGUL = .TRUE.
ENDIF
CALL DETPLAT(DT,RESP,REF,KC,PDD,LREGUL,FRACT,NVCST,
+ NREP-2,APD,BPD)
DO 40 J=1,NREP-2
REP(J) = PDD(J)
40 CONTINUE
ELSEIF (NXTYP(1:5).EQ.'CHION') THEN
*----
* LECTURE DE CHAMBRES D'ION
*----
IF(NREP.NE.3)CALL XABORT('@DETCDRV: ION CHAMBERS MUST '
+ //'HAVE THREE STORED VALUES FOR RESPONSES')
IF (KC.EQ.1) THEN
REF = REP(3)
RESP = LOG10(RESP/REF)
TLG = (RESP-PLNL)/DT
REF = TLG
ELSE
REP(3) = RESP
RESP =LOG10(RESP/REP(3))
ENDIF
ENDIF
ELSE
REF = VNORM/RESP
RESP = VNORM
ENDIF
*----
* DETECTOR RESPONSE STORAGE
*----
REP(1) = RESP
REP(2) = REF
IF(IPRT.GT.4) WRITE(6,*) 'RESP, REF ',RESP, REF
CALL LCMPUT(IPDET,'RESPON',NREP,2,REP)
CALL LCMSIX(IPDET,' ',2)
ENDIF
IF(LHEX) DEALLOCATE(IHEX)
IF(NXDET.EQ.FIRST1) GOTO 45
GOTO 20
45 CALL LCMSIX(IPDET,' ',2)
DEALLOCATE(REP)
IF(NXTYP(1:5).EQ.'PLATN')THEN
DEALLOCATE(FRACT,NVCST,PDD,APD,BPD)
ENDIF
ENDIF
IF (NXTYP.EQ.FIRST) GOTO 50
GOTO 10
50 CONTINUE
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(SPEC)
RETURN
END
|
