Newer
Older
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
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ||===\\ |
! || \\ |
! || || //==\\ || || //==|| ||/==\\ |
! || || || || || || || || || || |
! || // || || || || || || || |
! ||===// \\==// \\==\\ \\==\\ || |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! SLICES Feb. 2008 |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
subroutine slices (params,osolve,ov,vo,sections,istep,iter,inner)
use definitions
implicit none
!------------------------------------------------------------------------------|
!(((((((((((((((( Purpose of the routine ))))))))))))))))))))))))))))))))))))))
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine arguments ))))))))))))))))))))
!------------------------------------------------------------------------------|
type(parameters) params
type(octreesolve) :: osolve
type(octreev) ov
type(void) vo
type(cross_section) :: sections(params%nsections)
integer istep,iter,inner
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine internal variables )))))))))))))
!------------------------------------------------------------------------------|
integer iproc,nproc,ierr
character(len=4) cistep,citer,cinner
character(len=2) cis
integer is
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
INCLUDE 'mpif.h'
call mpi_comm_size (mpi_comm_world,nproc,ierr)
call mpi_comm_rank (mpi_comm_world,iproc,ierr)
if (iproc.eq.0) then
call int_to_char(cistep,4,istep)
call int_to_char(citer, 4,iter)
call int_to_char(cinner,4,inner)
do is=1,params%nsections
call int_to_char(cis,2,is)
if (sections(is)%flag_spress) call xsc2(122,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_press) call xsc2(123,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_e2d) call xsc2(124,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_crit) call xsc2(125,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_grid) call xsc2(126,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_u) call xsc2(127,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_v) call xsc2(128,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_w) call xsc2(129,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_uvw) call xsc2(130,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_e3d) call xsc2(131,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_lode) call xsc2(132,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_mu) call xsc2(133,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_plastic) call xsc2(134,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_velvect) call xsc2(137,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_strain) call xsc2(138,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
! if (sections(is)%flag_lsf) call xsc2(140,osolve,ov,cis,cistep,citer,cinner,sections(is))
if (sections(is)%flag_temp) call xsc2(139,osolve,ov,vo,cis,cistep,citer,cinner,sections(is))
end do
end if
return
end subroutine slices
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! XSC Feb. 2008 |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
subroutine xsc2 (iunit,osolve,ov,vo,cis,cistep,citer,cinner,section)
use colormaps
use definitions
implicit none
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine arguments ))))))))))))))))))))
!------------------------------------------------------------------------------|
integer iunit
type(octreesolve) :: osolve
type (octreev) ov
character(len=4) :: cistep,citer,cinner
character(len=2) :: cis
type(cross_section) :: section
type(void) vo
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine internal variables )))))))))))))
!------------------------------------------------------------------------------|
character(len=2) :: xx
character(len=3) :: charac
character(len=11) :: charac11
integer istat,pgopen,ic
integer ie,leaf,level,loc,ilsf
integer counter,nlsf,nleaves
integer node1,node2,node3,node4,node5,node6,node7,node8
real alpha_pos,beta_pos,dxyzr,red,green,blue,ncolours_r
real valpha1,vbeta1,valpha2,vbeta2,valpha3,vbeta3,valpha4,vbeta4
logical flag_cm,flag_text
double precision r1,r2,value
double precision minfield,maxfield,rannge
double precision x,y,z,u,v,w,x0,y0,z0,dxyz
double precision alpha_min,alpha_max,beta_min,beta_max
double precision,dimension(:),allocatable :: field
double precision f1,f2,f3,f4,ff
double precision, dimension(:,:), allocatable :: alpha_lsf,beta_lsf
logical, dimension(:), allocatable :: lilflag
!-------------------------------------------------------------------------------
!------------------------------------------------------------------------------|
flag_cm = .true. !toggles on/off the colormap on the side
flag_text = .true. !toggles on/off the text above the xsc
! select case (section%xyz)
! case (1)
!alpha_min=0. !zoom coordinates
!alpha_max=1. !zoom coordinates
!beta_min=0. !zoom coordinates
!beta_max=1. !zoom coordinates
! case (2)
!alpha_min=0.3 !zoom coordinates
!alpha_max=.7 !zoom coordinates
!beta_min=0. !zoom coordinates
!beta_max=0.126 !zoom coordinates
! case (3)
!alpha_min=0.3 !zoom coordinates
!alpha_max=0.7 !zoom coordinates
!beta_min=0. !zoom coordinates
!beta_max=.4 !zoom coordinates
! end select
nleaves=osolve%nleaves
nlsf=osolve%nlsf
ncolours_r=real(section%ncolours)
allocate(field(nleaves))
allocate(alpha_lsf(2,nlsf),beta_lsf(2,nlsf))
allocate(lilflag(nlsf))
!******************************************************************************
!******************************************************************************
select case (iunit)
!****************************************************************************
case(122) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'spressure'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 122'
field=osolve%spressure
!****************************************************************************
case(123) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'pressure'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 123'
field=osolve%pressure
!****************************************************************************
case(124) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'e2d'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 124'
open(unit=1234,file='./XSC/section_'//cis//'_'//'e2d'//'_'//cistep//'_'//citer//'_'//cinner//'.dat',status='replace')
field=osolve%e2d
!****************************************************************************
case(125) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'crit'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 125'
field=osolve%crit
!****************************************************************************
case(126) !***************************************************************
!****************************************************************************
istat=pgopen('XSC/section_'//cis//'_'//'grid'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 126'
!****************************************************************************
case(127) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'u'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 127'
do ie=1,osolve%nleaves
field(ie)=sum(ov%unode(osolve%icon(1:8,ie)))*0.125d0
end do
open(unit=1236,file='./XSC/section_'//cis//'_'//'u'//'_'//cistep//'_'//citer//'_'//cinner//'.dat',status='replace')
!****************************************************************************
case(128) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'v'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 128'
do ie=1,osolve%nleaves
field(ie)=sum(ov%vnode(osolve%icon(1:8,ie)))*0.125d0
end do
open(unit=1237,file='./XSC/section_'//cis//'_'//'v'//'_'//cistep//'_'//citer//'_'//cinner//'.dat',status='replace')
!****************************************************************************
case(129) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'w'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 129'
do ie=1,osolve%nleaves
field(ie)=sum(ov%wnode(osolve%icon(1:8,ie)))*0.125d0
end do
open(unit=1238,file='./XSC/section_'//cis//'_'//'w'//'_'//cistep//'_'//citer//'_'//cinner//'.dat',status='replace')
!****************************************************************************
case(130) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'uvw'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 130'
do ie=1,osolve%nleaves
u=sum(osolve%u(osolve%icon(1:8,ie)))*0.125d0
v=sum(osolve%v(osolve%icon(1:8,ie)))*0.125d0
w=sum(osolve%w(osolve%icon(1:8,ie)))*0.125d0
field(ie)=sqrt(u**2+v**2+w**2)
end do
!****************************************************************************
case(131) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'e3d'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 131'
field=osolve%e3d
!****************************************************************************
case(132) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'lode'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 132'
field=osolve%lode
!****************************************************************************
case(133) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'mu'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos'
open(unit=1235,file='./XSC/section_'//cis//'_'//'mu'//'_'//cistep//'_'//citer//'_'//cinner//'.dat',status='replace')
field=osolve%eviscosity
!****************************************************************************
case(134) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'plastic'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos'
!****************************************************************************
case(137) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'velvect'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 137'
do ie=1,osolve%nleaves
u=sum(osolve%u(osolve%icon(1:8,ie)))*0.125d0
v=sum(osolve%v(osolve%icon(1:8,ie)))*0.125d0
w=sum(osolve%w(osolve%icon(1:8,ie)))*0.125d0
field(ie)=sqrt(u**2+v**2+w**2)
end do
!****************************************************************************
case(138) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'strain'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 138'
open(unit=1239,file='./XSC/section_'//cis//'_'//'strain'//'_'//cistep//'_'//citer//'_'//cinner//'.dat',status='replace')
do ie=1,osolve%nleaves
field(ie)=sum(osolve%strain(osolve%icon(1:8,ie)))*0.125d0
end do
!****************************************************************************
case(139) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'temp'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos 139'
do ie=1,osolve%nleaves
field(ie)=sum(ov%temp(osolve%icon(1:8,ie)))*0.125d0
end do
!****************************************************************************
case(140) !***************************************************************
!****************************************************************************
istat=pgopen('./XSC/section_'//cis//'_'//'lsf'//'_'//cistep//'_'//citer//'_'//cinner//'.ps/VCPS')
if (istat .le.0) stop 'pb snapshot pos'
end select
!******************************************************************************
!******************************************************************************
minfield=minval(field)
maxfield=maxval(field)
rannge=maxfield-minfield ; if (rannge.lt.1.d-8) rannge=1.d0
CALL PGBBUF ! begin batch of output
CALL PGSAVE ! save pgplot attributes
CALL PGSCH(0.5) ! set character height
CALL PGPAGE ! advance to new page
CALL PGSFS (2) ! set fill style : outline
CALL PGENV(-0.1,1.28,-.1,1.1,1,-1) ! set window and viewport
CALL PGRECT(0.,1.,0.,1.) ! draw unit square
CALL PGSLW (1) ! set line width
CALL PGSCH (0.1) ! set size arrow head
counter=0
do ie=1,osolve%nleaves ! loop on all leaves
! if (vo%leaf(ie).eq.0) then
!****************************************************************************
!****************************************************************************
select case (section%xyz)
!*************************************************************************
case (1) !************************************************************
!*************************************************************************
r1=osolve%x(osolve%icon(1,ie))
r2=osolve%x(osolve%icon(8,ie))
!*************************************************************************
case (2) !************************************************************
!*************************************************************************
r1=osolve%y(osolve%icon(1,ie))
r2=osolve%y(osolve%icon(8,ie))
!*************************************************************************
case (3) !************************************************************
!*************************************************************************
r1=osolve%z(osolve%icon(1,ie))
r2=osolve%z(osolve%icon(8,ie))
end select
!****************************************************************************
!****************************************************************************
if (r1.le. section%slice .and. section%slice.le.r2) then ! testing if leaf is cut by slice
counter=counter+1
node1=osolve%icon(1,ie)
node2=osolve%icon(2,ie)
node3=osolve%icon(3,ie)
node4=osolve%icon(4,ie)
node5=osolve%icon(5,ie)
node6=osolve%icon(6,ie)
node7=osolve%icon(7,ie)
node8=osolve%icon(8,ie)
x=0.5d0*(osolve%x(node1)+osolve%x(node8)) !
y=0.5d0*(osolve%y(node1)+osolve%y(node8)) ! center of leaf
z=0.5d0*(osolve%z(node1)+osolve%z(node8)) !
u=0.125d0*(osolve%u(node1)+osolve%u(node2)+osolve%u(node3)+osolve%u(node4) &!
+osolve%u(node5)+osolve%u(node6)+osolve%u(node7)+osolve%u(node8)) !
v=0.125d0*(osolve%v(node1)+osolve%v(node2)+osolve%v(node3)+osolve%v(node4) & !
+osolve%v(node5)+osolve%v(node6)+osolve%v(node7)+osolve%v(node8)) ! average velocity
w=0.125d0*(osolve%w(node1)+osolve%w(node2)+osolve%w(node3)+osolve%w(node4) & !
+osolve%w(node5)+osolve%w(node6)+osolve%w(node7)+osolve%w(node8)) !
call octree_find_leaf (osolve%octree,osolve%noctree,x,y,z,leaf,level,loc,x0,y0,z0,dxyz)
dxyzr=real(dxyz) ! size of leaf
!*************************************************************************
!*************************************************************************
select case (section%xyz)
!**********************************************************************
case (1) !*********************************************************
!**********************************************************************
xx='x='
alpha_pos = y0
beta_pos = z0
!**********************************************************************
case (2) !*********************************************************
!**********************************************************************
xx='y='
alpha_pos = x0
beta_pos = z0
!**********************************************************************
case (3) !*********************************************************
!**********************************************************************
xx='z='
alpha_pos = x0
beta_pos = y0
end select
!*************************************************************************
!*************************************************************************
!ZOOM
!if ((alpha_pos+dxyz/2.d0< alpha_max) .and. (alpha_pos+dxyz/2.d0 > alpha_min) .and. ((beta_pos+dxyz/2.d0)<beta_max) .and. ((beta_pos+dxyz/2.d0)>beta_min)) then
!ZOOM
!*************************************************************************
!*************************************************************************
select case (iunit)
!**********************************************************************
case (122,123,124,125,127,128,129,130,131,132,133,138,139) !*********
!**********************************************************************
value=(field(ie)-minfield)/rannge ! value between 0 and 1
ic=nint(value*(section%ncolours-1))+1 ! colour index
if (ic<=0 .or. ic>section%ncolours) stop 'pb_c in slices'
red=red_jet(ic,section%ncolours)
green=green_jet(ic,section%ncolours)
blue=blue_jet(ic,section%ncolours)
CALL PGSCR (2,red,green,blue) ! redefine colour number 2
CALL PGSCI (2) ! use colour number 2
CALL PGSFS (1) ! filled
CALL PGRECT(alpha_pos,alpha_pos+dxyzr,beta_pos,beta_pos+dxyzr) ! draw leaf
if(iunit==124) &
write(1234,'(4f30.15)') x,y,z,field(ie)
if(iunit==133) &
write(1235,'(4f30.15)') x,y,z,field(ie)
if(iunit==127) &
write(1236,'(4f30.15)') x,y,z,field(ie)
if(iunit==128) &
write(1237,'(4f30.15)') x,y,z,field(ie)
if(iunit==129) &
write(1238,'(4f30.15)') x,y,z,field(ie)
if(iunit==138) &
write(1239,'(4f30.15)') x,y,z,field(ie)
!**********************************************************************
case (126) !*******************************************************
!**********************************************************************
CALL PGSCI (15)
CALL PGRECT(alpha_pos,alpha_pos+dxyzr,beta_pos,beta_pos+dxyzr) ! draw leaf
!**********************************************************************
case (134) !*******************************************************
!**********************************************************************
CALL PGSCI (15)
if (osolve%is_plastic(ie)) then
CALL PGSFS (1) ! filled
else
CALL PGSFS (2) ! outline
end if
CALL PGRECT(alpha_pos,alpha_pos+dxyzr,beta_pos,beta_pos+dxyzr) ! draw leaf
!**********************************************************************
case (137)
!**********************************************************************
CALL PGSCI (15)
CALL PGRECT(alpha_pos,alpha_pos+dxyzr,beta_pos,beta_pos+dxyzr) ! draw leaf
select case (section%xyz)
!*******************************************************************
case (1) !******************************************************
!*******************************************************************
valpha1=( (section%slice-osolve%x(node1)) * ov%vnode(node1) + (osolve%x(node2)-section%slice) * ov%vnode(node2) )/maxfield
valpha2=( (section%slice-osolve%x(node3)) * ov%vnode(node3) + (osolve%x(node4)-section%slice) * ov%vnode(node4) )/maxfield
valpha3=( (section%slice-osolve%x(node5)) * ov%vnode(node5) + (osolve%x(node6)-section%slice) * ov%vnode(node6) )/maxfield
valpha4=( (section%slice-osolve%x(node7)) * ov%vnode(node7) + (osolve%x(node8)-section%slice) * ov%vnode(node7) )/maxfield
vbeta1 =( (section%slice-osolve%x(node1)) * ov%wnode(node1) + (osolve%x(node2)-section%slice) * ov%wnode(node2) )/maxfield
vbeta2 =( (section%slice-osolve%x(node3)) * ov%wnode(node3) + (osolve%x(node4)-section%slice) * ov%wnode(node4) )/maxfield
vbeta3 =( (section%slice-osolve%x(node5)) * ov%wnode(node5) + (osolve%x(node6)-section%slice) * ov%wnode(node6) )/maxfield
vbeta4 =( (section%slice-osolve%x(node7)) * ov%wnode(node7) + (osolve%x(node8)-section%slice) * ov%wnode(node8) )/maxfield
!*******************************************************************
case (2) !******************************************************
!*******************************************************************
valpha1=( (section%slice-osolve%y(node1)) * ov%unode(node1) + (osolve%y(node3)-section%slice) * ov%unode(node3) )/maxfield
valpha2=( (section%slice-osolve%y(node2)) * ov%unode(node2) + (osolve%y(node4)-section%slice) * ov%unode(node4) )/maxfield
valpha3=( (section%slice-osolve%y(node5)) * ov%unode(node5) + (osolve%y(node7)-section%slice) * ov%unode(node7) )/maxfield
valpha4=( (section%slice-osolve%y(node6)) * ov%unode(node6) + (osolve%y(node8)-section%slice) * ov%unode(node8) )/maxfield
vbeta1 =( (section%slice-osolve%y(node1)) * ov%wnode(node1) + (osolve%y(node3)-section%slice) * ov%wnode(node3) )/maxfield
vbeta2 =( (section%slice-osolve%y(node2)) * ov%wnode(node2) + (osolve%y(node4)-section%slice) * ov%wnode(node4) )/maxfield
vbeta3 =( (section%slice-osolve%y(node5)) * ov%wnode(node5) + (osolve%y(node7)-section%slice) * ov%wnode(node7) )/maxfield
vbeta4 =( (section%slice-osolve%y(node6)) * ov%wnode(node6) + (osolve%y(node8)-section%slice) * ov%wnode(node8) )/maxfield
!*******************************************************************
case (3) !******************************************************
!*******************************************************************
valpha1=( (section%slice-osolve%z(node1)) * ov%unode(node1) + (osolve%z(node5)-section%slice) * ov%unode(node5) )/maxfield
valpha2=( (section%slice-osolve%z(node2)) * ov%unode(node2) + (osolve%z(node6)-section%slice) * ov%unode(node6) )/maxfield
valpha3=( (section%slice-osolve%z(node3)) * ov%unode(node3) + (osolve%z(node7)-section%slice) * ov%unode(node7) )/maxfield
valpha4=( (section%slice-osolve%z(node4)) * ov%unode(node4) + (osolve%z(node8)-section%slice) * ov%unode(node8) )/maxfield
vbeta1 =( (section%slice-osolve%z(node1)) * ov%vnode(node1) + (osolve%z(node5)-section%slice) * ov%vnode(node5) )/maxfield
vbeta2 =( (section%slice-osolve%z(node2)) * ov%vnode(node2) + (osolve%z(node6)-section%slice) * ov%vnode(node6) )/maxfield
vbeta3 =( (section%slice-osolve%z(node3)) * ov%vnode(node3) + (osolve%z(node7)-section%slice) * ov%vnode(node7) )/maxfield
vbeta4 =( (section%slice-osolve%z(node4)) * ov%vnode(node4) + (osolve%z(node8)-section%slice) * ov%vnode(node8) )/maxfield
end select
CALL PGSCI (1)
CALL PGARRO (alpha_pos,beta_pos,alpha_pos+valpha1,beta_pos+vbeta1)
if(abs(alpha_pos+dxyz-1.d0)<1.d-5) &
CALL PGARRO (alpha_pos,beta_pos,alpha_pos+valpha2,beta_pos+vbeta2)
if(abs(beta_pos+dxyz-1.d0) <1.d-5) &
CALL PGARRO (alpha_pos,beta_pos,alpha_pos+valpha3,beta_pos+vbeta3)
if(abs(beta_pos+dxyz-1.d0) <1.d-5 .and. abs(alpha_pos+dxyz-1.d0)<1.d-5) &
CALL PGARRO (alpha_pos,beta_pos,alpha_pos+valpha4,beta_pos+vbeta4)
!**********************************************************************
case (140)
!**********************************************************************
CALL PGSCI (15)
CALL PGRECT(alpha_pos,alpha_pos+dxyzr,beta_pos,beta_pos+dxyzr) ! draw leaf
select case (section%xyz)
!****************************************************************
case (1) !***************************************************
!****************************************************************
do ilsf=1,nlsf
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
section%slice,y0 ,z0 ,f1)
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
section%slice,y0+dxyz,z0 ,f2)
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
section%slice,y0 ,z0+dxyz,f3)
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
section%slice,y0+dxyz,z0+dxyz,f4)
!call find_lsf_points (section%xyz,osolve,alpha_lsf(:,ilsf),beta_lsf(:,ilsf),ilsf,f1,f2,f3,f4,section%slice,x0,y0,z0,dxyz,lilflag(ilsf))
end do
!****************************************************************
case (2) !***************************************************
!****************************************************************
do ilsf=1,nlsf
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,osolve%nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
x0 ,section%slice,z0 ,f1)
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,osolve%nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
x0+dxyz,section%slice,z0 ,f2)
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,osolve%nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
x0 ,section%slice,z0+dxyz,f3)
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,osolve%nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
x0+dxyz,section%slice,z0+dxyz,f4)
!call find_lsf_points (section%xyz,osolve,alpha_lsf(:,ilsf),beta_lsf(:,ilsf),ilsf,f1,f2,f3,f4,section%slice,x0,y0,z0,dxyz,lilflag(ilsf))
end do
!****************************************************************
case (3) !***************************************************
!****************************************************************
do ilsf=1,nlsf
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,osolve%nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
x0 ,y0 ,section%slice,f1)
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,osolve%nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
x0+dxyz,y0 ,section%slice,f2)
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,osolve%nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
x0 ,y0+dxyz,section%slice,f3)
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon,osolve%nleaves,osolve%lsf(:,ilsf),osolve%nnode,&
x0+dxyz,y0+dxyz,section%slice,f4)
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
!call find_lsf_points (section%xyz,osolve,alpha_lsf(:,ilsf),beta_lsf(:,ilsf),ilsf,f1,f2,f3,f4,section%slice,x0,y0,z0,dxyz,lilflag(ilsf))
end do
end select
! do ilsf=1,nlsf
! if(lilflag(ilsf)) call write_segment (iunit,alpha_lsf(1,ilsf),alpha_lsf(2,ilsf),alpha_offset,beta_lsf(1,ilsf),beta_lsf(2,ilsf),beta_offset)
! end do
end select
!*************************************************************************
!*************************************************************************
!ZOOM
! end if
!ZOOM
end if
! end if !void test
end do
!*******************************************************************************
!*******************************************************************************
select case (iunit)
case (122,123,124,125,127,128,129,130,131,132,133,138,139)
if (flag_cm) then
CALL PGSFS (1) ! filled
do ic=1,section%ncolours
red=red_jet(ic,section%ncolours)
green=green_jet(ic,section%ncolours)
blue=blue_jet(ic,section%ncolours)
CALL PGSCR (2,red,green,blue) ! redefine colour number 2
CALL PGSCI (2) ! use colour number 2
CALL PGRECT(1.1,1.15,real(ic-1)/ncolours_r,real(ic)/ncolours_r) ! draw leaf
end do
CALL PGSCI (1) ! use colour number 1
CALL PGSCH (0.65) ! set character height
write (charac11,'(es11.4)') minfield
CALL PGPTXT (1.125,-0.03,0.0,0.5,charac11)
write (charac11,'(es11.4)') maxfield
CALL PGPTXT (1.125,1.01,0.0,0.5,charac11)
end if
end select
!*******************************************************************************
!*******************************************************************************
if (flag_text) then
CALL PGSCI (1) ! use colour number 1
CALL PGSCH (0.65) ! set character height
ic=int(section%slice*1000)
call int_to_char(charac,3,ic)
CALL PGPTXT (0.0,1.01,0.0,0.0,xx//'0.'//charac)
CALL PGPTXT (0.5,1.01,0.0,0.0,'istep='//cistep//' iter='//citer//' inner='//cinner)
end if
deallocate(alpha_lsf,beta_lsf)
deallocate(field)
deallocate(lilflag)
CALL PGUNSA
CALL PGEBUF
CALL PGCLOS
close(1234)
close(1235)
close(1236)
close(1237)
close(1238)
close(1239)
return
end subroutine xsc2