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
|
*DECK DEVINI
SUBROUTINE DEVINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Read specification for the rod-devices, create a device object.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s):
* D. Sekki
*
*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 DEVINI: module specification is:
* DEVICE MATEX := DEVINI: MATEX :: (descdev) ;
* where
* DEVICE : name of the \emph{device) object that will be created by the
* module; it will contain the devices information.
* MATEX : name of the \emph{matex} object that will be updated by the
* module. The rod-devices material mixtures are appended to the previous
* material index and the rod-devices indices are also modified, accordingly.
* (descdev) : structure describing the input data to the DEVINI: module.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
TYPE(C_PTR) KENTRY(NENTRY)
CHARACTER HENTRY(NENTRY)*12
*----
* LOCAL VARIABLES
*----
PARAMETER(NSTATE=40)
CHARACTER HSIGN*12,TEXT12*12
INTEGER ISTATE(NSTATE)
REAL LIMIT(6)
TYPE(C_PTR) IPDEV,IPMTX
REAL, ALLOCATABLE, DIMENSION(:) :: XXX,YYY,ZZZ
*----
* PARAMETER VALIDATION
*----
IF(NENTRY.NE.2)CALL XABORT('@DEVINI: TWO PARAMETERS EXPECTED')
TEXT12=HENTRY(1)
IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@DEVI'
1 //'NI: LCM OBJECT FOR L_DEVICE EXPECTED ('//TEXT12//').')
IF(JENTRY(1).NE.0)CALL XABORT('@DEVINI: CREATE MODE EXPECTE'
1 //'D FOR L_DEVICE.')
HSIGN='L_DEVICE'
CALL LCMPTC(KENTRY(1),'SIGNATURE',12,HSIGN)
IPDEV=KENTRY(1)
TEXT12=HENTRY(2)
IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@DEVI'
1 //'NI: LCM OBJECT FOR L_MATEX EXPECTED ('//TEXT12//').')
CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)
IF(HSIGN.NE.'L_MATEX')CALL XABORT('@DEVINI: MISSING L_MATEX.')
IF(JENTRY(2).NE.1)CALL XABORT('@DEVINI: MODIFICATION MODE E'
1 //'XPECTED FOR L_MATEX.')
IPMTX=KENTRY(2)
*----
* RECOVER INFORMATION
*----
ISTATE(:NSTATE)=0
CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
IGEO=ISTATE(6)
IF(IGEO.NE.7)CALL XABORT('@DEVINI: ON'
1 //'LY 3D-CARTESIAN GEOMETRY ALLOWED.')
NMIX=ISTATE(2)
NTOT=ISTATE(5)
LX=ISTATE(8)
LY=ISTATE(9)
LZ=ISTATE(10)
* CORE LIMITS ALONG X-AXIS
ALLOCATE(XXX(LX+1))
XXX(:LX+1)=0.0
CALL LCMGET(IPMTX,'MESHX',XXX)
LIMIT(1)=XXX(1)
LIMIT(2)=XXX(LX+1)
DEALLOCATE(XXX)
* CORE LIMITS ALONG Y-AXIS
ALLOCATE(YYY(LY+1))
YYY(:LY+1)=0.0
CALL LCMGET(IPMTX,'MESHY',YYY)
LIMIT(3)=YYY(1)
LIMIT(4)=YYY(LY+1)
DEALLOCATE(YYY)
* CORE LIMITS ALONG Z-AXIS
ALLOCATE(ZZZ(LZ+1))
ZZZ(:LZ+1)=0.0
CALL LCMGET(IPMTX,'MESHZ',ZZZ)
LIMIT(5)=ZZZ(1)
LIMIT(6)=ZZZ(LZ+1)
DEALLOCATE(ZZZ)
* READ ROD-DEVICES DATA
CALL DEVDRV(IPDEV,IPMTX,IGEO,NMIX,NTOT,LIMIT)
RETURN
END
|