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
|
*DECK DETDRV
SUBROUTINE DETDRV(IPDET,NGRP,IPRT,LHEX,NDETOT,LENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Driver for module DETINI:
*
*Copyright:
* Copyright (C) 2010 Ecole Polytechnique de Montreal.
*
*Author(s):
* J. Koclas, E. Varin, M. Guyot
*
*Parameters: input/output
* IPDET pointer to the L_DETECT object.
* NGRP number of energy groups
* IPRT printing flag
* LHEX =.TRUE. if it is an hexagonal geometry
* NDETOT total number of detectors
* LENTRY =.TRUE. if the L_DETECT object is updated
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPDET
INTEGER NGRP,IPRT,NDETOT
LOGICAL LHEX,LENTRY
*----
* LOCAL VARIABLES
*----
CHARACTER TEXT*12,TYPE*12
INTEGER ITYP,NITMA,NDETEC,NREP,I,INFO(2)
REAL FLOT
DOUBLE PRECISION DFLOT
REAL, ALLOCATABLE, DIMENSION(:) :: SPEC,CST,FRACT
*----
* READING INFORMATION LINKED TO DETECTOR TYPE
*----
CALL REDGET(ITYP,NITMA,FLOT,TYPE,DFLOT)
IF (ITYP.NE.3) CALL XABORT('@DETDRV: CHARACTER DATA'
+ //' EXPECTED(1)')
CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
IF ((ITYP.NE.3).OR.(TEXT.NE.'INFO')) CALL XABORT('@DETINI:'
+ //' CHARACTER INFO EXPECTED')
CALL REDGET(ITYP,NDETEC,FLOT,TEXT,DFLOT)
IF (ITYP.NE.1) CALL XABORT('@DETDRV: INTEGER DATA EXPECTED(1)')
CALL REDGET(ITYP,NREP,FLOT,TEXT,DFLOT)
IF(NREP.LT.2)CALL XABORT('@DETDRV: AT LEAST TWO RESPONSES')
*----
* READING INFORMATION LINKED TO ENERGY SPECTRAL
*----
IF(NGRP.EQ.0)CALL XABORT('@DETDRV: NUMBER OF GROUPS REQUIRED')
ALLOCATE(SPEC(NGRP))
CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
IF (ITYP.NE.3) CALL XABORT('@DETDRV: CHARACTER DATA'
+ //' EXPECTED(2)')
IF(TEXT.EQ.'SPECTRAL') THEN
DO 10 I=1,NGRP
CALL REDGET(ITYP,NITMA,SPEC(I),TEXT,DFLOT)
IF (ITYP.NE.2) CALL XABORT('@DETDRV: REAL DATA EXPECTED '
+ //'FOR SPECTRAL')
10 CONTINUE
ELSEIF(TEXT.EQ.'DEFAULT')THEN
DO 20 I=1,NGRP-1
SPEC(I) = 0.0
20 CONTINUE
SPEC(NGRP) = 1.0
WRITE(6,*) '**** WARINING **** ENERGY SPECTRAL INITIALIZED '
+ //'TO 1.0 IN THE HIGHEST GROUP ONLY '
ELSE
CALL XABORT('@DETDRV: KEYWORDS FOR SPECTRAL EXPECTED')
ENDIF
*----
* READING INFORMATION LINKED TO DELAY CONSTANT AND FRACTION READING
*----
IF(TYPE(1:5).EQ.'PLATN') THEN
IF(NREP.LE.2)CALL XABORT('@DETDRV: MORE THAN TWO RESPONSES'
+ //' MUST BE SPECIFIED')
CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
IF (ITYP.NE.3) CALL XABORT('@DETDRV: CHARACTER DATA'
+ //' EXPECTED(3)')
IF(TEXT.EQ.'INVCONST') THEN
ALLOCATE(CST(NREP-2))
DO 40 I=1,NREP-2
CALL REDGET(ITYP,NITMA,CST(I),TEXT,DFLOT)
IF(ITYP.NE.2) CALL XABORT('@DETDRV: REAL DATA EXPECTED '
+ //'FOR TIME CONSTANTS')
40 CONTINUE
CALL LCMSIX(IPDET,' ',0)
CALL LCMSIX(IPDET,TYPE,1)
CALL LCMPUT(IPDET,'INV-CONST',NREP-2,2,CST)
CALL LCMSIX(IPDET,' ',0)
DEALLOCATE(CST)
ELSE
CALL XABORT('@DETDRV: KEYWORD INVCONST EXPECTED FOR'
+ //' PLATINIUM DETECTORS')
ENDIF
CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
IF (ITYP.NE.3) CALL XABORT('@DETDRV: CHARACTER DATA'
+ //' EXPECTED(4)')
IF(TEXT.EQ.'FRACTION') THEN
ALLOCATE(FRACT(NREP-1))
DO 50 I=1,NREP-1
CALL REDGET(ITYP,NITMA,FRACT(I),TEXT,DFLOT)
IF (ITYP.NE.2) CALL XABORT('@DETDRV: REAL DATA EXPECTED'
+ //' FOR FRACTION')
50 CONTINUE
CALL LCMSIX(IPDET,' ',0)
CALL LCMSIX(IPDET,TYPE,1)
CALL LCMPUT(IPDET,'FRACTION',NREP-1,2,FRACT)
CALL LCMSIX(IPDET,' ',0)
DEALLOCATE(FRACT)
ELSE
CALL XABORT('@DETDRV: KEYWORD FRACTION EXPECTED FOR'
+ //' PLATINIUM DETECTORS')
ENDIF
ENDIF
DO 30 I=1,NDETEC
CALL DETREAD(IPDET,TYPE,NREP,IPRT,LHEX)
30 CONTINUE
*----
* STORAGE OF INFORMATION
*----
CALL LCMSIX(IPDET,' ',0)
CALL LCMSIX(IPDET,TYPE,1)
IF (.NOT.LENTRY) THEN
INFO(1)=NDETEC
INFO(2)=NREP
ELSE
CALL LCMGET(IPDET,'INFORMATION',INFO)
INFO(1) = INFO(1) + NDETEC
IF (NREP.NE.INFO(2))
+ CALL XABORT('@DETDRV: RESPONS NUMBER INCONSISTENT WITH '//
+ ' THE PREVIOUS VALUE')
ENDIF
CALL LCMPUT(IPDET,'INFORMATION',2,1,INFO)
CALL LCMPUT(IPDET,'SPECTRAL',NGRP,2,SPEC)
CALL LCMSIX(IPDET,' ',0)
NDETOT = NDETOT + NDETEC
DEALLOCATE(SPEC)
RETURN
END
|
