42 . WIGE ,LSUBMODEL, IS_DYNA)
70 USE format_mod ,
ONLY : fmt_i_3f
71 USE user_id_mod ,
ONLY : id_limit
75#include "implicit_f.inc"
80 INTEGER,
INTENT(IN) :: IS_DYNA
81 TYPE (UNIT_TYPE_),
INTENT(IN) ::UNITAB
84 INTEGER,
INTENT(OUT)::ITAB(*)
85 INTEGER,
INTENT(OUT)::ITABM1(*)
101#include "remesh_c.inc"
105 INTEGER N,M,I,J,J1,NN, IOUTN, IERROR, STAT
106 INTEGER NUMNUSR,NUMNUSR1,NUMNAUX,KSPHRES,NUMNUSR2
107 INTEGER CHID, CNT1, CNT2, UID, IFLAGUNIT, ID
108 INTEGER FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP
109 my_real x1,x2,x3,xmin,ymin,zmin,xmax,
ymax,zmax,fac_l,w
110 CHARACTER(LEN=NCHARLINE) :: LLINE
111 CHARACTER(LEN=NCHARFIELD) :: MOT1, KEY
112 INTEGER,
DIMENSION(:),
ALLOCATABLE :: SUB_NOD,UID_NOD,ITAB_TMP,ITABM1_TMP
113 real*8,
DIMENSION(:,:),
ALLOCATABLE :: hm_x
114 my_real,
DIMENSION(:,:),
ALLOCATABLE :: x_tmp
116 real*8,
DIMENSION(:),
ALLOCATABLE :: dmerge
133 CALL cpp_nodes_count(numnusr1,numnusr2)
134 ALLOCATE (sub_nod(numnusr1),stat=stat)
135 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1
'SUB_NOD'
136 ALLOCATE (uid_nod(numnusr1),stat=stat)
137 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'UID_NOD'
138 ALLOCATE (hm_x(3,numnusr1),stat=stat)
139 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'HM_X')
140 ALLOCATE (dmerge(numnusr2),stat=stat)
141 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'DMERGE')
143 uid_nod(1:numnusr1) = 0
144 hm_x(1:3,1:numnusr1) = 0
145 dmerge(1:numnusr2) = zero
152 CALL cpp_node_read(itab,hm_x,w
166 IF(sub_nod(n) /= 0)
THEN
167 IF(uid_nod(n) == 0 .AND. lsubmodel(sub_nod(n))%UID /= 0) uid_nod(n) = lsubmodel(sub_nod(n))%UID
172 IF(uid_nod(n) /= uid )
THEN
176 IF (unitab%UNIT_ID(j) == uid)
THEN
177 fac_l = unitab%FAC_L(j)
182 IF (uid/=0 .AND. iflagunit==0)
THEN
183 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1=
'/NODE')
186 x(1,n) = x(1,n)*fac_l
187 x(2,n) = x(2,n)*fac_l
188 x(3,n) = x(3,n)*fac_l
190 IF(numelig3d > 0) wige(n) = w
191 xmin=
min(xmin,x(1,n))
192 ymin=
min(ymin,x(2,n))
193 zmin=
min(zmin,x(3,n))
194 xmax=
max(xmax,x(1,n))
196 zmax=
max(zmax,x(3,n))
201 ALLOCATE (itab_tmp(numnusr1),stat=stat)
202 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'ITAB_TMP')
203 ALLOCATE (itabm1_tmp(2*numnusr1),stat=stat)
204 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'ITABM1_TMP')
205 ALLOCATE (x_tmp(3,numnusr1),stat=stat)
206 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'X_TMP')
211 CALL cpp_node_read(itab_tmp,hm_x,w,sub_nod,uid_nod)
219 x_tmp(1,n) = hm_x(1,n)
220 x_tmp(2,n) = hm_x(2,n)
221 x_tmp(3,n) = hm_x(3,n)
225 IF(sub_nod(n) /= 0)
THEN
226 IF(uid_nod(n) == 0 .AND. lsubmodel(sub_nod(n))%UID
227 . uid_nod(n) = lsubmodel(sub_nod(n))%UID
232 IF(uid_nod(n) /= uid )
THEN
236 IF (unitab%UNIT_ID(j) == uid)
THEN
237 fac_l = unitab%FAC_L(j)
242 IF (uid/=0 .AND. iflagunit==0)
THEN
243 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1=
'/NODE')
246 x_tmp(1,n) = x_tmp(1,n)*fac_l
247 x_tmp(2,n) = x_tmp(2,n)*fac_l
248 x_tmp(3,n) = x_tmp(3,n)*fac_l
250 IF(numelig3d > 0) wige(n) = w
251 xmin=
min(xmin,x_tmp(1,n))
252 ymin=
min(ymin,x_tmp(2,n))
253 zmin=
min(zmin,x_tmp(3,n))
254 xmax=
max(xmax,x_tmp(1,n))
256 zmax=
max(zmax,x_tmp(3,n))
261 CALL constit(itab_tmp,itabm1_tmp,numnusr1)
265 itab(1) = itabm1_tmp(1)
266 x(1:3,1) = x_tmp(1:3,itabm1_tmp(numnusr1+1))
268 IF(itabm1_tmp(numnusr1+i) == itabm1_tmp(numnusr1+i-1)) cycle
269 numnaux = numnaux + 1
270 itab(numnaux) = itabm1_tmp(i)
271 x(1:3,numnaux) = x_tmp(1:3,itabm1_tmp(numnusr1+i))
275 IF(
ALLOCATED(itab_tmp))
DEALLOCATE(itab_tmp)
276 IF(
ALLOCATED(itabm1_tmp))
DEALLOCATE(itabm1_tmp)
277 IF(
ALLOCATED(x_tmp))
DEALLOCATE(x_tmp)
280 IF(
ALLOCATED(sub_nod))
DEALLOCATE(sub_nod)
281 IF(
ALLOCATED(uid_nod))
DEALLOCATE(uid_nod)
282 IF(
ALLOCATED(hm_x))
DEALLOCATE(hm_x)
287 IF(numnusr2 /= 0)
THEN
288 ALLOCATE (itab_tmp(numnusr2),stat=stat)
289 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'ITAB_TMP')
290 ALLOCATE (sub_nod(numnusr2),stat=stat)
291 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'SUB_NOD')
292 ALLOCATE (uid_nod(numnusr2),stat=stat)
293 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'UID_NOD')
294 ALLOCATE (hm_x(3,numnusr2),stat=stat)
295 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'HM_X')
297 itab_tmp(1:numnusr2) = 0
298 sub_nod(1:numnusr2) = 0
299 uid_nod(1:numnusr2) = 0
300 hm_x(1:3,1:numnusr2) = zero
302 CALL cpp_cnode_read(itab_tmp,hm_x,dmerge,sub_nod,uid_nod)
309 IF(sub_nod(i) /= 0)
THEN
310 IF(uid_nod(i) == 0 .AND. lsubmodel(sub_nod(i))%UID /= 0)
311 . uid_nod(i) = lsubmodel(sub_nod(i))%UID
313 itab(n) = itab_tmp(i)
317 IF(uid_nod(i) /= uid )
THEN
321 IF (unitab%UNIT_ID(j) == uid)
THEN
322 fac_l = unitab%FAC_L(j)
327 IF (uid/=0 .AND. iflagunit==0)
THEN
328 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1=
'/CNODE')
331 x(1,n) = hm_x(1,i)*fac_l
332 x(2,n) = hm_x(2,i)*fac_l
333 x(3,n) = hm_x(3,i)*fac_l
334 cmerge(i) = dmerge(i) * fac_l
335 xmin=
min(xmin,x(1,n))
337 zmin=
min(zmin,x(3,n))
338 xmax=
max(xmax,x(1,n))
340 zmax=
max(zmax,x(3,n))
342 IF(
ALLOCATED(itab_tmp))
DEALLOCATE(itab_tmp)
343 IF(
ALLOCATED(sub_nod))
DEALLOCATE(sub_nod)
344 IF(
ALLOCATED(uid_nod))
DEALLOCATE(uid_nod)
345 IF(
ALLOCATED(hm_x))
DEALLOCATE(hm_x)
352 x1=xmin-fourth*(xmax-xmin)
353 x2=ymin-fourth*(
ymax-ymin)
354 x3=zmin-fourth*(zmax-zmin)
365 CALL hm_get_intv(
'Np',ksphres,is_available,lsubmodel)
369 itab(i)=id_limit%ADMESH_LT_NODE_AUTO
370 id_limit%ADMESH_LT_NODE_AUTO=id_limit%ADMESH_LT_NODE_AUTO+1
381 itab(i)=id_limit%ADMESH_LT_NODE_AUTO
382 id_limit%ADMESH_LT_NODE_AUTO=id_limit%ADMESH_LT_NODE_AUTO+1
390 IF(numnod-numnod0>
THEN
395 DO n=numnod0+1,numnod
396 itab(n)=id_limit%ADMESH+n-numnod0-numcnod
403 IF(nadigemesh/=0)
THEN
404 IF(numnod-numnodige0>100000000)
THEN
409 DO n=numnodige0+1,numnod
410 itab(n)=id_limit%ADMESH+n-numnodige0
415 id_limit%ADMESH_LT_NODE_AUTO=id_limit%ADMESH_LT_NODE_AUTO+1
418 CALL constit(itab,itabm1,numnod)
428 IF (isigi==3.OR.isigi==4.OR.isigi
THEN
430 120
READ(iin4,fmt=
'(A)',
END=199,ERR=199)lline
431 IF(lline(1:33)/=
'/NODAL /VECTOR /COORDINATE')
GOTO 120
432 READ(iin4,fmt=
'(A)',
END=199,ERR=199)lline
434 IF (ioutp_fmt==2)
THEN
435 125
READ(iin4,fmt=
'(A)',
END=130,ERR=199)lline
436 IF(lline(1:1)==
'#')
GOTO 125
437 IF(lline(1:1)==
'/')
GOTO 130
438 READ(lline,
'(I8,3F16.0)')n,x1,x2,x3
447 126
READ(iin4,fmt=
'(A)',
END=130,ERR=199)lline
448 IF(lline(1:1)==
'#')
GOTO 126
449 IF(lline(1:1)==
'/')
GOTO 130
450 READ(lline,fmt=fmt_i_3f) n,x1,x2,x3
471 WRITE(iout,
'(//A/A//A/)')titre(70),titre(71),titre(72)
473 WRITE(iout,
'(5X,I10,8X,1P3G20.13)')itab(i),x(1,i),x(2,i),x(3,i)
477 DO n=numnusr1+1,numnusr,50
480 WRITE(iout,
'(A)')titre(117)
482 WRITE(iout,
'(5X,I10,8X,1P3G20.13)')itab(i),x(1,i),x(2,i),x(3,i)
488 IF(numnod > numnusr)
THEN
489 DO n=numnusr+1,numnod,50
492 WRITE(iout,
'(//A)')
' COORDINATES OF NODES FOR SPH RESERVES'
493 WRITE(iout,
'(A)')
' -------------------------------------'
494 WRITE(iout,
'(A/)')titre(72)
496 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)