OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_surf.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "ige3d_c.inc"
#include "sphcom.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_surf (itab, itabm1, igrsurf, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, x, mfi, iskn, skew, bufsf, knod2els, nod2els, sh4tree, sh3tree, isubmod, flag, unitab, ibox, ixs10, ixs16, ixs20, rtrans, lsubmodel, knod2elc, nod2elc, knod2eltg, nod2eltg, kxig3d, ixig3d, ipartig3d, knot, igeo, wige, knod2elig3d, nod2elig3d, v, nige, rige, xige, vige, iadtabige, decaligeo, iadboxmax, knod2elq, nod2elq, subset, igrbric, igrsh4n, igrsh3n, knotlocpc, knotlocel, nsets, map_tables)

Function/Subroutine Documentation

◆ hm_read_surf()

subroutine hm_read_surf ( integer, dimension(numnod) itab,
integer, dimension(sitabm1) itabm1,
type (surf_), dimension(nsurf+nsets) igrsurf,
integer, dimension(nixs,numels) ixs,
integer, dimension(nixq,numelq) ixq,
integer, dimension(nixc,numelx) ixc,
integer, dimension(nixt,numelt) ixt,
integer, dimension(nixp,numelp) ixp,
integer, dimension(nixr,numelr) ixr,
integer, dimension(nixtg,numeltg) ixtg,
integer, dimension(lipart1,npart+nthpart) ipart,
integer, dimension(numels) iparts,
integer, dimension(numelq) ipartq,
integer, dimension(numelc) ipartc,
integer, dimension(*) ipartt,
integer, dimension(numelp) ipartp,
integer, dimension(numelr) ipartr,
integer, dimension(numeltg) iparttg,
x,
integer mfi,
integer, dimension(liskn,siskwn/liskn) iskn,
skew,
bufsf,
integer, dimension(numnod+1) knod2els,
integer, dimension(8*numels+6*numels10+12*numels20+8*numels16) nod2els,
integer, dimension(ksh4tree*numelc) sh4tree,
integer, dimension(ksh3tree*numeltg) sh3tree,
integer, dimension(nsubmod) isubmod,
integer flag,
type (unit_type_), intent(in) unitab,
type (box_), dimension(nbbox) ibox,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
rtrans,
type(submodel_data), dimension(nsubmod) lsubmodel,
integer, dimension(numnod+1) knod2elc,
integer, dimension(4*numelc) nod2elc,
integer, dimension(numnod+1) knod2eltg,
integer, dimension(3*numeltg+3*numeltg6) nod2eltg,
integer, dimension(nixig3d,numelig3d0+addelig3d) kxig3d,
integer, dimension(*) ixig3d,
integer, dimension(numelig3d0+addelig3d) ipartig3d,
knot,
integer, dimension(npropgi,numgeo) igeo,
wige,
integer, dimension(numnod+1) knod2elig3d,
integer, dimension(*) nod2elig3d,
v,
integer, dimension(*) nige,
rige,
xige,
vige,
integer iadtabige,
integer decaligeo,
integer iadboxmax,
integer, dimension(numnod+1) knod2elq,
integer, dimension(4*numelq) nod2elq,
type (subset_), dimension(nsubs) subset,
type (group_), dimension(ngrbric) igrbric,
type (group_), dimension(ngrshel) igrsh4n,
type (group_), dimension(ngrsh3n) igrsh3n,
knotlocpc,
knotlocel,
integer nsets,
type(mapping_struct_), intent(in) map_tables )

Definition at line 59 of file hm_read_surf.F.

