OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_bem.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_preread_bem ../starter/source/loads/bem/hm_read_bem.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| arret ../starter/source/system/arret.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
32!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
33!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
34!||--- uses -----------------------------------------------------
35!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_preread_bem(IGRSURF,IGRNOD, NNFT ,
40 . UNITAB, NOM_OPT, LSUBMODEL)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE unitab_mod
45 USE message_mod
46 USE groupdef_mod
47 USE submodel_mod
48 USE hm_option_read_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "scr17_c.inc"
60#include "flowcom.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
65 INTEGER NNFT
66 INTEGER NOM_OPT(LNOPT1,*)
67C-----------------------------------------------
68 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
69 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
70 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I, ID, ITYP, II, NINOUT, J, ISU, NN, IAD, ITAG(NUMNOD),
75 . iad1, nel, j1, j2, j3, j4, ish34, nno, l, ibid,
76 . iii, igr, nnn, uid, iflagunit, iunit
77 INTEGER JFORM, FREESURF, NELMAX, HG
78 my_real
79 . rbid
80 CHARACTER(LEN=NCHARTITLE)::TITR
81 LOGICAL :: IS_AVAILABLE
82 INTEGER :: HM_NDAA, HM_NFLOW
83
84 hm_ndaa = 0
85 hm_nflow = 0
86 CALL hm_option_count('/BEM/DAA', hm_ndaa)
87 CALL hm_option_count('/BEM/FLOW', hm_nflow)
88C
89 liflow=0
90 lrflow=0
91 nnft=0
92 CALL hm_option_start('/BEM/FLOW')
93 DO i = 1, hm_nflow
94 CALL hm_option_read_key(lsubmodel, option_titr = titr, option_id = id)
95
96 ityp = 1
97C
98 CALL hm_get_intv('surf_IDex', ii, is_available, lsubmodel)
99 CALL hm_get_intv('Nio', ninout, is_available, lsubmodel)
100 isu=0
101 DO j=1,nsurf
102 IF (ii==igrsurf(j)%ID) isu=j
103 ENDDO
104 IF (isu==0) THEN
105 CALL ancmsg(msgid=621,msgtype=msgerror,anmode=aninfo,
106 . i1=id,c1=titr,c2='SURFACE',i2=ii)
107 ENDIF
108C
109 nn=igrsurf(isu)%NSEG
110 DO j=1,numnod
111 itag(j)=0
112 ENDDO
113 nel=0
114 DO j=1,nn
115 j1=igrsurf(isu)%NODES(j,1)
116 j2=igrsurf(isu)%NODES(j,2)
117 j3=igrsurf(isu)%NODES(j,3)
118 j4=igrsurf(isu)%NODES(j,4)
119 ish34=igrsurf(isu)%ELTYP(j)
120 itag(j1)=1
121 itag(j2)=1
122 itag(j3)=1
123 IF (ish34==3) THEN
124 nel=nel+2
125 itag(j4)=1
126 ELSEIF (ish34==7) THEN
127 nel=nel+1
128 ENDIF
129 ENDDO
130 nno=0
131 DO j=1,numnod
132 IF (itag(j)==1) nno=nno+1
133 ENDDO
134 nnft=nnft+nno
135C
136 CALL hm_get_intv('grn_IDaux', iii, is_available, lsubmodel)
137
138 nnn=0
139 IF (iii/=0) THEN
140 igr=0
141 DO j=1,ngrnod
142 IF (igrnod(j)%ID==iii) igr=j
143 ENDDO
144 IF (igr==0) THEN
145 CALL ancmsg(msgid=621,
146 . msgtype=msgerror,
147 . anmode=aninfo,
148 . i1=id,
149 . c1=titr,
150 . c2='NODE GROUP',
151 . i2=iii)
152 ENDIF
153 nnn=igrnod(igr)%NENTITY
154 ENDIF
155C
156 IF (nspmd == 1) THEN
157 liflow=liflow+niflow+nno+3*nel+ninout*niioflow+nnn+nel+nno+nnn
158 ELSE
159 liflow=liflow+niflow+nno+3*nel+ninout*niioflow+nnn+nel+4*nno+2*nnn+2*nel
160 ENDIF
161 lrflow=lrflow+nrflow+5*(nno+nnn)+ninout*nrioflow
162
163 ENDDO
164C
165
166
167 CALL hm_option_start('/BEM/DAA')
168 DO i = 1, hm_ndaa
169 CALL hm_option_read_key(lsubmodel, option_titr = titr, option_id = id)
170
171 ityp = 3
172C DAA SURFACES
173 nelmax=0
174 CALL hm_get_intv('surf_ID', ii, is_available, lsubmodel)
175 CALL hm_get_intv('Freesurf', freesurf, is_available, lsubmodel)
176 jform=2
177 IF(freesurf == 0) freesurf=1
178 isu=0
179 DO j=1,nsurf
180 IF (ii==igrsurf(j)%ID) isu=j
181 ENDDO
182 IF (isu==0) THEN
183 CALL ancmsg(msgid=1603,msgtype=msgerror,anmode=aninfo,
184 . i1=id,c1=titr,c2='SURFACE NUMBER NOT FOUND')
185 ENDIF
186C
187 nn= igrsurf(isu)%NSEG
188 DO j=1,numnod
189 itag(j)=0
190 ENDDO
191 nel=0
192 DO j=1,nn
193 j1=igrsurf(isu)%NODES(j,1)
194 j2=igrsurf(isu)%NODES(j,2)
195 j3=igrsurf(isu)%NODES(j,3)
196 j4=igrsurf(isu)%NODES(j,4)
197 ish34=igrsurf(isu)%ELTYP(j)
198 itag(j1)=1
199 itag(j2)=1
200 itag(j3)=1
201 IF (ish34==3) THEN
202 itag(j4)=1
203 IF(jform == 1) THEN
204 nel=nel+2
205 ELSEIF(jform == 2) THEN
206 nel=nel+1
207 ENDIF
208 ELSEIF (ish34==7) THEN
209 nel=nel+1
210 ENDIF
211 ENDDO
212 nno=0
213 DO j=1,numnod
214 IF (itag(j)==1) nno=nno+1
215 ENDDO
216 IF(nspmd == 1) THEN
217 IF(jform == 1) THEN
218 liflow=liflow+niflow+nno+3*nel+nno
219 ELSEIF(jform == 2) THEN
220 liflow=liflow+niflow+nno+5*nel+nno+nbgauge
221 ENDIF
222 ELSE
223 IF(jform == 1) THEN
224 liflow=liflow+niflow+nno+3*nel+nno+nno+2*nel
225 ELSEIF(jform == 2) THEN
226 liflow=liflow+niflow+nno+5*nel+nno+nbgauge+nno+2*nel
227 ENDIF
228 ENDIF
229 hg = huge(nel)
230 IF (nel > int(sqrt(real(hg)))) THEN
231 CALL ancmsg(msgid = 1711, anmode=aninfo, msgtype = msgerror,
232 . i1 = int(sqrt(real(hg))))
233 CALL arret(2)
234 ENDIF
235 IF(nel < nelmax) THEN
236 lrflow=lrflow+nrflow+7*nel+nel*nel+3*nel
237 ELSE
238 liflow=liflow+nel
239 lrflow=lrflow+nrflow+7*nel+2*nel*nel+3*nel
240 ENDIF
241 IF(freesurf == 2) lrflow=lrflow+3*nel
242 ENDDO
243C
244 RETURN
245 END
246!||====================================================================
247!|| hm_read_bem ../starter/source/loads/bem/hm_read_bem.F
248!||--- called by ------------------------------------------------------
249!|| lectur ../starter/source/starter/lectur.f
250!||--- calls -----------------------------------------------------
251!|| ancmsg ../starter/source/output/message/message.F
252!|| arret ../starter/source/system/arret.F
253!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
254!|| hm_get_float_array_index_dim ../starter/source/devtools/hm_reader/hm_get_float_array_index_dim.F
255!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
256!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
257!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
258!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
259!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
260!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
261!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
262!|| init_qd ../starter/source/fluid/init_qd.F
263!|| init_tg ../starter/source/fluid/init_tg.F
264!|| mass_fluid_qd ../starter/source/fluid/mass-fluid_qd.F
265!|| mass_fluid_tg ../starter/source/fluid/mass-fluid_tg.F
266!||--- uses -----------------------------------------------------
267!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
268!|| message_mod ../starter/share/message_module/message_mod.F
269!|| submodel_mod ../starter/share/modules1/submodel_mod.F
270!||====================================================================
271 SUBROUTINE hm_read_bem(IGRSURF, IFLOW , RFLOW ,
272 . NPC , IGRNOD , MEMFLOW,UNITAB,
273 . X , NOM_OPT , LGAUGE ,IGRV, LSUBMODEL,IRESP)
274C-----------------------------------------------
275C M o d u l e s
276C-----------------------------------------------
277 USE unitab_mod
278 USE message_mod
279 USE groupdef_mod
280 USE submodel_mod
281 USE hm_option_read_mod
282 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
283C-----------------------------------------------
284C I m p l i c i t T y p e s
285C-----------------------------------------------
286#include "implicit_f.inc"
287C-----------------------------------------------
288C C o m m o n B l o c k s
289C-----------------------------------------------
290#include "com01_c.inc"
291#include "com04_c.inc"
292#include "scr17_c.inc"
293#include "param_c.inc"
294#include "units_c.inc"
295#include "flowcom.inc"
296C-----------------------------------------------
297C D u m m y A r g u m e n t s
298C-----------------------------------------------
299 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
300 INTEGER IFLOW(*),NPC(*)
301 INTEGER NOM_OPT(LNOPT1,*), LGAUGE(3,*), IGRV(NIGRV,*)
302 INTEGER(KIND=8) MEMFLOW(*)
303 my_real rflow(*), x(3,*)
304 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
305 INTEGER,INTENT(IN) :: IRESP
306C-----------------------------------------------
307 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
308 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
309C-----------------------------------------------
310C L o c a l V a r i a b l e s
311C-----------------------------------------------
312 INTEGER IADI, IADR, I, ID, ITYP, II, NINOUT, ISU, J, IPIMP,
313 . NN, IAD, ITAG(NUMNOD), IAD1, IAD2, J1, J2, J3, J4, ISH34,
314 . NNO, ITABINV(NUMNOD), NEL, IVFREE, IFVEL, IFPRES,
315 . k, ifunc, l, ifpa, iadmati, iadmatr, iii, igr, nnn,
316 . nbloc, iform, ilvout, itagio(numnod), ng1, ng2, ng3, ng4,
317 . n1, n2, n3, n4, prod, nprow, npcol, itest, ivini, ifvini,
318 . iinside, nrmax, nr, isuio,nflow0, nblocmax, uid,
319 . iflagunit,iunit
320 INTEGER JFORM, KFORM, II1, II2, II3, II4, II5, II6
321 INTEGER IR1, IR2, IR3,IR4, IR5, IR6, IR7, IR8, IR9, IR10, IR11
322 INTEGER IPRES, IWAVE, INTEGR, FREESURF, AFTERFLOW, GRAV_ID, NELMAX, IBID, HG
323 INTEGER, DIMENSION(:), ALLOCATABLE :: N_SHELL
324 my_real sfpa, sfvel, sfpres, scalt, dtsub, rho, tole, scalt_pa,
325 . sfvini, dirx, diry, dirz, norm, rnspmd, scalt_vi
326 my_real xc, yc, zc, xs, ys, zs, ssp, pmax, theta
327 my_real apmax, atheta, pmin
328 my_real xa, ya, za, xd, yd, zd, tt
329 my_real, DIMENSION(:,:), ALLOCATABLE :: cbem
330 my_real :: fac_gen
331 CHARACTER(LEN=NCHARKEY) :: KEY
332 CHARACTER(LEN=NCHARTITLE) :: TITR
333 LOGICAL :: IS_AVAILABLE
334 INTEGER :: HM_NDAA, HM_NFLOW
335C-----------------------------------------------
336 hm_ndaa = 0
337 hm_nflow = 0
338 CALL hm_option_count('/BEM/DAA', hm_ndaa)
339 CALL hm_option_count('/BEM/FLOW', hm_nflow)
340C
341 iadi=0
342 iadr=0
343 iadmati=1
344 iadmatr=1
345 nflow0=nflow
346 ifunc = 0
347
348 CALL hm_option_start('/BEM/FLOW')
349
350 DO i=1,hm_nflow
351 CALL hm_option_read_key(lsubmodel, option_titr = titr, option_id = id)
352
353 ityp = 1
354 CALL hm_get_intv('surf_IDex', ii, is_available, lsubmodel)
355 CALL hm_get_intv('Nio', ninout, is_available, lsubmodel)
356 CALL hm_get_intv('Iinside', iinside, is_available, lsubmodel)
357 CALL hm_get_intv('Ifsp', ifpa, is_available, lsubmodel)
358 CALL hm_get_floatv('Fscalesp', sfpa, is_available, lsubmodel, unitab)
359 CALL hm_get_floatv('Ascalesp', scalt, is_available, lsubmodel, unitab)
360
361 isu=0
362 DO j=1,nsurf
363 IF (ii==igrsurf(j)%ID) isu=j
364 ENDDO
365 scalt_pa=scalt
366C
367 nn=igrsurf(isu)%NSEG
368 DO j=1,numnod
369 itag(j)=0
370 ENDDO
371 DO j=1,nn
372 j1=igrsurf(isu)%NODES(j,1)
373 j2=igrsurf(isu)%NODES(j,2)
374 j3=igrsurf(isu)%NODES(j,3)
375 j4=igrsurf(isu)%NODES(j,4)
376 ish34=igrsurf(isu)%ELTYP(j)
377 itag(j1)=1
378 itag(j2)=1
379 itag(j3)=1
380 IF (ish34==3) itag(j4)=1
381 ENDDO
382 nno=0
383 DO j=1,numnod
384 IF (itag(j)==1) THEN
385 nno=nno+1
386 iflow(iadi+niflow+nno)=j
387 itabinv(j)=nno
388 ENDIF
389 ENDDO
390 nel=0
391 DO j=1,nn
392 j1=igrsurf(isu)%NODES(j,1)
393 j2=igrsurf(isu)%NODES(j,2)
394 j3=igrsurf(isu)%NODES(j,3)
395 j4=igrsurf(isu)%NODES(j,4)
396 ish34=igrsurf(isu)%ELTYP(j)
397 IF (ish34==7) THEN
398 nel=nel+1
399 iflow(iadi+niflow+nno+3*(nel-1)+1)=itabinv(j1)
400 iflow(iadi+niflow+nno+3*(nel-1)+2)=itabinv(j2)
401 iflow(iadi+niflow+nno+3*(nel-1)+3)=itabinv(j3)
402 ELSEIF (ish34==3) THEN
403 nel=nel+1
404 iflow(iadi+niflow+nno+3*(nel-1)+1)=itabinv(j1)
405 iflow(iadi+niflow+nno+3*(nel-1)+2)=itabinv(j2)
406 iflow(iadi+niflow+nno+3*(nel-1)+3)=itabinv(j4)
407 nel=nel+1
408 iflow(iadi+niflow+nno+3*(nel-1)+1)=itabinv(j2)
409 iflow(iadi+niflow+nno+3*(nel-1)+2)=itabinv(j3)
410 iflow(iadi+niflow+nno+3*(nel-1)+3)=itabinv(j4)
411 ENDIF
412 ENDDO
413C
414 IF (iinside/=2) iinside=1
415C
416 ipimp=0
417 IF (ifpa/=0) THEN
418 ifunc=0
419 DO j=1,nfunct
420 IF (ifpa==npc(j)) ifunc=j
421 ENDDO
422 IF (ifunc==0) THEN
423 CALL ancmsg(msgid=621,
424 . msgtype=msgerror,
425 . anmode=aninfo,
426 . i1=id,
427 . c1=titr,
428 . c2='FUNCTION',
429 . i2=ifpa)
430 ENDIF
431 ifpa=ifunc
432 ipimp=ipimp+1
433 ENDIF
434C
435 CALL hm_get_intv('grn_IDaux', iii, is_available, lsubmodel)
436 CALL hm_get_intv('Itest', itest, is_available, lsubmodel)
437 CALL hm_get_floatv('Tole', tole, is_available, lsubmodel, unitab)
438
439 IF (iinside==2.AND.itest==1) itest=2
440 IF (tole==zero) tole=em5
441C
442 CALL hm_get_floatv('Rho', rho, is_available, lsubmodel, unitab)
443 CALL hm_get_intv('Ivinf', ivini, is_available, lsubmodel)
444C
445 nnn=0
446 IF (iii/=0) THEN
447 DO j=1,ngrnod
448 IF (igrnod(j)%ID==iii) igr=j
449 ENDDO
450 nnn=igrnod(igr)%NENTITY
451 DO j=1,nnn
452 iflow(iadi+niflow+nno+3*nel+ninout*niioflow+j)=
453 . igrnod(igr)%ENTITY(j)
454 ENDDO
455 ENDIF
456C
457 ivfree=0
458 DO j = 1, ninout
459 CALL hm_get_int_array_index('surf_IDio', ii, j, is_available, lsubmodel)
460 CALL hm_get_int_array_index('fct_IDvel', ifvel, j, is_available, lsubmodel)
461 CALL hm_get_int_array_index('fct_IDpr', ifpres, j, is_available, lsubmodel)
462 CALL hm_get_float_array_index('Fscalenv', sfvel, j, is_available, lsubmodel, unitab)
463 CALL hm_get_float_array_index('Fscalepres', sfpres, j, is_available, lsubmodel, unitab)
464 CALL hm_get_float_array_index('Ascalet', scalt, j, is_available, lsubmodel, unitab)
465
466
467 IF(sfvel == zero) THEN
468 CALL hm_get_float_array_index_dim('Sfvel', fac_gen, j, is_available, lsubmodel, unitab)
469 sfvel = one * fac_gen
470 ENDIF
471 IF(sfpres == zero) THEN
472 CALL hm_get_float_array_index_dim('Sfpres', fac_gen, j, is_available, lsubmodel, unitab)
473 sfpres = one * fac_gen
474 ENDIF
475 IF(scalt == zero) THEN
476 CALL hm_get_float_array_index_dim('Scal_t', fac_gen, j, is_available, lsubmodel, unitab)
477 scalt = one * fac_gen
478 ENDIF
479C
480 isuio=0
481 DO k=1,nsurf
482 IF (ii==igrsurf(k)%ID) isuio=k
483 ENDDO
484 IF (isuio==0) THEN
485 CALL ancmsg(msgid=621,
486 . msgtype=msgerror,
487 . anmode=aninfo,
488 . i1=id,
489 . c1=titr,
490 . c2='SURFACE',
491 . i2=ii)
492 ENDIF
493 iflow(iadi+niflow+nno+3*nel+niioflow*(j-1)+1)=isuio
494C
495 iflow(iadi+niflow+nno+3*nel+niioflow*(j-1)+2)=0
496C
497 IF (ifvel/=0) THEN
498 ifunc=0
499 DO k=1,nfunct
500 IF (ifvel==npc(k)) ifunc=k
501 ENDDO
502 IF (ifunc==0) THEN
503 CALL ancmsg(msgid=621,
504 . msgtype=msgerror,
505 . anmode=aninfo,
506 . i1=id,
507 . c1=titr,
508 . c2='FUNCTION',
509 . i2=ifvel)
510 ENDIF
511 ifvel=ifunc
512 ELSE
513 ivfree=ivfree+1
514 ENDIF
515 iflow(iadi+niflow+nno+3*nel+niioflow*(j-1)+3)=ifvel
516 rflow(iadr+nrflow+5*(nno+nnn)+nrioflow*(j-1)+1)=sfvel
517C
518 IF (ifpres/=0) THEN
519 ipimp=ipimp+1
520 ifunc=0
521 DO k=1,nfunct
522 IF (ifpres==npc(k)) ifunc=k
523 ENDDO
524 IF (ifunc==0) THEN
525 CALL ancmsg(msgid=621,
526 . msgtype=msgerror,
527 . anmode=aninfo,
528 . i1=id,
529 . c1=titr,
530 . c2='FUNCTION',
531 . i2=ifpres)
532 ENDIF
533 ifpres=ifunc
534 ENDIF
535 iflow(iadi+niflow+nno+3*nel+niioflow*(j-1)+4)=ifpres
536 rflow(iadr+nrflow+5*(nno+nnn)+nrioflow*(j-1)+2)=sfpres
537C
538 rflow(iadr+nrflow+5*(nno+nnn)+nrioflow*(j-1)+3)=scalt
539 ENDDO
540 IF (ninout>=1) THEN
541 IF (ipimp/=1) THEN
542 CALL ancmsg(msgid=622,
543 . msgtype=msgerror,
544 . anmode=aninfo,
545 . i1=id,
546 . c1=titr,
547 . c2='ONE AND ONLY ONE PRESSURE MUST BE IMPOSED')
548 ELSEIF (ivfree/=1.AND.(iinside==0.OR.
549 . (iinside==1.AND.ivini==0))) THEN
550 CALL ancmsg(msgid=622,
551 . msgtype=msgerror,
552 . anmode=aninfo,
553 . i1=id,
554 . c1=titr,
555 . c2='ONE AND ONLY ONE VELOCITY MUST BE LEFT FREE')
556 ELSEIF (ivfree/=0.AND.iinside==1.AND.ivini==1) THEN
557 CALL ancmsg(msgid=622,
558 . msgtype=msgerror,
559 . anmode=aninfo,
560 . i1=id,
561 . c1=titr,
562 . c2='NO FREE VELOCITY ALLOWED')
563 ENDIF
564 ELSE
565 IF (ifpa==0) THEN
566 CALL ancmsg(msgid=622,
567 . msgtype=msgerror,
568 . anmode=aninfo,
569 . i1=id,
570 . c1=titr,
571 . c2='NO IMPOSED PRESSURE')
572 ENDIF
573 ENDIF
574C Tag des elements d'entrees et de sorties
575 DO j=1,nno
576 itagio(j)=0
577 ENDDO
578 DO j=1,ninout
579 isuio=iflow(iadi+niflow+nno+3*nel+niioflow*(j-1)+1)
580 nn=igrsurf(isuio)%NSEG
581 DO k=1,nn
582 ng1=igrsurf(isuio)%NODES(k,1)
583 ng2=igrsurf(isuio)%NODES(k,2)
584 ng3=igrsurf(isuio)%NODES(k,3)
585 ng4=igrsurf(isuio)%NODES(k,4)
586 ish34=igrsurf(isuio)%ELTYP(k)
587 n1=itabinv(ng1)
588 n2=itabinv(ng2)
589 n3=itabinv(ng3)
590 itagio(n1)=j
591 itagio(n2)=j
592 itagio(n3)=j
593 IF (ish34==3) THEN
594 n4=itabinv(ng4)
595 itagio(n4)=j
596 ENDIF
597 ENDDO
598 ENDDO
599C
600 DO j=1,nel
601 n1=iflow(iadi+niflow+nno+3*(j-1)+1)
602 n2=iflow(iadi+niflow+nno+3*(j-1)+2)
603 n3=iflow(iadi+niflow+nno+3*(j-1)+3)
604 prod=itagio(n1)*itagio(n2)*itagio(n3)
605 iflow(iadi+niflow+nno+3*nel+ninout*niioflow+nnn+j)=0
606 IF (prod/=0)
607 . iflow(iadi+niflow+nno+3*nel+ninout*niioflow+nnn+j)=
608 . max(itagio(n1),itagio(n2),itagio(n3))
609 ENDDO
610C
611 CALL hm_get_intv('Iform', iform, is_available, lsubmodel)
612 CALL hm_get_intv('Ipri', ilvout, is_available, lsubmodel)
613 CALL hm_get_floatv('Dtflow', dtsub, is_available, lsubmodel, unitab)
614
615
616 IF (iform==0) iform=1
617C
618 nbloc=0
619 nprow=1
620 npcol=1
621 IF (nspmd > 1) THEN
622 rnspmd=nspmd
623 nrmax=int(sqrt(rnspmd))
624 IF (iform==1) THEN
625 DO nr=1,nrmax
626 IF (mod(nspmd,nr)==0) THEN
627 nprow=nr
628 npcol=nspmd/nr
629 ENDIF
630 ENDDO
631 ELSEIF (iform==2) THEN
632 nprow=nspmd
633 npcol=1
634 ENDIF
635 IF (nno<1000) THEN
636 nblocmax=32
637 ELSE
638 nblocmax=64
639 ENDIF
640 nbloc=min(nno/nprow, nno/npcol)
641 nbloc=min(nblocmax,nbloc)
642 nbloc=max(1,nbloc)
643 ENDIF
644C
645 ifvini=0
646 sfvini=zero
647 scalt_vi=zero
648 dirx=zero
649 diry=zero
650 dirz=zero
651 IF (ivini==1) THEN
652 CALL hm_get_intv('Ifvinf', ifvini, is_available, lsubmodel)
653 CALL hm_get_floatv('Fscalevel', sfvini, is_available, lsubmodel, unitab)
654 CALL hm_get_floatv('Ascalevel', scalt_vi, is_available, lsubmodel, unitab)
655
656 CALL hm_get_floatv('Dirx', dirx, is_available, lsubmodel, unitab)
657 CALL hm_get_floatv('Diry', diry, is_available, lsubmodel, unitab)
658 CALL hm_get_floatv('Dirz', dirz, is_available, lsubmodel, unitab)
659
660 ifunc=0
661 DO j=1,nfunct
662 IF (ifvini==npc(j)) ifunc=j
663 ENDDO
664 IF (ifunc==0) THEN
665 CALL ancmsg(msgid=621,
666 . msgtype=msgerror,
667 . anmode=aninfo,
668 . i1=id,
669 . c1=titr,
670 . c2='FUNCTION',
671 . i2=ifvini)
672 ENDIF
673 ifvini=ifunc
674 norm=sqrt(dirx**2+diry**2+dirz**2)
675 IF (norm==zero) THEN
676 CALL ancmsg(msgid=622,
677 . msgtype=msgerror,
678 . anmode=aninfo,
679 . i1=id,
680 . c1=titr,
681 . c2='NULL VELOCITY DIRECTION VECTOR')
682 ENDIF
683 dirx=dirx/norm
684 diry=diry/norm
685 dirz=dirz/norm
686 ENDIF
687C
688 iflow(iadi+1)=id
689 iflow(iadi+2)=ityp
690 iflow(iadi+3)=isu
691 iflow(iadi+4)=ninout
692 iflow(iadi+5)=nno
693 iflow(iadi+6)=nel
694 iflow(iadi+7)=nnn
695 iflow(iadi+8)=nno
696 iflow(iadi+9)=nno*nno+nno*(nel+1)
697 iflow(iadi+10)=iadmati
698 iflow(iadi+11)=iadmatr
699 iflow(iadi+12)=nbloc
700 iflow(iadi+13)=iform
701 IF (nspmd == 1) THEN
702 iflow(iadi+14)=niflow+nno+3*nel+ninout*niioflow+nnn+nel+nno+nnn
703 ELSE
704 iflow(iadi+14)=niflow+nno+3*nel+ninout*niioflow+nnn+nel+4*nno+2*nnn+2*nel
705 ENDIF
706 iflow(iadi+15)=nrflow+5*(nno+nnn)+ninout*nrioflow
707 iflow(iadi+17)=ilvout
708 iflow(iadi+18)=nprow
709 iflow(iadi+19)=npcol
710 iflow(iadi+20)=iadmatr+nno*nno
711 iflow(iadi+21)=itest
712 iflow(iadi+23)=ifpa
713 iflow(iadi+24)=ifvini
714 rflow(iadr+1)=sfpa
715 rflow(iadr+2)=scalt_pa
716 rflow(iadr+3)=dtsub
717 rflow(iadr+4)=zero
718 rflow(iadr+5)=rho
719 rflow(iadr+6)=tole
720 rflow(iadr+7)=sfvini
721 rflow(iadr+8)=scalt_vi
722 rflow(iadr+9)=dirx
723 rflow(iadr+10)=diry
724 rflow(iadr+11)=dirz
725 rflow(iadr+12)=zero
726C
727 memflow(1)=memflow(1)+iflow(iadi+8)
728 memflow(2)=memflow(2)+iflow(iadi+9)
729C PRINTOUTS
730 WRITE(iout,1000)
731 WRITE(iout,1100) i, id, trim(titr),igrsurf(isu)%ID, nno, nel
732 IF (iinside==1) THEN
733 WRITE(iout,1110)
734 ELSEIF (iinside==2) THEN
735 WRITE(iout,1120)
736 ENDIF
737 WRITE(iout,1200) ifpa, sfpa, scalt_pa, iii, nnn
738 IF (itest==1) THEN
739 WRITE(iout,1210)
740 WRITE(iout,1225) tole
741 ELSEIF (itest==2) THEN
742 WRITE(iout,1220)
743 WRITE(iout,1225) tole
744 ELSEIF (itest==0) THEN
745 WRITE(iout,1230)
746 ENDIF
747 WRITE(iout,1300) rho
748 WRITE(iout,1400) ninout
749 DO j=1,ninout
750 isuio=iflow(iadi+niflow+nno+3*nel+niioflow*(j-1)+1)
751 ifvel=iflow(iadi+niflow+nno+3*nel+niioflow*(j-1)+3)
752 sfvel=rflow(iadr+nrflow+5*(nno+nnn)+nrioflow*(j-1)+1)
753 ifpres=iflow(iadi+niflow+nno+3*nel+niioflow*(j-1)+4)
754 sfpres=rflow(iadr+nrflow+5*(nno+nnn)+nrioflow*(j-1)+2)
755 scalt=rflow(iadr+nrflow+5*(nno+nnn)+nrioflow*(j-1)+3)
756 WRITE(iout,1410) j, igrsurf(isuio)%ID
757 IF (ifvel>0) WRITE(iout,1420) ifvel, sfvel
758 IF (ifpres>0) WRITE(iout,1430) ifpres, sfpres
759 WRITE(iout,1440) scalt
760 ENDDO
761 WRITE(iout,1500) iform, ilvout, dtsub
762 IF (ivini==1) WRITE(iout,1600) ifvini, sfvini, scalt_vi,
763 . dirx, diry, dirz
764 IF (nspmd > 1) WRITE(iout,1700) nprow, npcol, nbloc
765C
766 iadr=iadr+iflow(iadi+15)
767 iadi=iadi+iflow(iadi+14)
768 iadmati=iadmati+nno
769 iadmatr=iadmatr+nno*nno+nno*(nel+1)
770
771 ENDDO
772
773 CALL hm_option_start('/BEM/DAA')
774
775 DO i=1,hm_ndaa
776 CALL hm_option_read_key(lsubmodel, option_titr = titr, option_id = id)
777C
778
779 CALL hm_get_intv('surf_ID', ii, is_available, lsubmodel)
780 CALL hm_get_intv('grav_ID', grav_id, is_available, lsubmodel)
781 nelmax=0
782 CALL hm_get_floatv('Rho', rho, is_available, lsubmodel, unitab)
783 CALL hm_get_floatv('C', ssp, is_available, lsubmodel, unitab)
784 CALL hm_get_floatv('Pmin', pmin, is_available, lsubmodel, unitab)
785
786 IF(pmin == zero) pmin=-ep30
787
788 CALL hm_get_floatv('Xs', xs, is_available, lsubmodel, unitab)
789 CALL hm_get_floatv('Ys', ys, is_available, lsubmodel, unitab)
790 CALL hm_get_floatv('Zs', zs, is_available, lsubmodel, unitab)
791
792 CALL hm_get_intv('Iform', iform, is_available, lsubmodel)
793 CALL hm_get_intv('Ipri', ilvout, is_available, lsubmodel)
794 CALL hm_get_intv('Ipres', ipres, is_available, lsubmodel)
795 CALL hm_get_intv('Kform', kform, is_available, lsubmodel)
796 CALL hm_get_intv('Freesurf', freesurf, is_available, lsubmodel)
797 CALL hm_get_intv('Afterflow', afterflow, is_available, lsubmodel)
798 CALL hm_get_intv('Integr', integr, is_available, lsubmodel)
799 ityp = 3
800 IF(iform == 0) iform=1
801 IF(ilvout == 0) ilvout=1
802 iwave=1
803 jform=2
804 IF(kform == 0) kform=1
805 IF(integr == 0) integr=2
806 IF(freesurf == 0) freesurf=1
807 IF(afterflow == 0) afterflow=2
808 IF (iwave ==2 .AND. freesurf == 2) THEN
809 CALL ancmsg(msgid=1603,
810 . msgtype=msgerror,
811 . anmode=aninfo,
812 . i1=id,
813 . c1=titr,
814 . c2='FREE SURFACE IS NOT COMPATIBLE WITH PLANE WAVE')
815 ENDIF
816 IF(kform ==2) integr=1
817C
818 IF(nbgauge > 0 .AND. jform == 2) ALLOCATE(n_shell(numelc))
819C
820 isu=0
821 DO j=1,nsurf
822 IF (ii==igrsurf(j)%ID) isu=j
823 ENDDO
824C
825 nn =igrsurf(isu)%NSEG
826 DO j=1,numnod
827 itag(j)=0
828 ENDDO
829 DO j=1,nn
830 j1=igrsurf(isu)%NODES(j,1)
831 j2=igrsurf(isu)%NODES(j,2)
832 j3=igrsurf(isu)%NODES(j,3)
833 j4=igrsurf(isu)%NODES(j,4)
834 ish34=igrsurf(isu)%ELTYP(j)
835 itag(j1)=1
836 itag(j2)=1
837 itag(j3)=1
838 IF (ish34==3) itag(j4)=1
839 ENDDO
840 nno=0
841 DO j=1,numnod
842 IF (itag(j)==1) THEN
843 nno=nno+1
844 iflow(iadi+niflow+nno)=j
845 itabinv(j)=nno
846 ENDIF
847 ENDDO
848 nel=0
849 DO j=1,nn
850 j1=igrsurf(isu)%NODES(j,1)
851 j2=igrsurf(isu)%NODES(j,2)
852 j3=igrsurf(isu)%NODES(j,3)
853 j4=igrsurf(isu)%NODES(j,4)
854 ish34=igrsurf(isu)%ELTYP(j)
855 IF(jform == 1) THEN
856 IF (ish34==7) THEN
857 nel=nel+1
858 iad2=iadi+niflow+nno+3*(nel-1)
859 iflow(iad2+1)=itabinv(j1)
860 iflow(iad2+2)=itabinv(j2)
861 iflow(iad2+3)=itabinv(j3)
862 ELSEIF (ish34==3) THEN
863 nel=nel+1
864 iad2=iadi+niflow+nno+3*(nel-1)
865 iflow(iad2+1)=itabinv(j1)
866 iflow(iad2+2)=itabinv(j2)
867 iflow(iad2+3)=itabinv(j4)
868 nel=nel+1
869 iad2=iadi+niflow+nno+3*(nel-1)
870 iflow(iad2+1)=itabinv(j2)
871 iflow(iad2+2)=itabinv(j3)
872 iflow(iad2+3)=itabinv(j4)
873 ENDIF
874 ELSEIF(jform == 2) THEN
875 IF (ish34==7) THEN
876 nel =nel+1
877 iad2=iadi+niflow+nno+5*(nel-1)
878 iflow(iad2+1)=itabinv(j1)
879 iflow(iad2+2)=itabinv(j2)
880 iflow(iad2+3)=itabinv(j3)
881 iflow(iad2+4)=itabinv(j3)
882 iflow(iad2+5)=2
883 IF(nbgauge > 0) n_shell(nel)=0
884 ELSEIF (ish34==3) THEN
885 nel =nel+1
886 iad2=iadi+niflow+nno+5*(nel-1)
887 iflow(iad2+1)=itabinv(j1)
888 iflow(iad2+2)=itabinv(j2)
889 iflow(iad2+3)=itabinv(j3)
890 iflow(iad2+4)=itabinv(j4)
891 iflow(iad2+5)=1
892 IF(nbgauge > 0) n_shell(nel)=igrsurf(isu)%ELEM(j)
893 ENDIF
894 ENDIF
895 ENDDO
896C
897 pmax = zero
898 theta = zero
899 apmax = zero
900 atheta = zero
901 ifpres = 0
902 sfpres = zero
903 IF(ipres == 1)THEN
904 CALL hm_get_floatv('Pm', pmax, is_available, lsubmodel, unitab)
905 CALL hm_get_floatv('Theta', theta, is_available, lsubmodel, unitab)
906 CALL hm_get_floatv('a', apmax, is_available, lsubmodel, unitab)
907 CALL hm_get_floatv('aTheta', atheta, is_available, lsubmodel, unitab)
908
909 IF(apmax == zero) apmax = one
910 ELSEIF(ipres == 2) THEN
911C Initialization
912 pmax = ep30
913 theta = ep30
914 CALL hm_get_intv('fct_IDP', ifpres, is_available, lsubmodel)
915 CALL hm_get_floatv('FscaleP', sfpres, is_available, lsubmodel, unitab)
916 IF(sfpres == zero) THEN
917 CALL hm_get_floatv_dim('FscaleP', fac_gen, is_available, lsubmodel, unitab)
918 sfpres = one * fac_gen
919 ENDIF
920 IF (ifpres/=0) THEN
921 ifunc=0
922 DO k=1,nfunct
923 IF (ifpres==npc(k)) ifunc=k
924 ENDDO
925 IF (ifunc==0) THEN
926 CALL ancmsg(msgid=621,msgtype=msgerror,anmode=aninfo,
927 . i1=id,c1=titr,c2='FUNCTION',i2=ifpres)
928 ENDIF
929 ENDIF
930 ELSEIF(ipres == 3) THEN
931
932 ELSEIF(ipres == 4) THEN
933 ENDIF
934
935 CALL hm_get_floatv('Xc', xc, is_available, lsubmodel, unitab)
936 CALL hm_get_floatv('Yc', yc, is_available, lsubmodel, unitab)
937 CALL hm_get_floatv('Zc', zc, is_available, lsubmodel, unitab)
938
939
940
941
942 xd=zero
943 yd=zero
944 zd=zero
945 xa=zero
946 ya=zero
947 za=zero
948 dirx=zero
949 diry=zero
950 dirz=zero
951 IF(freesurf == 2 .OR. grav_id > 0)THEN
952 CALL hm_get_floatv('XA', xa, is_available, lsubmodel, unitab)
953 CALL hm_get_floatv('YA', ya, is_available, lsubmodel, unitab)
954 CALL hm_get_floatv('ZA', za, is_available, lsubmodel, unitab)
955 CALL hm_get_floatv('Dir-X', dirx, is_available, lsubmodel, unitab)
956 CALL hm_get_floatv('Dir-Y', diry, is_available, lsubmodel, unitab)
957 CALL hm_get_floatv('Dir-Z', dirz, is_available, lsubmodel, unitab)
958 norm=sqrt(dirx**2+diry**2+dirz**2)
959 IF (norm==zero) THEN
960 CALL ancmsg(msgid=622,
961 . msgtype=msgerror,anmode=aninfo,
962 . i1=id,c1=titr,c2='NULL FREE SURFACE NORMAL')
963 ENDIF
964 dirx=dirx/norm
965 diry=diry/norm
966 dirz=dirz/norm
967C Compute Image D of Charge C
968 IF(freesurf == 2) THEN
969 tt = dirx*(xc-xa)+diry*(yc-ya)+dirz*(zc-za)
970 xd = xc - two*tt*dirx
971 yd = yc - two*tt*diry
972 zd = zc - two*tt*dirz
973 ENDIF
974 ENDIF
975
976 nbloc=0
977 nprow=1
978 npcol=1
979 IF (nspmd > 1) THEN
980 rnspmd=nspmd
981 nrmax=int(sqrt(rnspmd))
982 DO nr=1,nrmax
983 IF (mod(nspmd,nr)==0) THEN
984 nprow=nr
985 npcol=nspmd/nr
986 ENDIF
987 ENDDO
988 IF (nel<1000) THEN
989 nblocmax=32
990 ELSE
991 nblocmax=64
992 ENDIF
993 nbloc=min(nel/nprow, nel/npcol)
994 nbloc=min(nblocmax,nbloc)
995 nbloc=max(1,nbloc)
996 ENDIF
997C
998 iflow(iadi+1)=id
999 iflow(iadi+2)=ityp
1000 iflow(iadi+3)=isu
1001 iflow(iadi+4)=jform
1002 iflow(iadi+5)=nno
1003 iflow(iadi+6)=nel
1004 iflow(iadi+7)=ifunc
1005 iflow(iadi+8)=0
1006 iflow(iadi+9)=0
1007 iflow(iadi+10)=iadmati
1008 iflow(iadi+11)=iadmatr
1009 iflow(iadi+12)=nbloc
1010 iflow(iadi+13)=iform
1011 IF(nspmd == 1) THEN
1012 IF(jform == 1) THEN
1013 iflow(iadi+14)=niflow+nno+3*nel+nno
1014 ELSEIF(jform == 2) THEN
1015 iflow(iadi+14)=niflow+nno+5*nel+nno+nbgauge
1016 ENDIF
1017 ELSE
1018 IF(jform == 1) THEN
1019 iflow(iadi+14)=niflow+nno+3*nel+nno+nno+nel
1020 ELSEIF(jform == 2) THEN
1021 iflow(iadi+14)=niflow+nno+5*nel+nno+nbgauge+nno+nel
1022 ENDIF
1023 ENDIF
1024 hg = huge(nel)
1025 IF (nel > int(sqrt(real(hg)))) THEN
1026 CALL ancmsg(msgid = 1711, anmode=aninfo, msgtype = msgerror,
1027 . i1 = int(sqrt(real(hg))))
1028 CALL arret(2)
1029 ENDIF
1030 IF(freesurf == 1)iflow(iadi+15)=nrflow+ 7*nel+nel*nel+3*nel
1031 IF(freesurf == 2)iflow(iadi+15)=nrflow+10*nel+nel*nel+3*nel
1032 iflow(iadi+17)=ilvout
1033 iflow(iadi+18)=nprow
1034 iflow(iadi+19)=npcol
1035 iflow(iadi+20)=0
1036 iflow(iadi+21)=ipres
1037 iflow(iadi+22)=iwave
1038 iflow(iadi+23)=kform
1039 iflow(iadi+24)=integr
1040 iflow(iadi+25)=freesurf
1041 iflow(iadi+26)=afterflow
1042 k=0
1043 IF(grav_id > 0) THEN
1044 DO j=1,ngrav
1045 IF(igrv(5,j) == grav_id) k=j
1046 ENDDO
1047 ENDIF
1048 iflow(iadi+27)=k
1049 iflow(iadi+28)=nelmax
1050
1051 rflow(iadr+1)=rho*ssp
1052 rflow(iadr+2)=ssp
1053 rflow(iadr+3)=sfpres
1054 rflow(iadr+5)=rho
1055 rflow(iadr+6)=pmax
1056 rflow(iadr+7)=theta
1057 rflow(iadr+8)=-one
1058 rflow(iadr+9) =xc
1059 rflow(iadr+10)=yc
1060 rflow(iadr+11)=zc
1061 rflow(iadr+12)=sqrt((xs-xc)**2+(ys-yc)**2+(zs-zc)**2)
1062 rflow(iadr+13)=xd
1063 rflow(iadr+14)=yd
1064 rflow(iadr+15)=zd
1065
1066 rflow(iadr+16)=xa
1067 rflow(iadr+17)=ya
1068 rflow(iadr+18)=za
1069 rflow(iadr+19)=dirx
1070 rflow(iadr+20)=diry
1071 rflow(iadr+21)=dirz
1072 rflow(iadr+22)=pmin
1073 rflow(iadr+23)=apmax
1074 rflow(iadr+24)=atheta
1075
1076 memflow(1)=memflow(1)+iflow(iadi+8)
1077 memflow(2)=memflow(2)+iflow(iadi+9)
1078C
1079 WRITE(iout,2000)
1080 IF(jform == 1) WRITE(iout,2100) i, id, trim(titr), igrsurf(isu)%ID, nno, nel, grav_id
1081 IF(jform == 2) WRITE(iout,2200) i, id, trim(titr), igrsurf(isu)%ID, nno, nel, grav_id
1082 WRITE(iout,2300) rho, ssp, pmin
1083 WRITE(iout,2400) xs, ys, zs
1084 WRITE(iout,2500) iform, ilvout, ipres, kform, freesurf, afterflow, integr
1085 IF(ipres == 1)THEN
1086 WRITE(iout,2600) pmax, theta, apmax, atheta
1087 ELSEIF(ipres == 2) THEN
1088 WRITE(iout,2700) ifpres,sfpres
1089 ENDIF
1090 IF(iwave == 1) WRITE(iout,3000) xc, yc, zc
1091 IF(grav_id > 0 .OR. freesurf == 2) WRITE(iout,3500) xa,ya,za,dirx,diry,dirz
1092 IF(freesurf == 2) WRITE(iout,3600) xd,yd,zd
1093
1094C-----------------------------------------------------------------------------------
1095C Compute arrival time of incident wave, area, direction cosine, distance to charge
1096C Compute fluid mass matrix
1097C-----------------------------------------------------------------------------------
1098C Description des tableaux
1099C II1 -> IFLOW NIFLOW : parametres entiers
1100C II2 -> IBUF NNO : correspondances local-global noeuds surface
1101C II3 -> ELEM 3 ou 5*NEL : connectivite locale des triangles/quadrangles+flag
1102C II4 -> IBUF_L NNO : correspondances local-global noeuds surface
1103C II5 -> SHELL_GA NBGAUGE : correspondances local-gauge 4-node shell
1104C II6 -> CNP NNO : nombre de processeur pour chaque noeud nspmd > 1
1105C engine
1106C II7 -> IPIV NEL : lapack resolution nel > nelmax
1107C II8 -> IBUFELR NEL : SPMD ligne des elements dans la process grid (0 si absent du processeur courant)
1108C II9 -> IBUFELC NEL : SPMD colonne des elements dans la process grid (0 si absent du processeur courant)
1109C
1110C IR1 -> RFLOW : parametres reels
1111C IR2 -> NORMAL : normale
1112C IR3 -> TA : arrival time
1113C IR4 -> AREA : element area
1114C IR5 -> COSG : direction cosine
1115C IR6 -> DIST : distance charge
1116C IR7 -> MFLE : fluide mass matrix (inverse) if nel < nelmax
1117C IR7 -> MFLE : C**t B + B**t C if nel >= nelmax
1118C engine
1119C IR8 -> ACCF : acceleration point fluide
1120C IR9 -> PS : scattered pressure
1121C IR10 -> PTI : incident pressure time integral
1122C IR11 -> CBEM : C matrix if nel >= nelmax
1123C-----------------------------------------------------------------------------------
1124 ii1=iadi+1
1125 ii2=ii1+niflow
1126 ii3=ii2+nno
1127 IF(jform==1) THEN
1128 ii4=ii3+3*nel
1129 ii5=ii4+nno
1130 ii6=ii5
1131 ELSEIF(jform==2) THEN
1132 ii4=ii3+5*nel
1133 ii5=ii4+nno
1134 ii6=ii5+nbgauge
1135 ENDIF
1136 ir1=iadr+1
1137 ir2=ir1+nrflow
1138 ir3=ir2+nel*3
1139 ir4=ir3+nel*freesurf
1140 ir5=ir4+nel
1141 ir6=ir5+nel*freesurf
1142 ir7=ir6+nel*freesurf
1143 hg = huge(nel)
1144 IF (nel > int(sqrt(real(hg)))) THEN
1145 CALL ancmsg(msgid = 1711, anmode=aninfo, msgtype = msgerror,
1146 . i1 = int(sqrt(real(hg))))
1147 CALL arret(2)
1148 ENDIF
1149 ir8=ir7+nel*nel
1150 ir9=ir8+nel
1151 ir10=ir9+nel
1152 ir11=ir10+nel
1153 IF(jform == 1) THEN
1154 CALL init_tg(iflow(ii1), iflow(ii2), iflow(ii3), x, xs, ys, zs, xd, yd, zd,
1155 . rflow(ir1), rflow(ir2), rflow(ir3), rflow(ir4), rflow(ir5), rflow(ir6))
1156 CALL mass_fluid_tg(iform, ilvout, nno, nel, iflow(ii2), iflow(ii3), x,
1157 . rflow(ir2), rflow(ir4), rflow(ir7), rho)
1158 ELSEIF(jform == 2) THEN
1159 CALL init_qd(iflow(ii1), iflow(ii2), iflow(ii3), x, xs, ys, zs, xd, yd, zd,
1160 . rflow(ir1), rflow(ir2), rflow(ir3), rflow(ir4), rflow(ir5), rflow(ir6))
1161 IF(nel < nelmax) THEN
1162 ALLOCATE(cbem(nel,nel))
1163 CALL mass_fluid_qd(nno, nel, iflow(ii1), iflow(ii2), iflow(ii3), x,
1164 . rflow(ir2), rflow(ir4), rflow(ir7), cbem, rho,iresp)
1165 DEALLOCATE(cbem)
1166 ELSE
1167 CALL mass_fluid_qd(nno, nel, iflow(ii1), iflow(ii2), iflow(ii3), x,
1168 . rflow(ir2), rflow(ir4), rflow(ir7), rflow(ir11), rho,iresp)
1169 ENDIF
1170 IF(nbgauge > 0) THEN
1171 WRITE (iout,'(/5X,A)') 'GAUGE ELEMENT ELEMENT'
1172 DO j=1,nbgauge
1173 iflow(ii5+j-1)=0
1174 IF(lgauge(1,j) /= 0) cycle
1175C Node or Shell input
1176 n1=lgauge(3,j)
1177 IF(n1 < 0) THEN
1178 j1=-n1
1179 DO k=1,nel
1180 IF(j1 /= n_shell(k)) cycle
1181 iflow(ii5+j-1)=k
1182 GO TO 100
1183 ENDDO
1184 ENDIF
1185 100 CONTINUE
1186 WRITE(iout,'(3I10)') j,-lgauge(3,j),iflow(ii5+j-1)
1187 ENDDO
1188 DEALLOCATE(n_shell)
1189 ENDIF
1190 ENDIF
1191C
1192 iadr=iadr+iflow(iadi+15)
1193 iadi=iadi+iflow(iadi+14)
1194C
1195 ENDDO
1196C
1197 RETURN
1198C
1199 1000 FORMAT(/
1200 . /
1201 . ' INCOMPRESSIBLE FLOW (BOUNDARY ELEMENTS METHOD)'/
1202 . ' ----------------------------------------------'/)
1203 1100 FORMAT( 5x,'BEM PROBLEM NUMBER ',i10
1204 . /10x,'FLOW ID ',i10,1x,a,
1205 . /10x,'EXTERNAL SURFACE ID ',i10
1206 . /10x,'NUMBER OF SURFACE NODES ',i10
1207 . /10x,'NUMBER OF TRIANGULAR BOUNDARY ELEMENTS ',i10)
1208 1110 FORMAT( 10x,'FLOW INSIDE THE SURFACE')
1209 1120 FORMAT( 10x,'FLOW OUTSIDE THE SURFACE')
1210 1200 FORMAT( 10x,'STAGNATION PRESSURE CURVE ',i10
1211 . /10x,'STAGNATION PRESSURE SCALE FACTOR ',1pe10.3
1212 . /10x,'TIME SCALE FACTOR FOR STAG. PRES. CURVE ',1pe10.3
1213 . /10x,'AUXILIARY NODE GROUP ID ',i10
1214 . /10x,'NUMBER OF AUXILIARY NODES ',i10)
1215 1210 FORMAT( 10x,'POINT-INSIDE-SURFACE TEST FOR AUX. NODES')
1216 1220 FORMAT( 10x,'POINT-OUTSIDE-SURFACE TEST FOR AUX. NODES')
1217 1225 FORMAT( 10x,'ADIMENSIONAL TOLERANCE FOR TESTING ',1pe10.3)
1218 1230 FORMAT( 10x,'NO TEST FOR AUX. NODES')
1219 1300 FORMAT( 10x,'FLUID DENSITY ',1pe10.3)
1220 1400 FORMAT(/10x,'INFLOW-OUTFLOW'
1221 . /10x,'--------------'
1222 . /10x,'NUMBER OF INFLOW-OUTFLOW SURFACES ',i10)
1223 1410 FORMAT(/10x,'SURFACE NUMBER ',i10
1224 . /10x,'SURFACE ID ',i10)
1225 1420 FORMAT( 10x,'IMPOSED VELOCITY CURVE ',i10
1226 . /10x,'IMPOSED VELOCITY SCALE FACTOR ',1pe10.3)
1227 1430 FORMAT( 10x,'IMPOSED PRESSURE CURVE ',i10
1228 . /10x,'IMPOSED PRESSURE SCALE FACTOR ',1pe10.3)
1229 1440 FORMAT( 10x,'TIME SCALE FACTOR FOR CURVES ',1pe10.3)
1230 1500 FORMAT(/10x,'BEM PARAMETERS'
1231 . /10x,'--------------'
1232 . /10x,'BEM FORMULATION FLAG ',i10
1233 . /10x,'BEM SOLVER OUTPUT LEVEL ',i10
1234 . /10x,'TIME STEP FOR MATRICES ASSEMBLY ',1pe10.3)
1235 1600 FORMAT(/10x,'VELOCITY FIELD AT INFINITY'
1236 . /10x,'--------------------------'
1237 . /10x,'VELOCITY CURVE ',i10
1238 . /10x,'VELOCITY SCALE FACTOR ',1pe10.3
1239 . /10x,'TIME SCALE FOR VELOCITY CURVE ',1pe10.3
1240 . /10x,'X COMPONENT OF VELOCITY VECTOR ',1pe10.3
1241 . /10x,'Y COMPONENT OF VELOCITY VECTOR ',1pe10.3
1242 . /10x,'Z COMPONENT OF VELOCITY VECTOR ',1pe10.3)
1243 1700 FORMAT(/10x,'PARALLEL SOLVER PARAMETERS (SCALAPACK)'
1244 . /10x,'--------------------------------------'
1245 . /10x,'NUMBER OF ROW OF PROCESS GRID ',i10
1246 . /10x,'NUMBER OF COLUMNS OF PROCESS GRID ',i10
1247 . /10x,'2D-CYCLIC DECOMPOSITION BLOCK-SIZE ',i10)
1248
1249 2000 FORMAT(//
1250 . ' DAA SURFACE (BOUNDARY ELEMENT METHOD) '/
1251 . ' -------------------------------------- '/)
1252 2100 FORMAT( 5x,'DAA SURFACE NUMBER ',i10
1253 . /10x,'DAA ID ',i10,1x,a,
1254 . /10x,'WET SURFACE ID ',i10
1255 . /10x,'NUMBER OF SURFACE NODES ',i10
1256 . /10x,'NUMBER OF TRIANGULAR ELEMENTS ',i10
1257 . /10x,'GRAVITY ID (/GRAV) ',i10)
1258 2200 FORMAT( 5x,'DAA SURFACE NUMBER ',i10
1259 . /10x,'DAA ID ',i10,1x,a,
1260 . /10x,'WET SURFACE ID ',i10
1261 . /10x,'NUMBER OF SURFACE NODES ',i10
1262 . /10x,'NUMBER OF SHELL ELEMENTS ',i10
1263 . /10x,'GRAVITY ID (/GRAV) ',i10)
1264 2300 FORMAT( 10x,'FLUID DENSITY ',1pe13.6
1265 . /10x,'FLUID SOUND SPEED ',1pe13.6
1266 . /10x,'MINIMUM PRESSURE ',1pe13.6)
1267 2400 FORMAT( 10x,'X-COORDINATE OF STANDOFF POINT ',1pe13.6
1268 . /10x,'Y-COORDINATE OF STANDOFF POINT ',1pe13.6
1269 . /10x,'Z-COORDINATE OF STANDOFF POINT ',1pe13.6)
1270 2500 FORMAT(/10x,'BEM FORMULATION FLAG IFORM ',i10
1271 . /10x,'DAA SOLVER OUTPUT LEVEL ',i10
1272 . /10x,'INCIDENT PRESSURE INPUT FLAG ',i10
1273 . /10x,'DAA FORMULATION FLAG KFORM ',i10
1274 . /10x,'FREE SURFACE FLAG ',i10
1275 . /10x,'AFTERFLOW VELOCITY FLAG ',i10
1276 . /10x,'INTEGRATION FLAG ',i10)
1277 2600 FORMAT(/10x,'MAXIMUM PRESSURE AT STANDOFF POINT ',1pe13.6
1278 . /10x,'DECAY TIME AT STANDOFF POINT ',1pe13.6
1279 . /10x,'EXPONENT FOR PMAX (APMAX) ',1pe13.6
1280 . /10x,'EXPONENT FOR DECAY TIME (ATHETA) ',1pe13.6)
1281 2700 FORMAT(/10x,'INCIDENT PRESSURE FUNCTION ',i10
1282 . /10x,'PRESSURE SCALE FACTOR ',1pe13.6)
1283 3000 FORMAT( 10x,'X-COORDINATE OF EXPLOSIVE CHARGE ',1pe13.6
1284 . /10x,'Y-COORDINATE OF EXPLOSIVE CHARGE ',1pe13.6
1285 . /10x,'Z-COORDINATE OF EXPLOSIVE CHARGE ',1pe13.6)
1286 3100 FORMAT(/10x,'PLANE WAVE DIRECTION '
1287 . /10x,'X-DIRECTION ',1pe13.6
1288 . /10x,'Y-DIRECTION ',1pe13.6
1289 . /10x,'Z-DIRECTION ',1pe13.6)
1290 3500 FORMAT(/10x,'FREE SURFACE '
1291 . /10x,'X-COORDINATE OF SURFACE POINT A ',1pe13.6
1292 . /10x,'Y-COORDINATE OF SURFACE POINT A ',1pe13.6
1293 . /10x,'Z-COORDINATE OF SURFACE POINT A ',1pe13.6
1294 . /10x,'SURFACE NORMAL X-COMPONENT ',1pe13.6
1295 . /10x,'SURFACE NORMAL Y-COMPONENT ',1pe13.6
1296 . /10x,'SURFACE NORMAL Z-COMPONENT ',1pe13.6)
1297 3600 FORMAT(/10x,'X-COORDINATE OF CHARGE IMAGE ',1pe13.6
1298 . /10x,'Y-COORDINATE OF CHARGE IMAGE ',1pe13.6
1299 . /10x,'Z-COORDINATE OF CHARGE IMAGE ',1pe13.6)
1300 END
1301
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_float_array_index_dim
subroutine hm_get_float_array_index_dim(name, dim_fac, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index_dim.F:47
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
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_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_bem
subroutine hm_read_bem(igrsurf, iflow, rflow, npc, igrnod, memflow, unitab, x, nom_opt, lgauge, igrv, lsubmodel, iresp)
Definition hm_read_bem.F:274
hm_preread_bem
subroutine hm_preread_bem(igrsurf, igrnod, nnft, unitab, nom_opt, lsubmodel)
Definition hm_read_bem.F:41
init_qd
subroutine init_qd(iflow, ibuf, elem, x, xs, ys, zs, xd, yd, zd, rflow, normal, ta, af, cosg, dcp)
Definition init_qd.F:30
init_tg
subroutine init_tg(iflow, ibuf, elem, x, xs, ys, zs, xd, yd, zd, rflow, normal, ta, af, cosg, dcp)
Definition init_tg.F:30
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mass_fluid_qd
subroutine mass_fluid_qd(nno, nel, iflow, ibuf, elem, x, normal, af, mfle, cbem, rho, iresp)
Definition mass-fluid_qd.F:41
mass_fluid_tg
subroutine mass_fluid_tg(iform, ilvout, nno, nel, ibuf, elem, x, normal, af, mfle, rho)
Definition mass-fluid_tg.F:38
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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
lectur
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct)
Definition lectur.F:533
arret
subroutine arret(nn)
Definition arret.F:87
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723