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
|
*DECK NXTTLO
SUBROUTINE NXTTLO(IPRINT,MXMESH,
> MESH ,DMESH ,POSTRI)
*
*----------
*
*Purpose:
* Locate triangles positions for HEXT, HEXTZ, HEXTCEL and HEXTCELZ.
*
*Copyright:
* Copyright (C) 2013 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.
* MXMESH maximum number of spatial subdivision in
* $X$, $Y$ and $Z$.
* MESH effective number of spatial subdivision in
* each direction ($X$, $Y$ and $Z$).
* DMESH spatial description of the Cartesian geometry.
* POSTRI triangle position:
* POSTRI(1,*,*,*) is X position;
* POSTRI(2,*,*,*) is Y position;
* POSTRI(*,1,*,*) is location of first corner;
* POSTRI(*,2,*,*) is location of second corner;
* POSTRI(*,3,*,*) is location of third corner;
* POSTRI(*,*,i,j) is location of triangle i in cector j.
*
*----------
*
IMPLICIT NONE
*----
* Subroutine arguments
*----
INTEGER IPRINT,MXMESH
INTEGER MESH(4)
DOUBLE PRECISION DMESH(-1:MXMESH,4)
DOUBLE PRECISION POSTRI(2,3,MXMESH*MXMESH,6)
*----
* Local parameters
*----
INTEGER IOUT
CHARACTER NAMSBR*6
PARAMETER (IOUT=6,NAMSBR='NXTTLO')
DOUBLE PRECISION DZERO,DHALF,DSQ3O2
PARAMETER (DZERO=0.0D0,DHALF=0.5D0,
> DSQ3O2=0.86602540378444D0)
*----
* Local variables
*----
INTEGER NX,IREG,IX,IR,ISECT,ITRI
DOUBLE PRECISION SIDET,SIDEL,SIDEH,
> POSCX,POSCXD,POSCY,POSCYD
*----
* Initialize POSTRI and get triangle side
*----
IF(IPRINT .GE. 500) THEN
WRITE(IOUT,6000) NAMSBR
ENDIF
POSTRI(:2,:3,:MXMESH*MXMESH,:6)=DZERO
NX=MESH(1)
IF(NX .EQ. 1) THEN
SIDET=DMESH(1,1)-DMESH(0,1)
ELSE
SIDET=DMESH(2,1)-DMESH(1,1)
ENDIF
SIDEL=SIDET/DSQ3O2
SIDEH=DHALF*SIDEL
*----
* 1- First sector
*----
IREG=0
POSCXD=DZERO
POSCYD=SIDEH
DO IX=1,NX
*----
* Loop over right triangles on the line
*----
POSCX=POSCXD
POSCY=POSCYD
DO IR=1,IX-1
IREG=IREG+1
POSTRI(1,1,IREG,1)=POSCX+SIDET
POSTRI(2,1,IREG,1)=POSCY
POSTRI(1,2,IREG,1)=POSCXD
POSTRI(2,2,IREG,1)=POSCY+SIDEH
POSTRI(1,3,IREG,1)=POSCXD
POSTRI(2,3,IREG,1)=POSCY-SIDEH
POSCY=POSCY+SIDEL
ENDDO
*----
* Loop over left triangles on the line
*----
POSCYD=POSCYD-SIDEH
POSCX=POSCXD
POSCY=POSCYD
DO IR=1,IX
IREG=IREG+1
POSTRI(1,1,IREG,1)=POSCX
POSTRI(2,1,IREG,1)=POSCY
POSTRI(1,2,IREG,1)=POSCX+SIDET
POSTRI(2,2,IREG,1)=POSCY-SIDEH
POSTRI(1,3,IREG,1)=POSCX+SIDET
POSTRI(2,3,IREG,1)=POSCY+SIDEH
POSCY=POSCY+SIDEL
ENDDO
POSCXD=POSCXD+SIDET
ENDDO
*----
* Five other sectors are just Pi/3 rotations of first sectors
* triangles
*----
DO ISECT=2,6
DO IR=1,NX*NX
DO ITRI=1,3
POSTRI(1,ITRI,IR,ISECT)=DHALF*POSTRI(1,ITRI,IR,ISECT-1)
> -DSQ3O2*POSTRI(2,ITRI,IR,ISECT-1)
POSTRI(2,ITRI,IR,ISECT)=DSQ3O2*POSTRI(1,ITRI,IR,ISECT-1)
> +DHALF*POSTRI(2,ITRI,IR,ISECT-1)
ENDDO
ENDDO
ENDDO
IF(IPRINT .GE. 500) THEN
WRITE(IOUT,6020)
DO ISECT=1,6
DO IR=1,NX*NX
WRITE(IOUT,6021) ISECT,IR,
> (POSTRI(1,ITRI,IR,ISECT),POSTRI(2,ITRI,IR,ISECT),ITRI=1,3)
ENDDO
ENDDO
WRITE(IOUT,6001) NAMSBR
ENDIF
RETURN
*----
* Output formats
*----
6000 FORMAT('(* Output from --',A6,'-- follows ')
6001 FORMAT(' Output from --',A6,'-- completed *)')
6020 FORMAT('X-Y location of triangle corners')
6021 FORMAT(2I5,6F20.10)
END
|
