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