43 . WIGE ,LSUBMODEL, IS_DYNA)
70 USE format_mod ,
ONLY : fmt_i_3f
71 USE user_id_mod ,
ONLY : id_limit
72 USE sph_mod,
ONLY : xi_res, yi_res, zi_res
76#include "implicit_f.inc"
81 INTEGER,
INTENT(IN) :: IS_DYNA
82 TYPE (UNIT_TYPE_),
INTENT(IN) ::UNITAB
85 INTEGER,
INTENT(OUT)::ITAB(*)
86 INTEGER,
INTENT(OUT)::ITABM1(*)
102#include "remesh_c.inc"
107 INTEGER :: NUMNUSR,NUMNUSR1,NUMNAUX,KSPHRES,NUMNUSR2
108 INTEGER :: UID, IFLAGUNIT, ID
109 my_real :: x1,x2,x3,xmin,ymin,zmin,xmax,
ymax,zmax,fac_l,w
110 CHARACTER(LEN=NCHARLINE) :: LLINE
111 INTEGER,
DIMENSION(:),
ALLOCATABLE :: SUB_NOD,UID_NOD,ITAB_TMP,ITABM1_TMP
112 real*8,
DIMENSION(:,:),
ALLOCATABLE :: hm_x
113 my_real,
DIMENSION(:,:),
ALLOCATABLE :: x_tmp
114 LOGICAL :: IS_AVAILABLE
115 real*8,
DIMENSION(:),
ALLOCATABLE :: dmerge
132 CALL cpp_nodes_count(numnusr1,numnusr2)
133 ALLOCATE (sub_nod(numnusr1),stat=stat)
134 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'SUB_NOD')
135 ALLOCATE (uid_nod(numnusr1),stat=stat)
136 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'UID_NOD')
137 ALLOCATE (hm_x(3,numnusr1),stat=stat)
138 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'HM_X')
139 ALLOCATE (dmerge(numnusr2),stat=stat)
140 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'DMERGE')
141 sub_nod(1:numnusr1) = 0
142 uid_nod(1:numnusr1) = 0
143 hm_x(1:3,1:numnusr1) = 0
144 dmerge(1:numnusr2) = zero
151 CALL cpp_node_read(itab,hm_x,w,sub_nod,uid_nod)
165 IF(sub_nod(n) /= 0)
THEN
166 IF(uid_nod(n) == 0 .AND. lsubmodel(sub_nod(n))%UID /= 0) uid_nod(n) = lsubmodel(sub_nod(n))%UID
171 IF(uid_nod(n) /= uid )
THEN
175 IF (unitab%UNIT_ID(j) == uid)
THEN
176 fac_l = unitab%FAC_L(j)
181 IF (uid/=0 .AND. iflagunit==0)
THEN
182 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1=
'/NODE')
185 x(1,n) = x(1,n)*fac_l
186 x(2,n) = x(2,n)*fac_l
187 x(3,n) = x(3,n)*fac_l
189 IF(numelig3d > 0) wige(n) = w
190 xmin=
min(xmin,x(1,n))
191 ymin=
min(ymin,x(2,n))
192 zmin=
min(zmin,x(3,n))
193 xmax=
max(xmax,x(1,n))
195 zmax=
max(zmax,x(3,n))
200 ALLOCATE (itab_tmp(numnusr1),stat=stat)
201 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'ITAB_TMP'
202 ALLOCATE (itabm1_tmp(2*numnusr1),stat=stat)
203 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'ITABM1_TMP')
204 ALLOCATE (x_tmp(3,numnusr1),stat=stat)
205 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'X_TMP')
210 CALL cpp_node_read(itab_tmp,hm_x,w,sub_nod,uid_nod)
218 x_tmp(1,n) = hm_x(1,n)
219 x_tmp(2,n) = hm_x(2,n)
220 x_tmp(3,n) = hm_x(3,n)
224 IF(sub_nod(n) /= 0)
THEN
225 IF(uid_nod(n) == 0 .AND. lsubmodel(sub_nod(n))%UID /= 0)
226 . uid_nod(n) = lsubmodel(sub_nod(n))%UID
231 IF(uid_nod(n) /= uid )
THEN
235 IF (unitab%UNIT_ID(j) == uid)
THEN
236 fac_l = unitab%FAC_L(j)
241 IF (uid/=0 .AND. iflagunit==0)
THEN
242 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror
'/NODE')
245 x_tmp(1,n) = x_tmp(1,n)*fac_l
246 x_tmp(2,n) = x_tmp(2,n)*fac_l
247 x_tmp(3,n) = x_tmp(3,n)*fac_l
249 IF(numelig3d > 0) wige(n) = w
250 xmin=
min(xmin,x_tmp(1,n))
251 ymin=
min(ymin,x_tmp(2,n))
252 zmin=
min(zmin,x_tmp(3,n))
253 xmax=
max(xmax,x_tmp(1,n))
255 zmax=
max(zmax,x_tmp(3,n))
260 CALL constit(itab_tmp,itabm1_tmp,numnusr1)
264 itab(1) = itabm1_tmp(1)
265 x(1:3,1) = x_tmp(1:3,itabm1_tmp(numnusr1+1))
267 IF(itabm1_tmp(numnusr1+i) == itabm1_tmp(numnusr1+i-1)) cycle
268 numnaux = numnaux + 1
269 itab(numnaux) = itabm1_tmp(i)
270 x(1:3,numnaux) = x_tmp(1:3,itabm1_tmp(numnusr1+i))
274 IF(
ALLOCATED(itab_tmp))
DEALLOCATE(itab_tmp)
275 IF(
ALLOCATED(itabm1_tmp))
DEALLOCATE(itabm1_tmp)
276 IF(
ALLOCATED(x_tmp))
DEALLOCATE(x_tmp)
279 IF(
ALLOCATED(sub_nod))
DEALLOCATE(sub_nod)
280 IF(
ALLOCATED(uid_nod))
DEALLOCATE(uid_nod)
281 IF(
ALLOCATED(hm_x))
DEALLOCATE(hm_x)
286 IF(numnusr2 /= 0)
THEN
287 ALLOCATE (itab_tmp(numnusr2),stat=stat)
288 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'ITAB_TMP')
289 ALLOCATE (sub_nod(numnusr2),stat=stat)
290 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror
'SUB_NOD'
291 ALLOCATE (uid_nod(numnusr2),stat=stat)
292 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'UID_NOD')
293 ALLOCATE (hm_x(3,numnusr2),stat=stat)
294 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'HM_X')
296 itab_tmp(1:numnusr2) = 0
297 sub_nod(1:numnusr2) = 0
298 uid_nod(1:numnusr2) = 0
299 hm_x(1:3,1:numnusr2) = zero
301 CALL cpp_cnode_read(itab_tmp,hm_x,dmerge,sub_nod,uid_nod)
308 IF(sub_nod(i) /= 0)
THEN
309 IF(uid_nod(i) == 0 .AND. lsubmodel(sub_nod(i))%UID /= 0)
310 . uid_nod(i) = lsubmodel(sub_nod(i))%UID
312 itab(n) = itab_tmp(i)
316 IF(uid_nod(i) /= uid )
THEN
320 IF (unitab%UNIT_ID(j) == uid)
THEN
321 fac_l = unitab%FAC_L(j)
326 IF (uid/=0 .AND. iflagunit==0)
THEN
327 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1=
'/CNODE')
330 x(1,n) = hm_x(1,i)*fac_l
331 x(2,n) = hm_x(2,i)*fac_l
332 x(3,n) = hm_x(3,i)*fac_l
333 cmerge(i) = dmerge(i) * fac_l
334 xmin=
min(xmin,x(1,n))
335 ymin=
min(ymin,x(2,n))
336 zmin=
min(zmin,x(3,n))
337 xmax=
max(xmax,x(1,n))
339 zmax=
max(zmax,x(3,n))
341 IF(
ALLOCATED(itab_tmp))
DEALLOCATE(itab_tmp)
342 IF(
ALLOCATED(sub_nod))
DEALLOCATE(sub_nod)
343 IF(
ALLOCATED(uid_nod))
DEALLOCATE(uid_nod)
344 IF(
ALLOCATED(hm_x))
DEALLOCATE(hm_x)
351 x1=xmin-fourth*(xmax-xmin)
352 x2=ymin-fourth*(
ymax-ymin)
353 x3=zmin-fourth*(zmax-zmin)
364 CALL hm_get_intv(
'Np',ksphres,is_available,lsubmodel)
368 itab(i)=id_limit%ADMESH_LT_NODE_AUTO
369 id_limit%ADMESH_LT_NODE_AUTO=id_limit%ADMESH_LT_NODE_AUTO+1
380 itab(i)=id_limit%ADMESH_LT_NODE_AUTO
381 id_limit%ADMESH_LT_NODE_AUTO=id_limit%ADMESH_LT_NODE_AUTO+1
389 IF(numnod-numnod0>100000000)
THEN
394 DO n=numnod0+1,numnod
395 itab(n)=id_limit%ADMESH+n-numnod0-numcnod
402 IF(nadigemesh/=0)
THEN
403 IF(numnod-numnodige0>100000000)
THEN
408 DO n=numnodige0+1,numnod
409 itab(n)=id_limit%ADMESH+n-numnodige0
414 id_limit%ADMESH_LT_NODE_AUTO=id_limit%ADMESH_LT_NODE_AUTO+1
417 CALL constit(itab,itabm1,numnod)
427 IF (isigi==3.OR.isigi==4.OR.isigi==5)
THEN
429 120
READ(iin4,fmt=
'(A)',
END=199,ERR=199)lline
430 IF(lline(1:33)/=
'/NODAL /VECTOR /COORDINATE')
GOTO 120
431 READ(iin4,fmt=
'(A)',
END=199,ERR=199)lline
433 IF (ioutp_fmt==2)
THEN
434 125
READ(iin4,fmt=
'(A)',
END=130,ERR=199)lline
435 IF(lline(1:1)==
'#')
GOTO 125
436 IF(lline(1:1)==
'/')
GOTO 130
437 READ(lline,
'(I8,3F16.0)')n,x1,x2,x3
446 126
READ(iin4,fmt=
'(A)',
END=130,ERR=199)lline
447 IF(lline(1:1)==
'#')
GOTO 126
448 IF(lline(1:1)==
'/')
GOTO 130
449 READ(lline,fmt=fmt_i_3f) n,x1,x2,x3
470 WRITE(iout,
'(//A/A//A/)')titre(70),titre(71),titre
472 WRITE(iout,
'(5X,I10,8X,1P3G20.13)')itab(i),x(1,i),x(2,i),x(3,i)
476 DO n=numnusr1+1,numnusr,50
479 WRITE(iout,
'(A)')titre(117)
481 WRITE(iout,
'(5X,I10,8X,1P3G20.13)')itab(i),x(1,i),x(2,i),x(3,i)
487 IF(numnod > numnusr)
THEN
488 DO n=numnusr+1,numnod,50
491 WRITE(iout,
'(//A)')
' COORDINATES OF NODES FOR SPH RESERVES'
492 WRITE(iout,
'(A)')
' -------------------------------------'
493 WRITE(iout,
'(A/)')titre(72)
495 WRITE(iout,
'(5X,I10,8X,1P3G20.13)') itab(i),x(1,i),x(2,i),x(3,i)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)