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
|
*DECK DETINI
SUBROUTINE DETINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Reads detector information and stores them
*
*Copyright:
* Copyright (C) 2010 Ecole Polytechnique de Montreal.
*
*Author(s):
* J. Koclas, E. Varin, M. Guyot
*
*Parameters: input
* NENTRY number of data structures transfered to this module.
* HENTRY name of the data structures.
* IENTRY data structure type where:
* IENTRY=1 for LCM memory object;
* IENTRY=2 for XSM file;
* IENTRY=3 for sequential binary file;
* IENTRY=4 for sequential ASCII file.
* JENTRY access permission for the data structure where:
* JENTRY=0 for a data structure in creation mode;
* JENTRY=1 for a data structure in modifications mode;
* JENTRY=2 for a data structure in read-only mode.
* KENTRY data structure pointer.
*
*Comments:
* The DETINI: module specification is:
* DETECT := DETINI: [ DETECT ] :: (descdet) ;
* where
* DETECT : name of the \emph{detect} object that will be created by the
* module; it will contain the detector informations. If \emph{detect}
* appear on RHS, it is updated, otherwise, it is created.
* (descdev) : structure describing the input data to the DETINI: module.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
TYPE(C_PTR) KENTRY(NENTRY)
CHARACTER HENTRY(NENTRY)*12
*----
* LOCAL VARIABLES
*----
INTEGER NSTATE
PARAMETER (NSTATE=40)
CHARACTER TEXT*12,HSIGN*12
INTEGER ISTATE(NSTATE),NGRP,NDETOT,IPRT,IHEX,ITYP,NITMA
REAL FLOT
DOUBLE PRECISION DFLOT
LOGICAL LHEX,LDET,LENTRY
TYPE(C_PTR) IPDET
*----
* PARAMETER VALIDATION
*----
NDETOT = 0
NGRP = 0
LENTRY=.FALSE.
ISTATE(:NSTATE)=0
*
IF(NENTRY.NE.1) CALL XABORT('@DETINI: PARAMETER EXPECTED.')
IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('@D'
+ //'ETINI: LINKED LIST OR XSM FILE EXPECTED AT LHS.')
IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('@D'
+ //'ETINI: CREATE OR MODIFICATION MODE EXPECTED.')
*
IPDET=KENTRY(1)
IF(JENTRY(1).EQ.1) THEN
TEXT=HENTRY(1)
LENTRY=.TRUE.
CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN)
IF(HSIGN.NE.'L_DETECT')CALL XABORT('@DETINI: L_DETECT'
+ //' OBJECT IS EXPECTED (OBJECT='//TEXT//')')
CALL LCMGET(IPDET,'STATE-VECTOR',ISTATE)
NGRP = ISTATE(1)
NDETOT = ISTATE(2)
ENDIF
*----
* READ INPUT DATA
*----
IPRT = 0
LHEX = .FALSE.
LDET= .FALSE.
IHEX = 0
10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
IF(ITYP.NE.3) CALL XABORT('@DETINI: CHARACTER DATA'
+ //' EXPECTED(1).')
IF(TEXT.EQ.'EDIT') THEN
CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
IF(ITYP.NE.1)CALL XABORT('@DETINI: INTEGER DATA EXPECTED(1).')
IPRT=MAX(0,NITMA)
ELSEIF(TEXT.EQ.'HEXZ')THEN
LHEX=.TRUE.
ELSEIF(TEXT.EQ.'NGRP')THEN
CALL REDGET(ITYP,NGRP,FLOT,TEXT,DFLOT)
IF(ITYP.NE.1)CALL XABORT('@DETINI: INTEGER DATA EXPECTED(2).')
IF(JENTRY(1).EQ.1) THEN
CALL XABORT('@DETINI: ENERGY GROUP NUMBER REQUIRED ONLY AT'
+ //' CREATION OF L_DETECT OBJECT')
ENDIF
ELSEIF(TEXT.EQ.'TYPE')THEN
CALL DETDRV(IPDET,NGRP,IPRT,LHEX,NDETOT,LENTRY)
ELSEIF(TEXT.EQ.';')THEN
LDET=.TRUE.
ELSE
CALL XABORT('@DETINI: INVALID KEYWORD '//TEXT)
ENDIF
IF(.NOT.LDET) GOTO 10
*----
* STATE-VECTOR STORAGE
*----
IF(JENTRY(1).EQ.0) THEN
HSIGN='L_DETECT'
CALL LCMSIX(IPDET,' ',0)
CALL LCMPTC(IPDET,'SIGNATURE',12,HSIGN)
ENDIF
ISTATE(:NSTATE)=0
ISTATE(1)=NGRP
ISTATE(2)=NDETOT
IF(LHEX) ISTATE(3)=1
CALL LCMPUT(IPDET,'STATE-VECTOR',NSTATE,1,ISTATE)
IF(IPRT.GT.2) CALL LCMLIB(IPDET)
RETURN
END
|
