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
|
*DECK NXTHCL
SUBROUTINE NXTHCL(IPRINT,IR ,IS ,ISS ,
> SIDEH ,XLOC ,YLOC )
*
*----------
*
*Purpose:
* Locate spatial position of hexagon in assembly of cells.
*
*Copyright:
* Copyright (C) 2005 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
* IPRINT print level.
* IR crown number.
* IS cell sector.
* ISS cell in sector.
* SIDEH hexagon width.
*
*Parameters: output
* XLOC X location of cell center in assembly.
* YLOC Y location of cell center in assembly.
*
*Reference:
* G. Marleau,
* New Geometries Processing in DRAGON: The NXT: Module,
* Report IGE-260, Polytechnique Montreal,
* Montreal, 2005.
*
*----------
*
IMPLICIT NONE
*----
* Subroutine arguments
*----
INTEGER IPRINT,IR,IS,ISS
DOUBLE PRECISION SIDEH,XLOC,YLOC
*----
* Local parameters
*----
INTEGER IOUT
CHARACTER NAMSBR*6
PARAMETER (IOUT=6,NAMSBR='NXTHCL')
DOUBLE PRECISION DZERO,DONE,DHALF,DSQ3O2
PARAMETER (DZERO=0.0D0,DONE=1.0D0,
> DHALF=0.5D0,DSQ3O2=0.86602540378444D0)
*----
* Local variables
*----
DOUBLE PRECISION SQ32H,H3O2,XLOCR,YLOCR
*----
* Processing starts:
* print routine openning output header if required
* and initialize various parameters.
*----
IF(IPRINT .GE. 10) THEN
WRITE(IOUT,6000) NAMSBR
IF(IPRINT .GE. 100) THEN
WRITE(IOUT,6010) IR,IS,ISS,SIDEH
ENDIF
ENDIF
SQ32H=SIDEH*DSQ3O2
H3O2=3.0D0*DHALF*SIDEH
IF(IR.EQ.1) THEN
XLOC=DZERO
YLOC=DZERO
ELSE
XLOCR=SQ32H*(2.0D0*DBLE(IR-1)-DBLE(ISS-1))
YLOCR=H3O2*DBLE(ISS-1)
IF(IS .EQ. 1) THEN
*----
* No rotation
*----
XLOC=XLOCR
YLOC=YLOCR
ELSE IF(IS .EQ. 2) THEN
*----
* Rotate by Pi/3
*----
XLOC=DHALF*XLOCR-DSQ3O2*YLOCR
YLOC=DSQ3O2*XLOCR+DHALF*YLOCR
ELSE IF(IS .EQ. 3) THEN
*----
* Rotate by 2*Pi/3
*----
XLOC=-DHALF*XLOCR-DSQ3O2*YLOCR
YLOC=DSQ3O2*XLOCR-DHALF*YLOCR
ELSE IF(IS .EQ. 4) THEN
*----
* Rotate by Pi
*----
XLOC=-XLOCR
YLOC=-YLOCR
ELSE IF(IS .EQ. 5) THEN
*----
* Rotate by 4*Pi/3
*----
XLOC=-DHALF*XLOCR+DSQ3O2*YLOCR
YLOC=-DSQ3O2*XLOCR-DHALF*YLOCR
ELSE IF(IS .EQ. 6) THEN
*----
* Rotate by 5*Pi/3
*----
XLOC=DHALF*XLOCR+DSQ3O2*YLOCR
YLOC=-DSQ3O2*XLOCR+DHALF*YLOCR
ENDIF
ENDIF
*----
* Processing finished:
* print routine closing output header if required
* and return
*----
IF(IPRINT .GE. 10) THEN
IF(IPRINT .GE. 100) THEN
WRITE(IOUT,6011) XLOC,YLOC
ENDIF
WRITE(IOUT,6001) NAMSBR
ENDIF
RETURN
*----
* Output formats
*----
6000 FORMAT('(* Output from --',A6,'-- follows ')
6001 FORMAT(' Output from --',A6,'-- completed *)')
6010 FORMAT(' Location of cell in ',
>' Crown = ',I8,5X,'Sector =',I8,5X,' Cell =',I8,5X,
>' SIDE = ',F20.10)
6011 FORMAT(' X =',F20.10,10X,'Y =',F20.10)
END
|