76C-----------------------------------------------
77C M o d u l e s
78C-----------------------------------------------
79 USE my_alloc_mod
80 USE unitab_mod
81 USE submodel_mod
82 USE message_mod
83 USE groupdef_mod
84 USE optiondef_mod
85 USE surf_mod
86 USE hm_option_read_mod
87 USE mapping_option_mod
88 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
89 use element_mod , only : nixs, nixq, nixc, nixt, nixp, nixr, nixtg
90C-----------------------------------------------
91C I m p l i c i t T y p e s
92C-----------------------------------------------
93#include "implicit_f.inc"
94C-----------------------------------------------
95C C o m m o n B l o c k s
96C-----------------------------------------------
97#include "scr17_c.inc"
98#include "com01_c.inc"
99#include "com04_c.inc"
100#include "param_c.inc"
101#include "remesh_c.inc"
102#include "ige3d_c.inc"
103#include "sphcom.inc"
104#include "tabsiz_c.inc"
105C-----------------------------------------------
106C D u m m y A r g u m e n t s
107C-----------------------------------------------
108 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
109 INTEGER ITABM1(SITABM1),
110 . IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),IXC(NIXC,NUMELX),IXT(NIXT,NUMELT),
111 . IXP(NIXP,NUMELP),IXR(NIXR,NUMELR),IXTG(NIXTG,nUMELTG),IPARTS(NUMELS),
112 . IPARTQ(NUMELQ),IPARTC(NUMELC),IPARTT(*),IPARTP(NUMELP),IPARTR(NUMELR),
113 . IPARTTG(NUMELTG),IPART(LIPART1,NPART+NTHPART),ITAB(NUMNOD),
114 . ISKN(LISKN,SISKWN/LISKN),MFI,KNOD2ELS(NUMNOD+1),
115 . NOD2ELS(8*NUMELS+6*NUMELS10+12*NUMELS20+8*NUMELS16),
116 . SH4TREE(KSH4TREE*NUMELC),SH3TREE(KSH3TREE*NUMELTG),ISUBMOD(NSUBMOD),
117 . IXS10(6,*),IXS16(8,*),IXS20(12,*),
118 . KNOD2ELC(NUMNOD+1),NOD2ELC(4*NUMELC),KNOD2ELTG(NUMNOD+1),NOD2ELTG(3*NUMELTG+3*NUMELTG6),
119 . KXIG3D(NIXIG3D,NUMELIG3D0+ADDELIG3D),IPARTIG3D(NUMELIG3D0+ADDELIG3D),IXIG3D(*),
120 . KNOD2ELIG3D(NUMNOD+1),NOD2ELIG3D(*),
121 . NIGE(*),IGEO(NPROPGI,NUMGEO),
122 . KNOD2ELQ(NUMNOD+1),NOD2ELQ(4*NUMELQ)
123 INTEGER FLAG,IADTABIGE,DECALIGEO,
124 . IADBOXMAX,NSETS
125 my_real x(3,numnod),skew(lskew,sskew/lskew),bufsf(lisurf1*nsurf),
126 . rtrans(ntransf,nrtrans),v(3,numnod),rige(*),xige(*),vige(*),
127 . wige(*),knot(*),knotlocpc(*),knotlocel(*)
128 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
129 TYPE(MAPPING_STRUCT_), INTENT(IN) :: MAP_TABLES
130C-----------------------------------------------
131 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
132 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
133 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
134 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
135 TYPE (SURF_) , DIMENSION(NSURF+NSETS) :: IGRSURF
136 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
137C-----------------------------------------------
138C L o c a l V a r i a b l e s
139C-----------------------------------------------
140 INTEGER J,JJ,I,K,L,II,KK,ISU,ID,NSEG,NOSYS,NTOT,
141 . ITER,IGS,IGRS,NSU,CONT,IAD0,IADV,
142 . IADFIN,IT0,IT1,IT2,IT3,IT4,IT5,IT6,IT7,IPP,N1,N2,
143 . NSEGV,NE,ITYP,ISKEW,MAD,SRFTYP,REFMAD,DGR,DGR1,
144 . JC, IEXT,UID,IFLAGUNIT,
145 . ISK,BOXTYPE,J2(2),IT8,SBUFBOX,IT9,IADPL,SUB_ID,
146 . IFRE,NUMEL,INTMAX,IBUFSIZ,NINDX,STAT,NSEGIGE,
147 . IADBOX,N3,N4,NSEG0,
148 . LIST_SURF(NSURF),NSEG_TOT,NN,NENTITY,
149 . SEGID
150 my_real
151 . xmin,xmax,ymin,ymax,zmin,zmax,bid,
152 . s_a,s_b,s_c,xg,yg,zg,fac_l,diam,xp1,yp1,zp1,xp2,yp2,zp2
153 CHARACTER(LEN=NCHARTITLE) :: TITR,STRING
154 CHARACTER :: MESS*40
155 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2,KEY3
156 INTEGER, DIMENSION(:),ALLOCATABLE :: BUFBOX, BUFTMP, INDX ,TAGSHELLBOXC,TAGSHELLBOXG
157 my_real :: vectx,vecty,vectz,vect
158 DOUBLE PRECISION RSBUFBOX
159 CHARACTER(LEN=NCHARTITLE) :: TITR1
160 LOGICAL :: FLAG_GRBRIC, lFOUND, IS_AVAILABLE, IS_ENCRYPTED, lERROR, l1104
161 INTEGER :: ID_PART,MODE
162 INTEGER :: IBID
163 INTEGER :: NINDX_SOL, NINDX_SOL10
164 INTEGER, DIMENSION(:), ALLOCATABLE :: INDX_SOL, INDX_SOL10
165 TYPE(PART_TYPE), DIMENSION(:), ALLOCATABLE :: SURF_ELM
166! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
167! FLAG_GRBRIC : flag to initialize the INDX_SOL(10) arrays
168! and optimize an old and expensive treatment in SSURFTAG
169! NINDX_SOL(10) : number of the tagged solid(10) element
170! --> need to split solid and solid10
171! for a treatment in the SSURFTAG routine
172! only useful for /SURF/GRBRIC
173! INDX_SOL(10) : ID of the tagged solid(10) element
174! --> need to split solid and solid10
175! for a treatment in the SSURFTAG routine
176! only useful for /SURF/GRBRIC
177! MODE : integer
178! switch to initialize solid/shell/shell3n or truss/beam/spring
179! SURF_ELM : PART_TYPE structure
180! %Nxxx : number of element per part
181! %xxx_PART : ID of the element
182! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
183C-----------------------------------------------
184C E x t e r n a l F u n c t i o n s
185C-----------------------------------------------
186 INTEGER USR2SYS
187 DATA mess/'SURFACE DEFINITION '/
188 DATA intmax /2147483647/
189C-----------------------------------------------
190! IGRSURF(IGS)%ID :: SURFACE identifier
191! IGRSURF(IGS)%TITLE :: SURF title
192! IGRSURF(IGS)%NSEG :: Number of surfaces within /SURF
193! IGRSURF(IGS)%NSEG_IGE :: Number of iso-surfaces
194! IGRSURF(IGS)%TYPE :: OPEN / CLOSED surface flag
195! SURF_TYPE = 0 : SEGMENTS
196! SURF_TYPE = 100 : HYPER-ELLIPSOIDE MADYMO.
197! SURF_TYPE = 101 : HYPER-ELLIPSOIDE RADIOSS.
198! SURF_TYPE = 200 : INFINITE PLANE
199! IGRSURF(IGS)%ID_MADYMO :: Coupled madimo surface identifier
200! (computed in Radioss Engine, when receiving Datas from MaDyMo).
201! ID MaDyMo - for entity type which impose surface movement:
202! No systeme MaDyMo for entity type which impose surface movement
203! IGRSURF(IGS)%NB_MADYMO :: Entity number imposing surface movement.
204! --> No Radioss or MaDyMO system.
205! IGRSURF(IGS)%TYPE_MADYMO :: Entity type which impose surface movement.
206! = 1 : Rigid Body.
207! = 2 : MADYMO Hyper-ellipsoide.
208! IGRSURF(IGS)%IAD_BUFR :: Analytical Surfaces address (reals BUFSF - temp)
209! IGRSURF(IGS)%LEVEL :: FLAG "SUBLEVEL DONE" FOR SURFACES OF SURFACES
210! = 0 ! initialized surface
211! = 1 ! uninitialized surface
212! IGRSURF(IGS)%TH_SURF :: FLAG for /TH/SURF
213! = 0 ! unsaved surface for /TH/SURF
214! = 1 ! saved surface for /TH/SURF
215! IGRSURF(IGS)%ISH4N3N :: FLAG = 1 (only SH4N and SH3N considered - for airbags)
216! IGRSURF(IGS)%NSEG_R2R_ALL :: Multidomaines -> number of segments before split
217! IGRSURF(IGS)%NSEG_R2R_SHARE :: shared on boundary subdomain segments
218! IGRSURF(IGS)%ELTYP(J) :: type of element attached to the segment of the surface
219! ITYP = 0 - surf of segments
220! ITYP = 1 - surf of solids
221! ITYP = 2 - surf of quads
222! ITYP = 3 - surf of SH4N
223! ITYP = 4 - line of trusses
224! ITYP = 5 - line of beams
225! ITYP = 6 - line of springs
226! ITYP = 7 - surf of SH3N
227! ITYP = 8 - line of XELEM (nstrand element)
228! ITYP = 101 - ISOGEOMETRIQUE
229! igrsurf(igs)%ELEM(j) :: element attached to the segment(j) of the surface
230! IGRSURF(IGS)%NODES(J,4) :: 4 nodes of the segment for /SURF
231C=======================================================================
232 it0=0
233 it1=0
234 it2=0
235 it3=0
236 it4=0
237 it5=0
238 it6=0
239 it7=0
240 it8=0
241 it9=0
242 iext=0
243 ifre=0
244 ibufsiz=numelc+numeltg+6*numels+npart
245 ALLOCATE(buftmp(ibufsiz),indx(ibufsiz),stat=stat)
246 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
247 . msgtype=msgerror,
248 . c1='BUFTMP')
249 nindx=0
250 buftmp(1:ibufsiz)=0 ! init to 0 only one time
251
252C=======================================================================
253C SURFACE TYPE SEGMENT + init ISURF(1,IGS)
254C=======================================================================
255 CALL hm_option_start('/SURF')
256 titr1='SURFACE'
257 DO igs=1,nsurf
258 lerror=.false.
259 CALL hm_option_read_key(lsubmodel,
260 . option_id = id,
261 . option_titr = titr ,
262 . unit_id = uid,
263 . keyword2 = key ,
264 . keyword3 = key2)
265 nseg = 0
266 ! initialized variables:
267 IF (flag == 0) THEN
268 igrsurf(igs)%ID = 0
269 igrsurf(igs)%NSEG = 0
270 igrsurf(igs)%NSEG_IGE = 0
271 igrsurf(igs)%IAD_IGE = 0
272 igrsurf(igs)%TYPE = 0
273 igrsurf(igs)%ID_MADYMO = 0
274 igrsurf(igs)%IAD_BUFR = 0
275 igrsurf(igs)%NB_MADYMO = 0
276 igrsurf(igs)%TYPE_MADYMO = 0
277 igrsurf(igs)%LEVEL = 0
278 igrsurf(igs)%TH_SURF = 0
279 igrsurf(igs)%ISH4N3N = 0
280 igrsurf(igs)%NSEG_R2R_ALL = 0
281 igrsurf(igs)%NSEG_R2R_SHARE = 0
282 ENDIF
283 igrsurf(igs)%ID=id
284 igrsurf(igs)%TYPE=0
285 igrsurf(igs)%TITLE=titr
286 IF(key(1:4)=='SURF' .OR. key(1:5)=='DSURF')THEN
287C tag for surfaces defined from surface list
288 igrsurf(igs)%NSEG=-1
289 igrsurf(igs)%LEVEL=0
290 it0=it0+1
291 ELSEIF(key(1:3)=='SEG')THEN
292 it1=it1+1
293 IF (flag == 0) igrsurf(igs)%NSEG=0
294 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
295 nseg0 = igrsurf(igs)%NSEG
296 CALL my_alloc(igrsurf(igs)%NODES,nseg0,4)
297 igrsurf(igs)%NODES(1:nseg0,1:4) = 0
298 CALL my_alloc(igrsurf(igs)%ELTYP,nseg0)
299 igrsurf(igs)%ELTYP(1:nseg0) = 0
300 CALL my_alloc(igrsurf(igs)%ELEM,nseg0)
301 igrsurf(igs)%ELEM(1:nseg0) = 0
302 ENDIF
303 igrsurf(igs)%LEVEL=1
304 CALL hm_get_intv ('segmax' ,nentity,is_available,lsubmodel)
305 DO kk=1,nentity
306 CALL hm_get_int_array_index('SEGidArray',segid,kk,is_available,lsubmodel)
307 IF (flag == 1) THEN
308 CALL hm_get_int_array_index('N1',n1,kk,is_available,lsubmodel)
309 CALL hm_get_int_array_index('N2',n2,kk,is_available,lsubmodel)
310 n1 = usr2sys(n1,itabm1,mess,id)
311 n2 = usr2sys(n2,itabm1,mess,id)
312 ENDIF
313 IF(numels10>0.OR.flag==1) THEN
314 CALL hm_get_int_array_index('N3',n3,kk,is_available,lsubmodel)
315 CALL hm_get_int_array_index('N4',n4,kk,is_available,lsubmodel)
316 IF(n2d == 0) THEN
317 n3 = usr2sys(n3,itabm1,mess,id)
318 IF(n4/=0) THEN
319 n4 = usr2sys(n4,itabm1,mess,id)
320 ELSE
321 n4 = n3
322 ENDIF
323 ELSE
324 n3 = 0
325 n4 = 0
326 ENDIF
327 ENDIF
328 IF(numels10 > 0.AND.n2d==0.AND.n3==n4.AND.n3/=0) THEN
329 nseg0 = igrsurf(igs)%NSEG
330 IF (flag == 0) THEN
331 CALL hm_get_int_array_index('N1',n1,kk,is_available,lsubmodel)
332 CALL hm_get_int_array_index('N2',n2,kk,is_available,lsubmodel)
333 n1 = usr2sys(n1,itabm1,mess,id)
334 n2 = usr2sys(n2,itabm1,mess,id)
335 ENDIF
336 CALL tsurftag(ixs ,ixs10 ,igrsurf(igs),flag ,nseg ,
337 2 knod2els,nod2els ,n1 ,n2 ,n3 ,
338 3 nseg0 )
339 ELSE
340 nseg = nseg +1
341 IF (flag == 1) THEN
342 nseg0 = igrsurf(igs)%NSEG
343 CALL segsurf(
344 . n1 ,n2 ,n3 ,n4 ,nseg0,
345 . nseg,igrsurf(igs)%NODES,igrsurf(igs)%ELTYP,igrsurf(igs)%ELEM,0,0)
346 ENDIF
347 ENDIF
348 IF (flag == 0) THEN
349 igrsurf(igs)%NSEG = nseg
350 ENDIF
351 ENDDO
352
353 ELSEIF(key(1:6)=='SUBSET'.OR. key(1:4)=='PART'.OR.
354 . key(1:3)=='MAT' .OR. key(1:4)=='PROP'.OR.
355 . key(1:6)=='GRBRIC')THEN
356C surf of SUBSET PART MAT OR PROP
357 it2=it2+1
358 IF (flag == 0) igrsurf(igs)%NSEG=0
359 igrsurf(igs)%LEVEL=1
360 ELSEIF(key(1:3) == 'BOX'.AND.nbbox == 0 .AND.
361 . (key2(1:5) /= 'RECTA'.AND.
362 . key2(1:5) /= 'CYLIN'.AND.key2(1:5) /= 'SPHER'))THEN
363C surf in a box (old box)
364 lerror=.true.
365 ELSEIF(key(1:2)=='GR')THEN
366C surf d'un group d'elements
367 it4=it4+1
368 IF (flag == 0) igrsurf(igs)%NSEG=0
369 igrsurf(igs)%LEVEL=1
370 ELSEIF(key(1:6)=='ELLIPS'.OR.key(1:8)=='MDELLIPS')THEN
371C surface with formal equation (non-meshed).
372 it5=it5+1
373 IF (flag == 0) igrsurf(igs)%NSEG=1
374 igrsurf(igs)%LEVEL=1
375 IF (flag == 1) THEN
376 nseg0 = igrsurf(igs)%NSEG
377 CALL my_alloc(igrsurf(igs)%NODES,nseg0,4)
378 igrsurf(igs)%NODES(1:nseg0,1:4) = 0
379 CALL my_alloc(igrsurf(igs)%ELTYP,nseg0)
380 igrsurf(igs)%ELTYP(1:nseg0) = 0
381 CALL my_alloc(igrsurf(igs)%ELEM,nseg0)
382 igrsurf(igs)%ELEM(1:nseg0) = 0
383 ENDIF
384 ELSEIF(key(1:6)=='SUBMOD')THEN
385C a surface of a submodel.
386 it6=it6+1
387 IF (flag == 0) igrsurf(igs)%NSEG=0
388 igrsurf(igs)%LEVEL=1
389 ELSEIF(key(1:3)=='BOX'.AND.(key2(1:5) == 'RECTA'.OR.
390 . key2(1:5) == 'CYLIN'.OR.key2(1:5) == 'SPHER'))THEN
391C old /grnod/box (not /BOX/BOX)
392C surf inside a box (classical box, parallelepiped (oriented), cylindrical, spherical)
393 lerror=.true.
394 ELSEIF(key(1:3) == 'BOX' .AND. nbbox > 0)THEN
395C multi box (box of boxes)
396 it8=it8+1
397 IF (flag == 0) igrsurf(igs)%NSEG=0
398 igrsurf(igs)%LEVEL=1
399 ELSEIF(key(1:6)=='PLANE')THEN
400C infinite plane (non-meshed)
401 it9=it9+1
402 IF (flag == 0) igrsurf(igs)%NSEG=0
403 igrsurf(igs)%LEVEL=1
404 ELSE
405 lerror=.true.
406 ENDIF
407
408 IF(lerror)THEN
409 !INVALID KEYWORD
410 string=' '
411 string = "/SURF/"//key(1:len_trim(key))
412 IF(len_trim(key2)>1)string = string//key2(1:len_trim(key2))
413 CALL ancmsg(msgid=686,anmode=aninfo,msgtype=msgerror,i1=id, c1=titr, c2=string)
414 ENDIF
415
416
417 ENDDO ! I=1,NLINE(KCUR)
418c----------------------------
419 numel = numelc+numeltg
420C
421C-------------------------------------
422C Searching for double IDs
423C-------------------------------------
424 IF (flag == 0) THEN
425 DO igs=1,nsurf
426 list_surf(igs) = igrsurf(igs)%ID
427 ENDDO
428 CALL udouble_igr(list_surf,nsurf,mess,0,bid)
429 ENDIF
430C=======================================================================
431C BOX (OLD)
432C=======================================================================
433 IF (it3/=0)THEN
434 !no longer supported with new reader based on CFG files
435 ENDIF
436C=======================================================================
437C BOX (parallelepiped, cylindrical, spherical) - old one (10SA1)
438C=======================================================================
439 IF (it7/=0)THEN
440 !no longer supported with new reader based on CFG files
441 ENDIF
442C=======================================================================
443C NEW BOX OPTION (MULTI BOX COMBINATION)
444C=======================================================================
445 IF (it8/=0) THEN
446 ALLOCATE(tagshellboxc(numelc),stat=stat)
447 ALLOCATE(tagshellboxg(numeltg),stat=stat)
448 tagshellboxc(1:numelc) = 0
449 tagshellboxg(1:numeltg) = 0
450 iadbox = 1
451 IF (flag == 0) THEN
452 ALLOCATE(bufbox(1))
453 bufbox = 0
454 ELSEIF (flag == 1) THEN
455 ALLOCATE(bufbox(iadboxmax))
456 bufbox(1:iadboxmax) = 0
457 ENDIF
458 sbufbox = int(intmax)
459C
460 CALL hm_option_start('/SURF')
461 DO igs=1,nsurf
462 CALL hm_option_read_key(lsubmodel,
463 . option_id = id,
464 . option_titr = titr ,
465 . unit_id = uid,
466 . keyword2 = key ,
467 . keyword3 = key2)
468 nn = 0
469 nseg=0
470 IF(key(1:3) == 'BOX'.AND. nbbox > 0)THEN
471 nseg=0
472 iadbox = 1
473 iflagunit = 0
474 DO j=1,unitab%NUNITS
475 IF (unitab%UNIT_ID(j) == uid) THEN
476 fac_l = unitab%FAC_L(j)
477 iflagunit = 1
478 EXIT
479 ENDIF
480 ENDDO
481 IF (uid/=0.AND.iflagunit==0) THEN
482 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
483 . i2=uid,i1=id,c1='SURFACE',
484 . c2='SURFACE',
485 . c3=titr)
486 ENDIF
487!
488 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
489 nseg0 = igrsurf(igs)%NSEG
490 CALL my_alloc(igrsurf(igs)%NODES,nseg0,4)
491 igrsurf(igs)%NODES(1:nseg0,1:4) = 0
492 CALL my_alloc(igrsurf(igs)%ELTYP,nseg0)
493 igrsurf(igs)%ELTYP(1:nseg0) = 0
494 CALL my_alloc(igrsurf(igs)%ELEM,nseg0)
495 igrsurf(igs)%ELEM(1:nseg0) = 0
496 ENDIF
497!
498 numel = numelc
499 IF(numel > 0)
500 . CALL hm_bigsbox(numel ,ixc ,nixc ,2 ,5 ,3 ,
501 . x , nseg ,flag ,skew,
502 . iskn ,1 ,itabm1 ,ibox ,
503 . id ,bufbox,igrsurf(igs),iadbox,key ,
504 . sbufbox,titr ,mess ,tagshellboxc,
505 . nn, lsubmodel )
506C---
507 iadboxmax = max(iadbox,iadboxmax)
508C---
509 IF (iadbox>sbufbox .OR. iadbox<0)
510 . CALL ancmsg(msgid=1007, msgtype=msgerror,anmode=anstop)
511C---
512 numel = numeltg
513 IF(numel > 0)
514 . CALL hm_bigsbox(numel ,ixtg ,nixtg ,2 ,4 ,7 ,
515 . x , nseg ,flag ,skew,
516 . iskn ,1 ,itabm1 ,ibox ,
517 . id ,bufbox,igrsurf(igs),iadbox,key ,
518 . sbufbox,titr ,mess ,tagshellboxg,
519 . nn, lsubmodel )
520 IF (iadbox>sbufbox .OR. iadbox<0)
521 . CALL ancmsg(msgid=1007, msgtype=msgerror,anmode=anstop)
522C---
523 iadboxmax = max(iadbox,iadboxmax)
524C---
525 iext=0
526 IF(key2(1:3)=='EXT')THEN
527 iext=ext_surf
528 ELSEIF(key2(1:3)=='ALL')THEN
529 iext=all_surf
530 END IF
531 igrsurf(igs)%EXT_ALL = iext
532C---
533 IF (numels > 0) THEN
534 nseg0 = igrsurf(igs)%NSEG
535 CALL sboxboxsurf(ixs ,x ,nseg,
536 . knod2els ,nod2els,iext ,flag,
537 . ixs10 ,ixs16 ,ixs20,skew ,ibox,
538 . id ,bufbox,iadbox ,key ,
539 . sbufbox ,titr ,knod2elc,nod2elc ,ixc ,
540 . tagshellboxc ,knod2eltg ,nod2eltg ,ixtg ,
541 . tagshellboxg,igrsurf(igs),nn,nseg0,lsubmodel)
542 ENDIF
543C---
544 iadboxmax = max(iadbox,iadboxmax)
545C---
546 IF (flag == 0) THEN
547 igrsurf(igs)%NSEG = nseg
548 ELSEIF (flag == 1) THEN
549 igrsurf(igs)%NSEG = nseg
550 ENDIF
551 ENDIF
552 IF (iadbox>sbufbox .OR. iadbox<0)
553 . CALL ancmsg(msgid=1007, msgtype=msgerror,anmode=anstop)
554 ENDDO
555 IF(ALLOCATED(bufbox))DEALLOCATE(bufbox)
556 DEALLOCATE(tagshellboxc,tagshellboxg)
557 ENDIF ! IT8/=0
558C
559C=======================================================================
560C groups of SUBSETS,PART,MAT,PROP,BRIC
561C=======================================================================
562
563 IF(it2/=0.OR.it6/=0)THEN
564 ALLOCATE( surf_elm(npart) )
565 mode = 1
566 CALL init_surf_elm(numels ,numels8,numels10,numelc ,numeltg ,
567 1 ibid ,ibid ,ibid ,npart ,iparts ,
568 2 ipartc ,iparttg,ibid ,ibid ,ibid ,
569 3 surf_elm,mode )
570 ENDIF
571
572 IF(it2/=0)THEN
573 nindx_sol = 0
574 nindx_sol10 = 0
575 ALLOCATE( indx_sol(numels) )
576 ALLOCATE( indx_sol10(numels) )
577 CALL hm_option_start('/SURF')
578 DO igs=1,nsurf
579 CALL hm_option_read_key(lsubmodel,
580 . option_id = id,
581 . option_titr = titr ,
582 . unit_id = uid,
583 . keyword2 = key ,
584 . keyword3 = key2)
585 nseg=0
586 nsegige=0
587 iext=0
588 nseg0 = igrsurf(igs)%NSEG
589 IF (key(1:6)=='GRBRIC')THEN
590 IF(key2(1:3)=='EXT')THEN
591 ifre=0
592 iext=ext_surf
593 END IF
594 IF(key2(1:4)=='FREE')THEN
595 ifre=1
596 iext=1
597 END IF
598 IF(iext==0.AND.ifre==0)THEN !only /grbric/ext is treated
599 CALL ancmsg(msgid=479,
600 . msgtype=msgerror,
601 . anmode=aninfo,
602 . i1=id,
603 . c1=titr)
604 ENDIF
605!
606 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
607 nseg0 = igrsurf(igs)%NSEG
608 CALL my_alloc(igrsurf(igs)%NODES,nseg0,4)
609 igrsurf(igs)%NODES(1:nseg0,1:4) = 0
610 CALL my_alloc(igrsurf(igs)%ELTYP,nseg0)
611 igrsurf(igs)%ELTYP(1:nseg0) = 0
612 CALL my_alloc(igrsurf(igs)%ELEM,nseg0)
613 igrsurf(igs)%ELEM(1:nseg0) = 0
614 ENDIF
615!
616 numel=numels8+numels10
617 flag_grbric = .true.
618 CALL hm_surfgr2(ngrbric ,key(1:6),numel ,igrsurf(igs)%ID,
619 2 igrbric ,buftmp ,titr ,titr1 ,
620 3 indx ,nindx ,flag ,nindx_sol,nindx_sol10,
621 4 indx_sol,indx_sol10 ,flag_grbric,lsubmodel)
622 CALL ssurftag(ixs ,iparts ,nseg0 ,igrsurf(igs),buftmp,
623 2 nseg ,knod2els,nod2els ,iext ,flag ,
624 3 ixs10 ,ixs16 ,ixs20 ,ifre ,key ,
625 4 knod2elc,nod2elc ,knod2eltg,nod2eltg,
626 5 ixc ,ixtg ,ipartc ,iparttg ,nindx,
627 6 nindx_sol, nindx_sol10, indx, indx_sol, indx_sol10,
628 7 surf_elm)
629 IF (flag == 0) THEN
630 igrsurf(igs)%NSEG = nseg
631 ENDIF
632 ENDIF
633
634 IF (key(1:4)=='PART'.OR.key(1:6)=='SUBSET'.OR.
635 . key(1:3)=='MAT' .OR.key(1:4)=='PROP') THEN
636 IF(key2(1:3)=='EXT')THEN
637 iext=ext_surf
638 ELSEIF(key2(1:3)=='ALL')THEN
639 iext=all_surf
640 END IF
641 igrsurf(igs)%EXT_ALL = iext
642 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
643! ISOGEO
644 nseg0 = igrsurf(igs)%NSEG_IGE
645 CALL my_alloc(igrsurf(igs)%NODES_IGE,nseg0,4)
646 igrsurf(igs)%NODES_IGE(1:nseg0,1:4) = 0
647 CALL my_alloc(igrsurf(igs)%ELTYP_IGE,nseg0)
648 igrsurf(igs)%ELTYP_IGE(1:nseg0) = 0
649 CALL my_alloc(igrsurf(igs)%ELEM_IGE,nseg0)
650 igrsurf(igs)%ELEM_IGE(1:nseg0) = 0
651!
652 nseg0 = igrsurf(igs)%NSEG
653 CALL my_alloc(igrsurf(igs)%NODES,nseg0,4)
654 igrsurf(igs)%NODES(1:nseg0,1:4) = 0
655 CALL my_alloc(igrsurf(igs)%ELTYP,nseg0)
656 igrsurf(igs)%ELTYP(1:nseg0) = 0
657 CALL my_alloc(igrsurf(igs)%ELEM,nseg0)
658 igrsurf(igs)%ELEM(1:nseg0) = 0
659!
660 IF (nvolu + nmonvol > 0) THEN
661 nseg0 = igrsurf(igs)%NSEG
662 !Keep track of the "reversed surface" -> when /SURF/PART comes
663 !with a negative part_id
664 CALL my_alloc(igrsurf(igs)%REVERSED, nseg0)
665 ENDIF
666 ENDIF
667!
668 CALL hm_tagpart2(buftmp,ipart ,key ,
669 . igrsurf(igs)%ID,titr,titr1,indx,nindx ,
670 . flag ,subset, lsubmodel,map_tables%IPARTM)
671 IF (nadmesh==0)THEN
672 numel = numelc
673 CALL surftag(numel,ixc,nixc,2,5,3,ipartc,
674 . buftmp,igrsurf(igs),nseg,flag,nindx,
675 . indx,surf_elm)
676 numel = numeltg
677 CALL surftag(numel,ixtg,nixtg,2,4,7,iparttg,
678 . buftmp,igrsurf(igs),nseg,flag,nindx,
679 . indx,surf_elm)
680 ELSE
681 numel = numelc
682 CALL surftagadm(numel,ixc,nixc,2,5,3,ipartc,
683 . buftmp,igrsurf(igs),nseg,ipart,
684 . ksh4tree,sh4tree,flag)
685 numel = numeltg
686 CALL surftagadm(numel,ixtg,nixtg,2,4,7,iparttg,
687 . buftmp,igrsurf(igs),nseg,ipart,
688 . ksh3tree,sh3tree,flag)
689 END IF
690 IF(iext==0)THEN
691 l1104=.false.
692 DO ii=1,numels
693 IF (iabs(buftmp(iparts(ii)))==1)THEN
694 l1104=.true.
695 CALL ancmsg(msgid=1104,
696 . msgtype=msgerror,
697 . anmode=aninfo_blind_1,
698 . prmod=msg_cumu,
699 . i1=iparts(ii),
700 . i2=ixs(11,ii))
701 ENDIF
702 ENDDO
703 IF(l1104)CALL ancmsg(msgid=1104,
704 . msgtype=msgerror,
705 . anmode=aninfo_blind_1,
706 . prmod=msg_print,
707 . i1=id,
708 . c1=titr )
709
710 ELSE
711 DO ii=numels8+numels10+1,numels
712 IF (iabs(buftmp(iparts(ii)))==1)THEN
713 titr = igrsurf(igs)%TITLE
714 CALL ancmsg(msgid=651,
715 . msgtype=msgerror,
716 . anmode=aninfo,
717 . i1=id,
718 . c1=titr)
719 ENDIF
720 ENDDO
721 END IF
722!
723 nseg0 = igrsurf(igs)%NSEG
724 CALL ssurftag(ixs ,iparts ,nseg0 ,igrsurf(igs),buftmp ,
725 2 nseg ,knod2els,nod2els ,iext ,flag ,
726 3 ixs10 ,ixs16 ,ixs20 ,ifre ,key ,
727 4 knod2elc,nod2elc ,knod2eltg,nod2eltg,
728 5 ixc ,ixtg ,ipartc ,iparttg ,nindx,
729 6 nindx_sol, nindx_sol10, indx, indx_sol, indx_sol10,
730 7 surf_elm)
731 IF(numelig3d/=0) THEN
732 CALL ssurftagigeo(ixig3d,ipartig3d,kxig3d,
733 2 buftmp ,nseg ,
734 3 iext ,flag ,ifre ,key ,
735 4 nsegige,knot ,igeo ,wige ,
736 5 x ,v, knod2elig3d,nod2elig3d ,
737 6 nige,rige,xige,vige,iadtabige,decaligeo,
738 7 igrsurf(igs),knotlocpc,knotlocel)
739 ENDIF
740
741C------------/SURF/PART/EXT FOR QUADS --------------------
742 CALL qsurftag(ixq ,ipartq , nseg0 ,igrsurf(igs),buftmp ,
743 2 nseg ,knod2elq,nod2elq,iext ,flag ,
744 3 x)
745
746 IF (flag == 0) THEN
747 igrsurf(igs)%NSEG = nseg
748 igrsurf(igs)%NSEG_IGE = nsegige
749 numfakenodigeo=numfakenodigeo+16*nsegige/9 ! same functionality as IADTABIGE
750 ENDIF
751 ENDIF
752C reset BUFTMP to 0 (only where it was set to 1/-1)
753 DO ii=1,nindx
754 buftmp(indx(ii))=0
755 END DO
756 nindx=0
757 nindx_sol = 0
758 nindx_sol10 = 0
759 ENDDO
760
761 DEALLOCATE( indx_sol )
762 DEALLOCATE( indx_sol10 )
763 ENDIF
764C=======================================================================
765C surfaces from SUBMODELS
766C=======================================================================
767 IF (it6 > 0)THEN
768 CALL hm_option_start('/SURF')
769 DO igs=1,nsurf
770 CALL hm_option_read_key(lsubmodel,
771 . option_id = id,
772 . option_titr = titr ,
773 . unit_id = uid,
774 . keyword2 = key ,
775 . keyword3 = key2)
776 nseg=0
777 iext=0
778 IF (key(1:6)=='SUBMOD') THEN
779 IF(key2(1:3)=='EXT')THEN
780 iext=ext_surf
781 ELSEIF(key2(1:3)=='ALL')THEN
782 iext=all_surf
783 END IF
784 igrsurf(igs)%EXT_ALL = iext
785!
786 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
787 nseg0 = igrsurf(igs)%NSEG
788 CALL my_alloc(igrsurf(igs)%NODES,nseg0,4)
789 igrsurf(igs)%NODES(1:nseg0,1:4) = 0
790 CALL my_alloc(igrsurf(igs)%ELTYP,nseg0)
791 igrsurf(igs)%ELTYP(1:nseg0) = 0
792 CALL my_alloc(igrsurf(igs)%ELEM,nseg0)
793 igrsurf(igs)%ELEM(1:nseg0) = 0
794 IF (nvolu + nmonvol > 0) THEN
795 nseg0 = igrsurf(igs)%NSEG
796 !Keep track of the "reversed surface" -> when /SURF/PART comes
797 !with a negative part_id
798 CALL my_alloc(igrsurf(igs)%REVERSED, nseg0)
799 ENDIF
800 ENDIF
801!
802 CALL hm_submodpart(isubmod,buftmp ,ipart ,id ,flag ,
803 . mess ,titr ,titr1 ,indx ,nindx,
804 . lsubmodel)
805C----------------------- --
806 IF (nadmesh==0) THEN
807 numel = numelc
808 CALL surftag(numel,ixc,nixc,2,5,3,ipartc,
809 . buftmp,igrsurf(igs),nseg,flag,nindx,
810 . indx,surf_elm)
811 numel = numeltg
812 CALL surftag(numel,ixtg,nixtg,2,4,7,iparttg,
813 . buftmp,igrsurf(igs),nseg,flag,nindx,
814 . indx,surf_elm)
815 ELSE
816 numel = numelc
817 CALL surftagadm(numel,ixc,nixc,2,5,3,ipartc,
818 . buftmp,igrsurf(igs),nseg,ipart,
819 . ksh4tree,sh4tree,flag)
820 numel = numeltg
821 CALL surftagadm(numel,ixtg,nixtg,2,4,7,iparttg,
822 . buftmp,igrsurf(igs),nseg,ipart,
823 . ksh3tree,sh3tree,flag)
824 END IF
825C----------------------- --
826 IF(iext==0)THEN
827 l1104=.false.
828 DO ii=1,numels
829 IF(iabs(buftmp(iparts(ii)))==1)THEN
830 l1104=.true.
831 CALL ancmsg(msgid=1104,
832 . msgtype=msgerror,
833 . anmode=aninfo_blind_1,
834 . prmod=msg_cumu,
835 . i1=iparts(ii),
836 . i2=ixs(11,ii))
837 ENDIF
838 ENDDO
839 IF(l1104)CALL ancmsg(msgid=1104,
840 . msgtype=msgerror,
841 . anmode=aninfo_blind_1,
842 . i1=id,
843 . c1=titr,
844 . prmod=msg_print)
845 ELSE
846 DO ii=numels8+numels10+1,numels
847 IF(iabs(buftmp(iparts(ii)))==1)THEN
848 CALL ancmsg(msgid=651,
849 . msgtype=msgerror,
850 . anmode=aninfo,
851 . i1=id,
852 . c1=titr)
853 ENDIF
854 ENDDO
855 END IF
856C-------------------------
857 nseg0 = igrsurf(igs)%NSEG
858 CALL ssurftag(ixs ,iparts ,nseg0 ,igrsurf(igs),buftmp,
859 2 nseg ,knod2els,nod2els ,iext ,flag ,
860 3 ixs10 ,ixs16 ,ixs20 ,ifre ,key ,
861 4 knod2elc,nod2elc ,knod2eltg,nod2eltg,
862 5 ixc ,ixtg ,ipartc ,iparttg ,nindx,
863 6 nindx_sol, nindx_sol10, indx, indx_sol, indx_sol10,
864 7 surf_elm)
865 IF (flag == 0) THEN
866 igrsurf(igs)%NSEG = nseg
867 ENDIF
868C-------------------------
869 ENDIF
870C reset BUFTMP to 0 (only where it was set to 1/-1)
871 DO ii=1,nindx
872 buftmp(indx(ii))=0
873 END DO
874 nindx=0
875 ENDDO
876 ENDIF
877C=======================================================================
878C SURFACE FROM GROUP OF SHELLS (4N ET 3N)
879C=======================================================================
880 IF (it4 /= 0) THEN
881 CALL hm_option_start('/SURF')
882 DO igs=1,nsurf
883 CALL hm_option_read_key(lsubmodel,
884 . option_id = id,
885 . option_titr = titr ,
886 . unit_id = uid,
887 . keyword2 = key ,
888 . keyword3 = key2)
889 nseg=0
890 nseg_tot=0
891 cont=1
892C----------- --
893 IF (key(1:6)=='GRSHEL') THEN
894!
895 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
896 nseg0 = igrsurf(igs)%NSEG
897 CALL my_alloc(igrsurf(igs)%NODES,nseg0,4)
898 igrsurf(igs)%NODES(1:nseg0,1:4) = 0
899 CALL my_alloc(igrsurf(igs)%ELTYP,nseg0)
900 igrsurf(igs)%ELTYP(1:nseg0) = 0
901 CALL my_alloc(igrsurf(igs)%ELEM,nseg0)
902 igrsurf(igs)%ELEM(1:nseg0) = 0
903!
904 IF (nvolu + nmonvol > 0) THEN
905 nseg0 = igrsurf(igs)%NSEG
906 ! Keep track of the "reversed surface" -> when /SURF/PART comes
907 ! with a negative part_id
908 CALL my_alloc(igrsurf(igs)%REVERSED, nseg0)
909 ENDIF
910 ENDIF
911!
912 numel=numelc
913 flag_grbric=.false.
914 CALL hm_surfgr2(ngrshel ,key(1:6),numel ,igrsurf(igs)%ID,
915 . igrsh4n ,buftmp ,titr ,titr1 ,
916 . indx ,nindx ,flag ,nindx_sol,nindx_sol10,
917 . indx_sol,indx_sol10 ,flag_grbric,lsubmodel)
918 CALL surftage(numel,ixc,nixc,2,5,3,
919 . buftmp,igrsurf(igs),nseg,flag,
920 . indx,nindx,nseg_tot)
921 IF (flag == 0) THEN
922 igrsurf(igs)%NSEG = nseg
923 ENDIF
924C---
925 ELSEIF (key(1:6)=='GRSH3N' .OR. key(1:6)=='GRTRIA') THEN
926!
927 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
928 nseg0 = igrsurf(igs)%NSEG
929 CALL my_alloc(igrsurf(igs)%NODES,nseg0,4)
930 igrsurf(igs)%NODES(1:nseg0,1:4) = 0
931 CALL my_alloc(igrsurf(igs)%ELTYP,nseg0)
932 igrsurf(igs)%ELTYP(1:nseg0) = 0
933 CALL my_alloc(igrsurf(igs)%ELEM,nseg0)
934 igrsurf(igs)%ELEM(1:nseg0) = 0
935!
936 IF (nvolu + nmonvol > 0) THEN
937 nseg0 = igrsurf(igs)%NSEG
938 ! Keep track of the "reversed surface" -> when /SURF/PART comes
939 ! with a negative part_id
940 CALL my_alloc(igrsurf(igs)%REVERSED, nseg0)
941 ENDIF
942 ENDIF
943!
944 numel=numeltg
945 flag_grbric=.false.
946 CALL hm_surfgr2(ngrsh3n ,key(1:6),numel ,igrsurf(igs)%ID,
947 . igrsh3n ,buftmp ,titr ,titr1 ,
948 . indx ,nindx ,flag ,nindx_sol,nindx_sol10,
949 . indx_sol,indx_sol10 ,flag_grbric,lsubmodel)
950 CALL surftage(numel,ixtg,nixtg,2,4,7,
951 . buftmp,igrsurf(igs),nseg,flag,
952 . indx,nindx,nseg_tot)
953 IF (flag == 0) THEN
954 igrsurf(igs)%NSEG = nseg
955 ENDIF
956 ENDIF
957 !reset BUFTMP to 0 (only where it was set to 1/-1)
958 DO ii=1,nindx
959 buftmp(indx(ii))=0
960 END DO
961 nindx=0
962C-----------
963 enddo!next IGS
964 endif!(it4 /= 0)
965
966C=======================================================================
967C SURFACE WITH FORMAL EQUATION (ETC).
968C=======================================================================
969 mad=0
970 IF (it5 /= 0 .AND. flag == 1)THEN
971
972 CALL hm_option_start('/SURF')
973 DO igs=1,nsurf
974 CALL hm_option_read_key(lsubmodel,
975 . option_id = id,
976 . option_titr = titr ,
977 . unit_id = uid,
978 . keyword2 = key ,
979 . keyword3 = key2 ,
980 . submodel_id = sub_id)
981 igrsurf(igs)%TITLE = titr
982 IF(key(1:6)=='ELLIPS')THEN
983 igrsurf(igs)%ID = id
984 igrsurf(igs)%TYPE = 101
985 igrsurf(igs)%IAD_BUFR = mad
986 mfi=mfi+36
987 dgr1=0
988 CALL hm_get_intv ('SKEW' ,iskew,is_available,lsubmodel)
989 CALL hm_get_intv ('n' ,dgr1,is_available,lsubmodel)
990 !skew:temporary storage of user id
991 igrsurf(igs)%ID_MADYMO = iskew
992 !get internal id from user id
993 lfound=.false.
994 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
995 IF(iskew==iskn(4,j+1)) THEN
996 iskew=j+1
997 lfound=.true.
998 EXIT
999 ENDIF
1000 END DO
1001 IF(.NOT.lfound)THEN
1002 CALL ancmsg(msgid=184,
1003 . msgtype=msgerror,
1004 . anmode=aninfo,
1005 . c1='SURFACE',
1006 . i1=id,
1007 . c2='SURFACE',
1008 . c3=titr,
1009 . i2=iskew)
1010C
1011 ELSE
1012C Init surface rotation
1013 DO j=1,9
1014 bufsf(mad+7+j-1)=skew(j,iskew)
1015 END DO
1016 ENDIF
1017C
1018 CALL hm_get_floatv ('Xc' ,xg,is_available,lsubmodel,unitab)
1019 CALL hm_get_floatv ('Yc' ,yg,is_available,lsubmodel,unitab)
1020 CALL hm_get_floatv ('Zc' ,zg,is_available,lsubmodel,unitab)
1021 IF(sub_id /= 0)CALL subrotpoint(xg,yg,zg,rtrans,sub_id,lsubmodel)
1022 bufsf(mad+4)=xg
1023 bufsf(mad+5)=yg
1024 bufsf(mad+6)=zg
1025 !Init application point for force and momentum
1026 !/* ellipsoides : defining center ! */
1027 bufsf(mad+16)=xg
1028 bufsf(mad+17)=yg
1029 bufsf(mad+18)=zg
1030 dgr=0
1031
1032 CALL hm_get_floatv ('a' ,S_A,IS_AVAILABLE,LSUBMODEL,UNITAB)
1033 CALL HM_GET_FLOATV ('b' ,s_b,is_available,lsubmodel,unitab)
1034 CALL hm_get_floatv ('c' ,s_c,is_available,lsubmodel,unitab)
1035 dgr = 0
1036 IF ( s_a==0. .OR. s_b==0. .OR. s_c==0.) THEN
1037 CALL ancmsg(msgid=185,
1038 . msgtype=msgerror,
1039 . anmode=aninfo,
1040 . i1=id,
1041 . c1=titr)
1042 ENDIF
1043 IF (dgr==0.AND.dgr1==0) THEN
1044 dgr1=2
1045 ELSEIF (dgr1==0) THEN
1046 dgr1=dgr
1047 ENDIF
1048
1049 bufsf(mad+1)=s_a
1050 bufsf(mad+2)=s_b
1051 bufsf(mad+3)=s_c
1052 bufsf(mad+36)=dgr1
1053
1054 mad=mad+36
1055 ELSEIF (key(1:8)=='MDELLIPS')THEN
1056 igrsurf(igs)%ID = id
1057 igrsurf(igs)%TYPE = 100
1058 igrsurf(igs)%IAD_BUFR = mad
1059 mfi=mfi+43
1060 CALL hm_get_intv ('MDELLIPS' ,refmad,is_available,lsubmodel)
1061 !ID MaDyMo of entity which imposes the surface movement
1062 igrsurf(igs)%ID_MADYMO = refmad
1063 !Madymo syst id of entity which imposes the surface movement
1064 !(computed in Radioss Engine, when receiving Datas from MaDyMo).
1065 igrsurf(igs)%NB_MADYMO = 0
1066 mad=mad+43
1067 ENDIF
1068 ENDDO
1069 ENDIF
1070C=======================================================================
1071C INFINITE PLANE
1072C=======================================================================
1073 iadpl = mad
1074 IF (it9 /= 0 .AND. flag == 1)THEN
1075 CALL hm_option_start('/SURF')
1076 DO igs=1,nsurf
1077 CALL hm_option_read_key(lsubmodel,
1078 . option_id = id,
1079 . option_titr = titr ,
1080 . unit_id = uid,
1081 . keyword2 = key ,
1082 . keyword3 = key2,
1083 . submodel_id = sub_id)
1084 igrsurf(igs)%TITLE = titr
1085 iflagunit = 0
1086 DO j=1,unitab%NUNITS
1087 IF (unitab%UNIT_ID(j) == uid) THEN
1088 fac_l = unitab%FAC_L(j)
1089 iflagunit = 1
1090 EXIT
1091 ENDIF
1092 ENDDO
1093 IF (uid/=0.AND.iflagunit==0) THEN
1094 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
1095 . i2=uid,i1=id,c1='SURFACE',
1096 . c2='SURFACE',
1097 . c3=titr)
1098 ENDIF
1099
1100 IF(key(1:6)=='PLANE')THEN
1101 igrsurf(igs)%ID = id
1102 igrsurf(igs)%TYPE = 200
1103 igrsurf(igs)%IAD_BUFR = iadpl
1104 mfi=mfi+6
1105
1106 xp1 = zero
1107 yp1 = zero
1108 zp1 = zero
1109 xp2 = zero
1110 yp2 = zero
1111 zp2 = zero
1112
1113 CALL hm_get_floatv ('X_A' ,xp1,is_available,lsubmodel,unitab)
1114 CALL hm_get_floatv ('Y_A' ,yp1,is_available,lsubmodel,unitab)
1115 CALL hm_get_floatv ('Z_A' ,zp1,is_available,lsubmodel,unitab)
1116 IF(sub_id /= 0)CALL subrotpoint(xp1,yp1,zp1,rtrans,sub_id,lsubmodel)
1117
1118 CALL hm_get_floatv ('X_B' ,xp2,is_available,lsubmodel,unitab)
1119 CALL hm_get_floatv ('Y_B' ,yp2,is_available,lsubmodel,unitab)
1120 CALL hm_get_floatv ('Z_B' ,zp2,is_available,lsubmodel,unitab)
1121 IF(sub_id /= 0)CALL subrotpoint(xp2,yp2,zp2,rtrans,sub_id,lsubmodel)
1122
1123 vectx = (xp2-xp1)*(xp2-xp1)
1124 vecty = (yp2-yp1)*(yp2-yp1)
1125 vectz = (zp2-zp1)*(zp2-zp1)
1126 vect = sqrt(vectx+vecty+vectz)
1127 IF(vect <= em10)THEN
1128 CALL ancmsg(msgid=891,
1129 . msgtype=msgerror,
1130 . anmode=aninfo,
1131 . i1=id,
1132 . c1=titr)
1133 ENDIF
1134C Normal Vector
1135 bufsf(iadpl+1)=xp1
1136 bufsf(iadpl+2)=yp1
1137 bufsf(iadpl+3)=zp1
1138 bufsf(iadpl+4)=xp2
1139 bufsf(iadpl+5)=yp2
1140 bufsf(iadpl+6)=zp2
1141C
1142 iadpl=iadpl+6
1143 ENDIF
1144 ENDDO
1145!
1146 mad = iadpl
1147 ENDIF
1148C=======================================================================
1149 DEALLOCATE(buftmp,indx)
1150 IF(it2/=0.OR.it6/=0)THEN
1151 mode = 1
1152 CALL deallocate_surf_elm(npart,surf_elm,mode)
1153 DEALLOCATE( surf_elm )
1154 ENDIF
1155 RETURN
1156
1157 CALL ancmsg(msgid=189,
1158 . msgtype=msgerror,
1159 . anmode=aninfo,
1160 . i1=igrsurf(igs)%ID)
1161 RETURN
sboxboxsurf
subroutine sboxboxsurf(ixs, x, nseg, knod2els, nod2els, iext, flag, ixs10, ixs16, ixs20, skew, ibox, id, ibufbox, iadb, key, sbufbox, titr, knod2elc, nod2elc, ixc, tagshellboxc, knod2eltg, nod2eltg, ixtg, tagshellboxg, igrsurf, nn, nseg0, lsubmodel)
Definition bigbox.F:1955
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
hm_bigsbox
subroutine hm_bigsbox(numel, ix, nix, nix1, nix2, ieltyp, x, nseg, flag, skew, iskn, isurf0, itabm1, ibox, id, ibufbox, isurflin, iadb, key, sbufbox, titr, mess, tagshellbox, nn, lsubmodel)
Definition hm_bigsbox.F:44
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_submodpart
subroutine hm_submodpart(isubmod, tagbuf, ipart, id, flag, mess, titr, titr1, indx, nindx, lsubmodel)
Definition hm_submodpart.F:41
hm_surfgr2
subroutine hm_surfgr2(ngrele, elchar, numel, id, igrelem, tagbuf, titr, titr1, indx, nindx, flag, nindx_sol, nindx_sol10, indx_sol, indx_sol10, flag_grbric, lsubmodel)
Definition hm_surfgr2.F:40
hm_tagpart2
subroutine hm_tagpart2(bufftmp, ipart, key, id, titr, titr1, indx, nindx, flag, subset, lsubmodel, map)
Definition hm_tagpart2.F:43
init_surf_elm
subroutine init_surf_elm(numels, numels8, numels10, numelc, numeltg, numelt, numelp, numelr, npart, iparts, ipartc, iparttg, ipartt, ipartp, ipartr, surf_elm, mode)
Definition init_surf_elm.F:35
deallocate_surf_elm
subroutine deallocate_surf_elm(npart, surf_elm, mode)
Definition init_surf_elm.F:200
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
mapping_option_mod
Definition dichotomy_mod.F:36
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
optiondef_mod
Definition optiondef_mod.F:90
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
surf_mod
Definition surf_mod.F:37
surf_mod::ext_surf
integer, parameter ext_surf
definition of /EXT surface
Definition surf_mod.F:42
surf_mod::all_surf
integer, parameter all_surf
definition of /ALL surface
Definition surf_mod.F:43
unitab_mod
Definition unitab_mod.F:517
qsurftag
subroutine qsurftag(ixq, ipartq, nseg0, igrsurf, tagbuf, nseg, knod2elq, nod2elq, iext, flag, x)
Definition qsurftag.F:34
ssurftag
subroutine ssurftag(ixs, iparts, nseg0, igrsurf, tagbuf, nseg, knod2els, nod2els, iext, flag, ixs10, ixs16, ixs20, ifre, key, knod2elc, nod2elc, knod2eltg, nod2eltg, ixc, ixtg, ipartc, iparttg, nindx, nindx_sol, nindx_sol10, indx, indx_sol, indx_sol10, surf_elm)
Definition ssurftag.F:39
ssurftagigeo
subroutine ssurftagigeo(ixig3d, ipartig3d, kxig3d, tagbuf, nseg, iext, flag, ifre, key, nsegige, knot, igeo, wige, x, v, knod2elig3d, nod2elig3d, nige, rige, xige, vige, iadtabige, decaligeo, igrsurf, knotlocpc, knotlocel)
Definition ssurftagigeo.F:38
ancmsg
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)
Definition message.F:895
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146
udouble_igr
subroutine udouble_igr(list, nlist, mess, ir, rlist)
Definition sysfus.F:1204
subrotpoint
subroutine subrotpoint(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:180
surftag
subroutine surftag(numel, ix, nix, nix1, nix2, ieltyp, iparte, tagbuf, isu, nseg, flag, nindx, indx, surf_elm)
Definition surftag.F:34
surftagadm
subroutine surftagadm(numel, ix, nix, nix1, nix2, ieltyp, iparte, tagbuf, igrsurf, nseg, ipart, kshtree, shtree, flag)
Definition surftag.F:137
surftage
subroutine surftage(numel, ix, nix, nix1, nix2, ieltyp, tagbuf, isu, nseg, flag, indx, nindx, nseg_tot)
Definition surftage.F:33
segsurf
subroutine segsurf(n1, n2, n3, n4, nseg0, iseg, surf_nodes, surf_eltyp, surf_elem, elem, elty)
Definition tsurftag.F:295
tsurftag
subroutine tsurftag(ixs, ixs10, igrsurf, flag, nseg, knod2els, nod2els, n1, n2, n3, nseg0)
Definition tsurftag.F:35