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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
|
!
!-----------------------------------------------------------------------
!
!Purpose:
! Generate a surfacic 2D geometry following the TDT specification.
!
!Copyright:
! Copyright (C) 2001 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. Civario (CS-SI)
!
!Parameters: input/output
! NENTRY : NUMBER OF LINKED LISTS AND FILES USED BY THE MODULE.
! HENTRY : CHARACTER*12 NAME OF EACH LINKED LIST OR FILE.
! IENTRY : =1 LINKED LIST; =2 XSM FILE; =3 SEQUENTIAL BINARY FILE;
! =4 SEQUENTIAL ASCII FILE; =5 DIRECT ACCESS FILE.
! JENTRY : =0 THE LINKED LIST OR FILE IS CREATED;
! =1 THE LINKED LIST OR FILE IS OPEN FOR MODIFICATIONS;
! =2 THE LINKED LIST OR FILE IS OPEN IN READ-ONLY MODE.
! KENTRY : FILE UNIT NUMBER OR LINKED LIST ADDRESS.
!
!-----------------------------------------------------------------------
!
subroutine G2S(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
use GANLIB
use SALGET_FUNS_MOD
use celluleBase
use cellulePlaced
use boundCond
use ptNodes
use pretraitement
use derivedPSPLOT
use track
use segArc
use generTabSegArc
use generSAL
implicit none
integer NENTRY
integer IENTRY,JENTRY
type(c_ptr) KENTRY
character*12 HENTRY
dimension IENTRY(*),JENTRY(*),KENTRY(*),HENTRY(*)
integer,parameter :: dimTabCelluleBase = 20000
integer,parameter :: dimTabSegArc = 100000
type(c_ptr) :: ipGeo,ipGeo_1
integer :: sizeB,sizeP,sizeSA,nbNode,nbCLP,nbFlux,nbMacro,ipSal,ipPs,ipAl, &
ipZa,indic,nitma,impx
character(len=12) :: text12
logical :: drawNod,drawMix,lmacro
real,dimension(2) :: zoomx,zoomy
integer,allocatable,dimension(:) :: gig,merg,imacro
integer,dimension(10) :: datain
real :: flott
double precision :: dflott
integer :: lgMaxGig=0
!
ipAl=-1 ! no Alamos file read
ipZa=-1 ! no PropertyMap file read
ipGeo_1=c_null_ptr ! no geometry read
if ((NENTRY == 2).and.(IENTRY(2) == 4)) then
!generating ps file from Salomon file
ipPs = FILUNIT(KENTRY(1)) ! output psfile
g_psp_isEpsFile = (index(HENTRY(1),'.eps')/=0) !is it an eps file ?
ipSal = FILUNIT(KENTRY(2)) ! input Salomon/Alamos file
! check argument types and permissions
if ((IENTRY(1) /= 4) .or. (JENTRY(1) /= 0)) &
call XABORT('G2S: a new file was expected for the postscript file')
if ((IENTRY(2) /= 4) .or. (JENTRY(2) /= 2)) &
call XABORT('G2S: expecting Salomon file in read-only mode')
else if ((NENTRY == 3).and.(IENTRY(3) == 4)) then
!generating Salomon and ps files from Alamos file
ipSal = FILUNIT(KENTRY(1)) ! output Salomon file
ipPs = FILUNIT(KENTRY(2)) ! output psfile
ipAl = FILUNIT(KENTRY(3)) ! input Alamos file
g_psp_isEpsFile = (index(HENTRY(2),'.eps')/=0) !is it an eps file ?
! check argument types and permissions
if ((IENTRY(1) /= 4) .or. (JENTRY(1) /= 0)) &
call XABORT('G2S: a new file was expected for the Salomon file')
if ((IENTRY(2) /= 4) .or. (JENTRY(2) /= 0)) &
call XABORT('G2S: a new file was expected for the postscript file')
if ((IENTRY(3) /= 4) .or. (JENTRY(3) /= 2)) &
call XABORT('G2S: expecting Alamos file in read-only mode')
else if ((NENTRY == 4).and.(IENTRY(3) == 4).and.(IENTRY(4) == 4)) then
!generating Salomon and ps files from Alamos and PropertyMap file
ipSal = FILUNIT(KENTRY(1)) ! output Salomon file
ipPs = FILUNIT(KENTRY(2)) ! output psfile
ipAl = FILUNIT(KENTRY(3)) ! input Alamos file
ipZa = FILUNIT(KENTRY(4)) ! input PropertyMap file
g_psp_isEpsFile = (index(HENTRY(2),'.eps')/=0) !is it an eps file ?
! check argument types and permissions
if ((IENTRY(1) /= 4) .or. (JENTRY(1) /= 0)) &
call XABORT('G2S: a new file was expected for the Salomon file')
if ((IENTRY(2) /= 4) .or. (JENTRY(2) /= 0)) &
call XABORT('G2S: a new file was expected for the postscript file')
if ((IENTRY(3) /= 4) .or. (JENTRY(3) /= 2)) &
call XABORT('G2S: expecting Alamos file in read-only mode')
if ((IENTRY(4) /= 4) .or. (JENTRY(4) /= 2)) &
call XABORT('G2S: expecting PropertyMap file in read-only mode')
else if ((NENTRY == 2).and.(IENTRY(2) <= 2)) then
!generating Salomon file from LCM geometry
ipPs = -1 ! no postscript file
ipSal = FILUNIT(KENTRY(1)) ! output Salomon file
ipGeo_1= KENTRY(2) ! geometry read
! check argument types and permissions
if ((IENTRY(1) /= 4) .or. (JENTRY(1) /= 0)) &
call XABORT('G2S: a new ASCII file was expected for writing geometry')
if ((IENTRY(2) > 2) .or. (JENTRY(2) /= 2)) &
call XABORT('G2S: expecting LCM geometry in read-only mode(1)')
else if ((NENTRY == 3).and.(IENTRY(3) <= 2)) then
!generating Salomon file and ps file from LCM geometry
ipSal = FILUNIT(KENTRY(1)) ! output Salomon file
ipPs = FILUNIT(KENTRY(2)) ! output psfile
g_psp_isEpsFile = (index(HENTRY(2),'.eps')/=0) !is it an eps file ?
ipGeo_1= KENTRY(3) ! geometry read
! check argument types and permissions
if ((IENTRY(1) /= 4) .or. (JENTRY(1) /= 0)) &
call XABORT('G2S: a new file was expected for writing geometry')
if ((IENTRY(2) /= 4) .or. (JENTRY(2) /= 0)) &
call XABORT('G2S: a new file was expected for the postscript file')
if ((IENTRY(3) > 2) .or. (JENTRY(3) /= 2)) &
call XABORT('G2S: expecting LCM geometry in read-only mode(2)')
else
call XABORT('G2S: you must provide 2, 3 or 4 arguments')
end if
impx=1
drawNod = .false.
drawMix = .false.
zoomx = (/ 0.0, 1.0 /)
zoomy = (/ 0.0, 1.0 /)
typgeo=0
lmacro=.false.
10 call REDGET(indic,nitma,flott,text12,dflott)
if (indic == 10) go to 20
if (indic /= 3) call XABORT('G2S: character data expected.')
if (text12 == 'EDIT') then
! read the print index.
call REDGET(indic,impx,flott,text12,dflott)
if (indic /= 1) call XABORT('G2S: integer data expected(1).')
else if (text12 == 'DRAWNOD') then
drawNod=.true.
drawmix=.true.
else if (text12 == 'DRAWMIX') then
drawNod=.true.
drawmix=.false.
else if (text12 == 'ZOOMX') then
call REDGET(indic,nitma,zoomx(1),text12,dflott)
if (indic /= 2) call XABORT('G2S: real data expected(1).')
call REDGET(indic,nitma,zoomx(2),text12,dflott)
if (indic /= 2) call XABORT('G2S: real data expected(2).')
if ((zoomx(1).lt.0.0).or.(zoomx(2).le.zoomx(1)).or.(zoomx(2).gt.1.0)) then
call XABORT('G2S: invalid zoom factors in x.')
endif
else if (text12 == 'ZOOMY') then
call REDGET(indic,nitma,zoomy(1),text12,dflott)
if (indic /= 2) call XABORT('G2S: real data expected(3).')
call REDGET(indic,nitma,zoomy(2),text12,dflott)
if (indic /= 2) call XABORT('G2S: real data expected(4).')
if ((zoomy(1).lt.0.0).or.(zoomy(2).le.zoomy(1)).or.(zoomy(2).gt.1.0)) then
call XABORT('G2S: invalid zoom factors in y.')
endif
else if (text12 == 'ALAMOS') then
if (NENTRY == 2) call XABORT('G2S: three entries required.')
if (ipAl == -1) call XABORT('G2S: no RHS Salomon file.')
call REDGET(indic,typgeo,flott,text12,dflott)
if (indic /= 1) call XABORT('G2S: integer data expected(2).')
else if (text12 == 'MACRO') then
lmacro=.true.
else if (text12 == ';') then
go to 20
else
call XABORT('G2S: '//text12//' is an invalid keyword.')
end if
go to 10
!conversion of Alamos file into a Salomon file
20 if (ipAl /= -1) call g2s_convert(impx,ipAl,ipZa,ipSal)
sizeB = 0 !cellules de base
sizeP = 0 !cellules placees
sizeSA = 0 !elements geometriques
if (c_associated(ipGeo_1)) then
! copy the input geometric object
call lcmop(ipGeo,'geom_copy',0,1,0)
call lcmequ(ipGeo_1,ipGeo)
!initialisation des differents tableaux
call initializeData(dimTabCelluleBase,dimTabSegArc)
!unfold the geometry
call g2s_unfold(ipGeo,impx)
!pretraitement des donnees lues (remplace la partie python)
!+completion des cellules de base et remplissage du tableau
!des cellules placees
call prepareData(ipGeo,sizeB,sizeP,lgMaxGig)
if (impx > 0) write(*,*) 'fin : prepareData lgMaxGig=',lgMaxGig
!en sortie, toutes les cellules de base ont tous leurs
!champs remplis, et le tableau des cellules placees est pret
!eclatement des cellules
call splitCells(sizeP,sizeSA)
!creation de nouveaux segements aux interfaces des cellules
!et elimination des doublons
call addSegsAndClean(sizeSA)
!prise en compte des conditions aux limites
call appliBoundariConditions(ipGeo,sizeSA,nbCLP)
!calcul des nodes delimites par les elements
allocate(merg(dimTabCelluleBase),imacro(dimTabCelluleBase),stat=alloc_ok)
if (alloc_ok /= 0) call XABORT("G2S: g2s_g2s(1) => allocation pb(1)")
call createNodes(sizeSA,dimTabCelluleBase,lmacro,nbNode,merg,imacro)
if (sizeSA > dimTabSegArc) call XABORT('g2s_g2s: sizeSA overflow')
!calcul des arrays gig et merg
allocate(gig(nbNode*lgMaxGig),stat=alloc_ok)
if (alloc_ok /= 0) call XABORT("G2S: g2s_g2s(1) => allocation pb(2)")
call generateTrack(sizeP,sizeSA,nbNode,lgMaxGig,gig,merg)
nbFlux=maxval(merg(:nbNode))
nbMacro=maxval(imacro(:nbFlux))
else
if (JENTRY(NENTRY) == 0) call XABORT('G2S: a RHS ascii file is expected')
!initialisation de TabSegArc
call SALGET(datain,4,ipSal,0,'dimensions for geometry')
nbNode=datain(3)
sizeSA=datain(4)
rewind(ipSal)
allocate(TabSegArc(sizeSA),stat=alloc_ok)
if (alloc_ok /= 0) call XABORT("G2S: generateTabSegArc => allocation pb")
call initializebCData()
allocate(merg(nbNode),imacro(nbNode),stat=alloc_ok)
if (alloc_ok /= 0) call XABORT("G2S: g2s_g2s(2) => allocation pb")
call generateTabSegArc(ipSal,sizeSA,nbNode,nbCLP,nbFlux,merg,impx)
imacro(:nbFlux) = 1
nbMacro=1
endif
!impression des segArc charges
if (ipPs /= -1) call drawSegArc(ipPs,sizeSA,drawMix,drawNod,zoomx,zoomy)
if (c_associated(ipGeo_1)) then
!creation du fichier de commande SAL
call generateSALFile(ipSal,sizeSA,nbNode,nbCLP,nbFlux,nbMacro,merg,imacro)
deallocate(gig)
call LCMCL(ipGeo,2)
endif
deallocate(imacro,merg)
write(6,*) " At end of G2S:"
write(6,*) " ",sizeSA,"segs or arcs"
write(6,*) " ",nbNode,"nodes"
write(6,*) " ",nbFlux,"fluxes"
write(6,*) " ",nbMacro,"macros"
write(6,*) " ",nbCLP,"boundary conditions other than default"
!liberation de la memoire allouee
call destroyData(sizeB,sizeP)
end subroutine G2S
subroutine initializeData(dimTabCelluleBase,dimTabSegArc)
use celluleBase
use cellulePlaced
use boundCond
use segArc
implicit none
integer,intent(in) :: dimTabCelluleBase,dimTabSegArc
call initializeTabCelluleBase(dimTabCelluleBase)
call initializeTabCellulePlaced()
allocate(tabSegArc(dimTabSegArc))
call initializebCData()
end subroutine initializeData
subroutine destroyData(szB,szP)
use celluleBase
use cellulePlaced
use boundCond
use segArc
implicit none
integer,intent(in) :: szB,szP
! if (szB /= 0) call destroyTabCelluleBase(szB)
deallocate(tabSegArc)
if (szB /= 0) deallocate(TabCelluleBase)
if (szP /= 0) call destroyTabCellulePlaced(szP)
call destroybCData()
end subroutine destroyData
|
