OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c3grtails.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com_xfem1.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "vect01_c.inc"
#include "scr17_c.inc"
#include "remesh_c.inc"
#include "sms_c.inc"
#include "r2r_c.inc"
#include "drape_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine c3grtails (ixtg, pm, iparg, geo, eadd, nd, iparttg, dd_iad, idx, inum, index, cep, thk, xnum, itr1, igrsurf, igrsh3n, icnod, igeo, ipm, ixtg1, ipart, sh3tree, nod2eltg, itrioff, sh3trim, tagprt_sms, iworksh, stack, drape, rnoise, mat_param, sh3ang, drapeg, print_flag, ptsh3n, damp_range_part)

Function/Subroutine Documentation

◆ c3grtails()

subroutine c3grtails ( integer, dimension(nixtg,*) ixtg,
pm,
integer, dimension(nparg,*) iparg,
geo,
integer, dimension(*) eadd,
integer nd,
integer, dimension(*) iparttg,
integer, dimension(nspmd+1,*) dd_iad,
integer idx,
integer, dimension(10,*) inum,
integer, dimension(*) index,
integer, dimension(*) cep,
thk,
xnum,
integer, dimension(*) itr1,
type (surf_), dimension(nsurf) igrsurf,
type (group_), dimension(ngrsh3n) igrsh3n,
integer, dimension(*) icnod,
integer, dimension(npropgi,numgeo) igeo,
integer, dimension(npropmi,nummat) ipm,
integer, dimension(4,*) ixtg1,
integer, dimension(lipart1,*) ipart,
integer, dimension(ksh3tree,*) sh3tree,
integer, dimension(*) nod2eltg,
integer, dimension(*) itrioff,
integer, dimension(*) sh3trim,
integer, dimension(*) tagprt_sms,
integer, dimension(3,*) iworksh,
type (stack_ply) stack,
type (drape_), dimension(numelc_drape + numeltg_drape), target drape,
rnoise,
type(matparam_struct_), dimension(nummat), intent(in) mat_param,
sh3ang,
type (drapeg_) drapeg,
integer, intent(in) print_flag,
integer, dimension(numeltg), intent(inout) ptsh3n,
integer, dimension(npart), intent(in) damp_range_part )
Parameters
[in]print_flagflag to print the element group data
[in]damp_range_partflag to compute the damping range

Definition at line 39 of file c3grtails.F.

49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE my_alloc_mod
53 USE message_mod
54 USE r2r_mod
55 USE stack_mod
56 USE reorder_mod
57 USE groupdef_mod
58 USE drape_mod
59 USE matparam_def_mod
60 USE names_and_titles_mod , ONLY : nchartitle
61 USE ale_mod , ONLY : ale
62C-----------------------------------------------
63C A R G U M E N T S
64C-----------------------------------------------
65C IXTG(NIXTG,NUMELTG)TABLEAU CONECS+PID+MID+NOS TRIANGLES E
66C PM(NPROPM,NUMMAT) TABLEAU DES CARACS DES MATERIAUX E
67C IPARG(NPARG,NGROUP)TABLEAU DES CARACTERISTIQUES DES GROUPES E/S
68C GEO(NPROPG,NUMGEO) TABLEAU DES CARACS DES PID E
69C EADD(NUMELTG) TABLEAU DES ADRESSES DANS IDAM CHGT DAMIER E
70C IPARTTG(NUMELTG) E/S
71C INUM(8,NUMELTG) TABLEAU DE TRAVAIL E/S
72C ITR1(NSELTG) TABLEAU DE TRAVAIL E/S
73C INDEX(NUMELTG) TABLEAU DE TRAVAIL E/S
74C CEP(NUMELTG) TABLEAU DE TRAVAIL E/S
75C THK(NUMELTG) TABLEAU DE TRAVAIL E/S
76C ITRIOFF(NUMELTG) FLAG ELEM RBY ON/OFF E/S
77C-----------------------------------------------
78C I M P L I C I T T Y P E S
79C-----------------------------------------------
80#include "implicit_f.inc"
81C-----------------------------------------------
82C C O M M O N B L O C K S
83C-----------------------------------------------
84#include "com01_c.inc"
85#include "com04_c.inc"
86#include "com_xfem1.inc"
87#include "units_c.inc"
88#include "param_c.inc"
89#include "vect01_c.inc"
90#include "scr17_c.inc"
91#include "remesh_c.inc"
92#include "sms_c.inc"
93#include "r2r_c.inc"
94#include "drape_c.inc"
95C-----------------------------------------------
96C D U M M Y A R G U M E N T S
97C-----------------------------------------------
98 INTEGER ND, IDX,
99 . IXTG(NIXTG,*), IPARG(NPARG,*), EADD(*), IXTG1(4,*),
100 . DD_IAD(NSPMD+1,*),IPARTTG(*),
101 . INUM(10,*),ITR1(*),INDEX(*),CEP(*),ICNOD(*),IPM(NPROPMI,NUMMAT),
102 . ITRIOFF(*), SH3TRIM(*),IGEO(NPROPGI,NUMGEO),
103 . IPART(LIPART1,*), SH3TREE(KSH3TREE,*), NOD2ELTG(*) ,
104 . TAGPRT_SMS(*),IWORKSH(3,*)
105 INTEGER, INTENT(IN) :: PRINT_FLAG !< flag to print the element group data
106 INTEGER , DIMENSION(NUMELTG) , INTENT(INOUT):: PTSH3N
107 INTEGER , INTENT(IN) :: DAMP_RANGE_PART(NPART) !< flag to compute the damping range
108 my_real pm(npropm,nummat), geo(npropg,numgeo),thk(*),xnum(*),rnoise(nperturb,*), sh3ang(*)
109C-----------------------------------------------
110 TYPE (STACK_PLY) :: STACK
111 TYPE (DRAPE_) , TARGET :: DRAPE(NUMELC_DRAPE + NUMELTG_DRAPE)
112 TYPE (DRAPEG_) :: DRAPEG,XNUM_DRAPEG
113 TYPE (DRAPE_) , DIMENSION(:), ALLOCATABLE :: XNUM_DRAPE
114 TYPE (DRAPE_PLY_) , POINTER :: DRAPE_PLY
115C-----------------------------------------------
116 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
117 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
118 TYPE(MATPARAM_STRUCT_) ,DIMENSION(NUMMAT),INTENT(IN) :: MAT_PARAM
119C-----------------------------------------------
120C L O C A L V A R I A B L E S
121C-----------------------------------------------
122 INTEGER I, K, NGR1, MLN,ISMST,NN,ICSEN,NLEVXF,
123 . NPN, N, MID, PID,II, J, MIDN, NSG, NEL, NE1, ITHK,
124 . IPLA, IGTYP, P, NEL_PREC, NB,MODE,KCNOD,PRT,NELTG3,IPT,
125 . ILEV, IE, MPT, NUVARR,IADM, MY_NVSIZ,IXFEM_ERR,
126 . IMATLY,IXFEM,IPTUN,IREP,IFWV,
127 . ISUBSTACK,IPPID,IPMAT,ISH3N, NPG,IDROT1,NB_LAW58,IPERT,
128 . STAT, IGMAT,ISM0,JALE_FROM_MAT, JALE_FROM_PROP,NSLICE,KK,NPT_DRP,
129 . IDRAPE, JJ,IEL,IEL0,IDAMP_FREQ_RANGE
130 INTEGER WORK(70000),NGP(NSPMD+1)
131 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ISTOR
132 INTEGER ID,IPARTR2R
133 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
134 my_real, DIMENSION(:,:), ALLOCATABLE :: xnum_rnoise
135 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX2, INUM_PTSH3N
136 INTEGER, DIMENSION(:,:), ALLOCATABLE :: INUM_WORKSH
137 my_real :: angle(numeltg)
138C
139C-----------------------------------------------
140C S O U R C E L I N E S
141C-----------------------------------------------
142 CALL my_alloc(index2,numeltg)
143 index2(1:numeltg)=permutation%TRIANGLE(1:numeltg)
144
145 IF(nadmesh /= 0)THEN
146 ALLOCATE( istor(ksh3tree+1,numeltg) )
147 ELSE
148 ALLOCATE( istor(0,0) )
149 ENDIF
150C
151 IF (nperturb > 0) THEN
152 ALLOCATE(xnum_rnoise(nperturb,numeltg),stat=stat)
153 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
154 . msgtype=msgerror,
155 . c1='XNUM_RNOISE')
156 ELSE
157 ALLOCATE(xnum_rnoise(0,0))
158 ENDIF
159C
160 iptun = 1
161 ixfem_err = 0
162C--------------------------------------------------------------
163C BORNAGE DES GROUPES DE MVSIZ
164C--------------------------------------------------------------
165 ngr1 = ngroup + 1
166C
167C phase 1 : domain decompostition
168C
169 idx=idx+nd*(nspmd+1)
170 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
171C NSPGROUP = NSPGROUP + ND
172 nft = 0
173C initialisation dd_iad
174 DO n=1,nd
175 DO p=1,nspmd+1
176 dd_iad(p,nspgroup+n) = 0
177 END DO
178 ENDDO
179C
180 iel = 0
181 neltg3 = numeltg-numeltg6
182 IF(ndrape > 0) iel = drapeg%NUMSH4
183 DO n=1,nd
184 nel = eadd(n+1)-eadd(n)
185C
186 IF (ndrape > 0 .AND. numeltg_drape > 0) THEN
187 ALLOCATE(xnum_drape(nel))
188 ALLOCATE(xnum_drapeg%INDX(nel))
189 xnum_drapeg%INDX = 0
190 DO i =1, nel
191 iel0 = drapeg%INDX(numelc + i + nft)
192 IF(iel0 == 0) cycle
193 npt = drape(iel0)%NPLY
194 npt_drp = drape(iel0)%NPLY_DRAPE
195 ALLOCATE(xnum_drape(i)%INDX_PLY(npt))
196 ALLOCATE(xnum_drape(i)%DRAPE_PLY(npt_drp))
197 xnum_drape(i)%INDX_PLY= 0
198 DO j = 1,npt_drp
199 nslice = drape(iel0)%DRAPE_PLY(j)%NSLICE
200 ALLOCATE(xnum_drape(i)%DRAPE_PLY(j)%RDRAPE(nslice,2))
201 ALLOCATE(xnum_drape(i)%DRAPE_PLY(j)%IDRAPE(nslice,2))
202 xnum_drape(i)%DRAPE_PLY(j)%RDRAPE = 0
203 xnum_drape(i)%DRAPE_PLY(j)%IDRAPE = 0
204 ENDDO
205 ENDDO
206 ELSE
207 ALLOCATE( xnum_drape(0) )
208 ENDIF
209 ALLOCATE(inum_worksh(3,nel))
210C
211 IF(ndrape > 0 .AND. numeltg_drape > 0) THEN
212 DO i = 1, nel
213 index(i) = i
214 inum(1,i)=iparttg(nft+i)
215 inum(2,i)=itrioff(nft+i)
216 inum(3,i)=ixtg(1,nft+i)
217 inum(4,i)=ixtg(2,nft+i)
218 inum(5,i)=ixtg(3,nft+i)
219 inum(6,i)=ixtg(4,nft+i)
220 inum(7,i)=ixtg(5,nft+i)
221 inum(8,i)=ixtg(6,nft+i)
222 inum(10,i)=ixtg(1,nft+i)
223 xnum(i)=thk(nft+i)
224 inum_worksh(1,i) = iworksh(1,numelc + nft + i)
225 inum_worksh(2,i) = iworksh(2,numelc + nft + i)
226 inum_worksh(3,i) = iworksh(3,numelc + nft + i)
227 IF (nperturb > 0) THEN
228 DO ipert = 1, nperturb
229 xnum_rnoise(ipert,i) = rnoise(ipert,nft+i)
230 ENDDO
231 ENDIF
232 angle(i) = sh3ang(nft + i)
233 !drape structure
234 iel0 = drapeg%INDX(numelc + nft + i)
235 xnum_drapeg%INDX(i) = iel0
236 IF(iel0 == 0) cycle
237 npt = drape(iel0)%NPLY
238 xnum_drape(i)%NPLY = npt
239 xnum_drape(i)%INDX_PLY(1:npt) = drape(iel0)%INDX_PLY(1:npt)
240 npt = drape(iel0)%NPLY_DRAPE
241 xnum_drape(i)%NPLY_DRAPE = npt
242 xnum_drape(i)%THICK = drape(iel0)%THICK
243 DO jj = 1, npt
244 drape_ply => drape(iel0)%DRAPE_PLY(jj)
245 nslice = drape_ply%NSLICE
246 xnum_drape(i)%DRAPE_PLY(jj)%NSLICE = nslice
247 xnum_drape(i)%DRAPE_PLY(jj)%IPID = drape_ply%IPID
248 DO kk = 1,nslice
249 xnum_drape(i)%DRAPE_PLY(jj)%IDRAPE(kk,1)=drape_ply%IDRAPE(kk,1)
250 xnum_drape(i)%DRAPE_PLY(jj)%IDRAPE(kk,2)=drape_ply%IDRAPE(kk,2)
251 xnum_drape(i)%DRAPE_PLY(jj)%RDRAPE(kk,1)=drape_ply%RDRAPE(kk,1)
252 xnum_drape(i)%DRAPE_PLY(jj)%RDRAPE(kk,2)=drape_ply%RDRAPE(kk,2)
253 ENDDO
254 DEALLOCATE(drape_ply%IDRAPE, drape_ply%RDRAPE)
255 ENDDO
256 DEALLOCATE(drape(iel0)%DRAPE_PLY)
257 DEALLOCATE(drape(iel0)%INDX_PLY)
258 ENDDO
259 ELSE
260 DO i = 1, nel
261 index(i) = i
262 inum(1,i)=iparttg(nft+i)
263 inum(2,i)=itrioff(nft+i)
264 inum(3,i)=ixtg(1,nft+i)
265 inum(4,i)=ixtg(2,nft+i)
266 inum(5,i)=ixtg(3,nft+i)
267 inum(6,i)=ixtg(4,nft+i)
268 inum(7,i)=ixtg(5,nft+i)
269 inum(8,i)=ixtg(6,nft+i)
270 inum(10,i)=ixtg(1,nft+i)
271 inum_worksh(1,i) = iworksh(1,numelc + nft + i)
272 inum_worksh(2,i) = iworksh(2,numelc + nft + i)
273 inum_worksh(3,i) = iworksh(3,numelc + nft + i)
274 xnum(i)=thk(nft+i)
275 IF (nperturb > 0) THEN
276 DO ipert = 1, nperturb
277 xnum_rnoise(ipert,i) = rnoise(ipert,nft+i)
278 ENDDO
279 ENDIF
280 angle(i)=sh3ang(nft+i)
281 ENDDO
282 ENDIF
283C
284 IF(abs(isigi) == 3 .OR. abs(isigi) == 4 .OR. abs(isigi) == 5) THEN
285 ALLOCATE(inum_ptsh3n(nel))
286 DO i = 1, nel
287 inum_ptsh3n(i)=ptsh3n(nft+i)
288 ENDDO
289 ENDIF
290 IF(nadmesh/=0)THEN
291 DO k=1,ksh3tree
292 DO i=1,nel
293 istor(k,i)=sh3tree(k,nft+i)
294 ENDDO
295 ENDDO
296 IF(lsh3trim/=0)THEN
297 DO i=1,nel
298 istor(ksh3tree+1,i)=sh3trim(nft+i)
299 ENDDO
300 END IF
301 END IF
302
303 mode=0
304 CALL my_orders( mode, work, cep(nft+1), index, nel , 1)
305 IF(ndrape > 0 .AND. numeltg_drape > 0) THEN
306 DO i = 1, nel
307 permutation%TRIANGLE(i+nft) = index2(index(i)+nft)
308 iparttg(i+nft)=inum(1,index(i))
309 itrioff(i+nft)=inum(2,index(i))
310 thk(i+nft) =xnum(index(i))
311 ixtg(1,i+nft)=inum(3,index(i))
312 ixtg(2,i+nft)=inum(4,index(i))
313 ixtg(3,i+nft)=inum(5,index(i))
314 ixtg(4,i+nft)=inum(6,index(i))
315 ixtg(5,i+nft)=inum(7,index(i))
316 ixtg(6,i+nft)=inum(8,index(i))
317 itr1(nft+index(i)) = nft+i
318 iworksh(1,numelc + nft + i)=inum_worksh(1,index(i))
319 iworksh(2,numelc + nft + i)=inum_worksh(2,index(i))
320 iworksh(3,numelc + nft + i)=inum_worksh(3,index(i))
321 IF (nperturb > 0) THEN
322 DO ipert = 1, nperturb
323 rnoise(ipert,i+nft) = xnum_rnoise(ipert,index(i))
324 ENDDO
325 ENDIF
326 sh3ang(nft+i) = angle(index(i))
327 !
328 iel0 = xnum_drapeg%INDX(index(i))
329 drapeg%INDX(numelc + nft + i)= 0
330 IF(iel0 == 0) cycle
331 iel = iel + 1
332 npt = xnum_drape(index(i))%NPLY ! number of layer shell
333 drape(iel)%NPLY = npt
334 drapeg%INDX(numelc + nft + i)= iel
335 ALLOCATE(drape(iel)%INDX_PLY(npt))
336 drape(iel)%INDX_PLY = 0
337 drape(iel)%INDX_PLY(1:npt) = xnum_drape(index(i))%INDX_PLY(1:npt)
338 npt = xnum_drape(index(i))%NPLY_DRAPE ! NPT_DRP
339 drape(iel)%NPLY_DRAPE = npt
340 drape(iel)%THICK = xnum_drape(index(i))%THICK
341 ALLOCATE(drape(iel)%DRAPE_PLY(npt))
342 DO jj = 1, npt
343 drape_ply => drape(iel)%DRAPE_PLY(jj)
344 nslice = xnum_drape(index(i))%DRAPE_PLY(jj)%NSLICE
345 drape_ply%NSLICE = nslice
346 drape_ply%IPID = xnum_drape(index(i))%DRAPE_PLY(jj)%IPID
347 ALLOCATE(drape_ply%IDRAPE(nslice,2), drape_ply%RDRAPE(nslice,2))
348 drape_ply%IDRAPE = 0
349 drape_ply%RDRAPE = zero
350 DO kk = 1,nslice
351 drape_ply%IDRAPE(kk,1) = xnum_drape(index(i))%DRAPE_PLY(jj)%IDRAPE(kk,1)
352 drape_ply%IDRAPE(kk,2) = xnum_drape(index(i))%DRAPE_PLY(jj)%IDRAPE(kk,2)
353 drape_ply%RDRAPE(kk,1) = xnum_drape(index(i))%DRAPE_PLY(jj)%RDRAPE(kk,1)
354 drape_ply%RDRAPE(kk,2) = xnum_drape(index(i))%DRAPE_PLY(jj)%RDRAPE(kk,2)
355 ENDDO
356 ENDDO
357 ENDDO
358 ELSE
359 DO i = 1, nel
360 permutation%TRIANGLE(i+nft) = index2(index(i)+nft)
361 iparttg(i+nft)=inum(1,index(i))
362 itrioff(i+nft)=inum(2,index(i))
363 thk(i+nft) =xnum(index(i))
364 ixtg(1,i+nft)=inum(3,index(i))
365 ixtg(2,i+nft)=inum(4,index(i))
366 ixtg(3,i+nft)=inum(5,index(i))
367 ixtg(4,i+nft)=inum(6,index(i))
368 ixtg(5,i+nft)=inum(7,index(i))
369 ixtg(6,i+nft)=inum(8,index(i))
370 itr1(nft+index(i)) = nft+i
371 iworksh(1,numelc + nft + i)=inum_worksh(1,index(i))
372 iworksh(2,numelc + nft + i)=inum_worksh(2,index(i))
373 iworksh(3,numelc + nft + i)=inum_worksh(3,index(i))
374 IF (nperturb > 0) THEN
375 DO ipert = 1, nperturb
376 rnoise(ipert,i+nft) = xnum_rnoise(ipert,index(i))
377 ENDDO
378 ENDIF
379 sh3ang(nft+i) = angle(index(i))
380 ENDDO
381 ENDIF
382 IF(abs(isigi)==3.OR.abs(isigi)== 4.OR.abs(isigi)==5)THEN
383 DO i=1,nel
384 ptsh3n(nft+i) = inum_ptsh3n(index(i))
385 ENDDO
386 DEALLOCATE(inum_ptsh3n)
387 ENDIF
388 IF(nadmesh/=0)THEN
389 DO k=1,ksh3tree
390 DO i=1,nel
391 sh3tree(k,i+nft)=istor(k,index(i))
392 ENDDO
393 ENDDO
394 IF(lsh3trim/=0)THEN
395 DO i=1,nel
396 sh3trim(i+nft)=istor(ksh3tree+1,index(i))
397 ENDDO
398 END IF
399 END IF
400C
401 IF(nft>=neltg3)THEN
402 DO i = 1, nel
403 ii = i+nft-neltg3
404 inum(1,i)=ixtg1(1,ii)
405 inum(2,i)=ixtg1(2,ii)
406 inum(3,i)=ixtg1(3,ii)
407C INUM(4,I)=IXTG1(4,II)
408 END DO
409 DO i = 1, nel
410 ii = i+nft-neltg3
411 ixtg1(1,ii)=inum(1,index(i))
412 ixtg1(2,ii)=inum(2,index(i))
413 ixtg1(3,ii)=inum(3,index(i))
414C IXTG1(4,II)=INUM(4,INDEX(I))
415 END DO
416 END IF
417C
418
419 p = cep(nft+index(1))
420 nb = 1
421 DO i = 2, nel
422 IF (cep(nft+index(i))/=p) THEN
423 dd_iad(p+1,nspgroup+n) = nb
424 nb = 1
425 p = cep(nft+index(i))
426 ELSE
427 nb = nb + 1
428 ENDIF
429 ENDDO
430 dd_iad(p+1,nspgroup+n) = nb
431 DO p = 2, nspmd
432 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
433 . + dd_iad(p-1,nspgroup+n)
434 ENDDO
435 DO p = nspmd+1,2,-1
436 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
437 ENDDO
438 dd_iad(1,nspgroup+n) = 1
439C
440C maj CEP
441C
442 DO i = 1, nel
443 index(i) = cep(nft+index(i))
444 ENDDO
445 DO i = 1, nel
446 cep(nft+i) = index(i)
447 ENDDO
448 nft = nft + nel
449C
450 IF(ndrape > 0 .AND. numeltg_drape > 0) THEN
451 DO i =1, nel
452 iel0 = xnum_drapeg%INDX(i)
453 IF(iel0 == 0 ) cycle
454 npt_drp = xnum_drape(i)%NPLY_DRAPE
455 DO j = 1,npt_drp
456 DEALLOCATE(xnum_drape(i)%DRAPE_PLY(j)%RDRAPE)
457 DEALLOCATE(xnum_drape(i)%DRAPE_PLY(j)%IDRAPE)
458 ENDDO
459 DEALLOCATE(xnum_drape(i)%DRAPE_PLY,xnum_drape(i)%INDX_PLY)
460 ENDDO
461 DEALLOCATE(xnum_drape, xnum_drapeg%INDX )
462 ELSE
463 DEALLOCATE( xnum_drape )
464 ENDIF
465 DEALLOCATE(inum_worksh)
466 ENDDO ! ND
467C
468C RENUMEROTATION DE L'ARBRE
469C
470 IF(nadmesh/=0)THEN
471 DO i=1,numeltg
472 IF(sh3tree(1,i)/=0)
473 . sh3tree(1,i)=itr1(sh3tree(1,i))
474 IF(sh3tree(2,i)/=0)
475 . sh3tree(2,i)=itr1(sh3tree(2,i))
476 ENDDO
477 END IF
478C
479C RENUMEROTATION POUR SURFACES
480C
481 DO i=1,nsurf
482 nn=igrsurf(i)%NSEG
483 DO j=1,nn
484 IF(igrsurf(i)%ELTYP(j) == 7)
485 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
486 ENDDO
487 ENDDO
488C
489C RENUMEROTATION POUR GROUPES DE SHELL
490C
491 DO i=1,ngrsh3n
492 nn=igrsh3n(i)%NENTITY
493 DO j=1,nn
494 igrsh3n(i)%ENTITY(j) = itr1(igrsh3n(i)%ENTITY(j))
495 ENDDO
496 ENDDO
497C
498C renumerotation CONNECTIVITE INVERSE
499C
500 DO i=1,3*numeltg+3*numeltg6
501 IF(nod2eltg(i) /= 0)nod2eltg(i)=itr1(nod2eltg(i))
502 END DO
503C
504C phase 2 : bornage en groupe de mvsiz
505C ngroup est global, iparg est global mais organise en fonction de dd
506C
507 DO 300 n=1,nd
508 nft = 0
509 DO p = 1, nspmd
510 ngp(p)=0
511 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
512 IF (nel>0) THEN
513 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
514 ngp(p)=ngroup
515 DO WHILE (nft < nel_prec+nel)
516 ngroup=ngroup+1
517 ii = eadd(n)+nft
518 prt = iparttg(ii)
519 mid = ixtg(1,ii)
520 mln = nint(pm(19,mid))
521 pid = ixtg(5,ii)
522 ipartr2r = 0
523 IF (nsubdom>0) ipartr2r = tag_mat(mid)
524 npn = igeo(4,pid)
525 ismst = igeo(5,pid)
526 igtyp=igeo(11,pid)
527 kcnod=icnod(ii)
528 idrot1= igeo(20,pid)
529 irep = igeo(6,pid)
530 ish3n = igeo(18,pid)
531 igmat = igeo(98 ,pid)
532 ithk = nint(geo(35,pid))
533 ipla = nint(geo(39,pid))
534 icsen= igeo(3,pid)
535 istrain = nint(geo(11,pid))
536 IF (ish3n > 3 .AND. ish3n < 30) ish3n=2
537 IF (ish3n > 31 ) THEN ! not expected
538 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
539 CALL ancmsg(msgid=3008,
540 . anmode=aninfo,
541 . msgtype=msgerror,
542 . i1=igeo(1,pid),
543 . c1=titr,
544 . i2=ish3n,
545 . prmod=msg_cumu)
546 ENDIF
547 nlevxf = 0
548 ixfem = 0
549 isubstack = 0
550 idrape = 0
551 IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
552 npn = iworksh(1,numelc + ii)
553 isubstack =iworksh(3,numelc + ii)
554 IF(npn == 0) THEN
555 id = igeo(1,pid)
556 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
557 CALL ancmsg(msgid=1241,
558 . msgtype=msgerror,
559 . anmode=aninfo,
560!! . ANMODE=ANSTOP,
561 . i1=id,
562 . c1=titr,
563 . i2=ixtg(nixtg,ii))
564 CALL arret(2)
565 ENDIF
566 ENDIF
567 IF(ndrape > 0 .AND. (igtyp == 17 .OR. igtyp == 51 .OR. igtyp ==52 )) THEN
568 IF(drapeg%INDX(ii) /= 0 ) idrape = 1
569 ENDIF
570c-------- check xfem compatibility
571c IF (ICRACK3D > 0) THEN
572 IF (igtyp == 11 .or. igtyp == 16) THEN
573 DO ipt = 1, npn
574 imatly = igeo(100+ipt,pid)
575 IF (mat_param(imatly)%NFAIL > 0) ixfem = mat_param(imatly)%IXFEM
576 ENDDO
577 IF (ixfem > 0) ixfem = 1
578 IF (ixfem == 1) nlevxf = nxel*npn
579 ELSEIF (igtyp == 51 .OR. igtyp == 52) THEN
580 ippid = 2
581 ipmat = ippid + npn
582 DO ipt = 1, npn
583 imatly = stack%IGEO(ipmat + ipt ,isubstack)
584 IF (mat_param(imatly)%NFAIL > 0) ixfem = mat_param(imatly)%IXFEM
585 IF (ixfem > 0) ixfem = 1
586 IF (ixfem == 1) nlevxf = nxel*npn
587 ENDDO
588 ELSEIF (igtyp == 1 .or. igtyp == 9 .or. igtyp == 10 .or. igtyp == 17) THEN
589 ixfem = mat_param(mid)%IXFEM
590 IF (ixfem == 1) THEN
591 ixfem = 2
592 nlevxf = nxel
593 ENDIF
594 ENDIF
595 nlevmax = max(nlevmax, nlevxf)
596c ENDIF
597 IF (ish3n >= 30 .and. ixfem > 0) THEN ! not compatible with Batoz shells
598 ixfem = 0
599 nlevxf = 0
600 nlevmax = 0
601 numelcrk = 0
602 icrack3d = 0
603 ixfem_err = 1
604 CALL ancmsg(msgid=1601,
605 . anmode=aninfo,
606 . msgtype=msgerror,
607 . i1=igeo(1,pid),
608 . c1=titr,
609 . prmod=msg_cumu)
610 ENDIF
611C---------
612C
613 id=igeo(1,pid)
614 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
615 IF(nadmesh == 0)THEN
616 ilev=0
617 my_nvsiz=nvsiz
618 ELSE
619 prt = iparttg(ii)
620 iadm= ipart(10,prt)
621 IF(iadm==0)THEN
622 ilev = 0
623 my_nvsiz=nvsiz
624 ELSE
625 ilev=sh3tree(3,ii)
626 IF(ilev<0)ilev=-ilev-1
627 my_nvsiz=max(4,min(4**ilev,nvsiz))
628 END IF
629 END IF
630C
631 IF (igtyp == 0) mln=0 ! VOID Property => Void material
632C--------------------
633C- ISMSTR IPLAST,ITHICK Automatic
634C-----------------all shell prop
635 IF (igtyp > 0) THEN
636C----- fixed to 1 excepting small strain case
637 IF (ithk<0) THEN
638 ithk = 1
639 IF (mat_param(mid)%SMSTR==1 .OR. mln == 1) ithk = 0
640C--------message out
641 ism0 = ithk
642 IF (ithk == 0) ism0=2
643 CALL ancmsg(msgid=1770,
644 . msgtype=msginfo,
645 . anmode=aninfo_blind_2,
646 . i1=id,
647 . c1=titr,
648 . i2=ism0,
649 . prmod=msg_cumu)
650 END IF
651C----- fixed to iterative, but can be changed in fonction of law
652 IF (ipla<0) THEN
653 ipla = 1
654C--------message out
655 CALL ancmsg(msgid=1771,
656 . msgtype=msginfo,
657 . anmode=aninfo_blind_2,
658 . i1=id,
659 . c1=titr,
660 . i2=ipla,
661 . prmod=msg_cumu)
662 END IF
663C------ --
664 IF (ismst<0) THEN
665C--- MAT_PARAM(MID)%SMSTR : 2 large, 1: small ; MAT_PARAM(MID)%STRAIN_FORMULATION : 1 inc, 2 total
666c there is no recommended total strain for shell for the moment
667 IF (mat_param(mid)%SMSTR==1) THEN
668 ismst = 1
669C--in c3init3 :IF (ISMSTR == 1 .AND. MTN==19) IPARG(9)=11 -> Ismstr=11 for law19
670 ELSE
671 ismst = 2
672C----certain laws to use 4 to see one by one
673 IF (mat_param(mid)%STRAIN_FORMULATION==2) ismst =4
674 IF (mln == 58 ) ismst =4
675 IF (mln == 19 .AND. npn==1) ismst =11
676 END IF
677 geo(3,pid) = ismst
678C--------message out
679 CALL ancmsg(msgid=1772,
680 . msgtype=msginfo,
681 . anmode=aninfo_blind_2,
682 . i1=id,
683 . c1=titr,
684 . i2=ismst,
685 . prmod=msg_cumu)
686 END IF
687 END IF !(IGTYP > 0) THEN
688C
689 IF (igtyp == 16 .and. mln == 58 .and. ismst /= 4) THEN
690 ismst = 4
691 CALL ancmsg(msgid=772,
692 . msgtype=msgwarning,
693 . anmode=aninfo_blind_2,
694 . i1=id,
695 . c1=titr,
696 . prmod=msg_cumu)
697 ENDIF
698
699 IF (igtyp == 1 .AND. mln ==200)THEN
700 CALL ancmsg(msgid=2035,
701 . msgtype=msgerror,
702 . anmode=aninfo_blind_1,
703 . i1=id,
704 . c1=titr,
705 . i2=mln)
706 ENDIF
707c------
708c global integration
709 IF (npn /= 1 .and. mln == 1) npn = 0
710c switch global integration to npt=3
711 IF (npn == 0 .and. mln /= 0 .and. mln /= 1 .and. mln /= 91) THEN
712 CALL ancmsg(msgid=1912,
713 . anmode=aninfo,
714 . msgtype=msgwarning,
715 . i1=id,
716 . c1=titr,
717 . i2=mln,
718 . prmod=msg_cumu)
719 npn = 3
720 ENDIF
721 IF (npn == 0 .and. mln > 2 .and. mln /= 22 .and.
722 . mln /= 36 .and. mln /= 43 .and. mln /= 60 .and.
723 . mln /= 86 .and. mln /= 13 .and. mln /= 151) THEN
724 CALL fretitl2(titr1,
725 . ipm(npropmi-ltitr+1,mid),
726 . ltitr)
727 CALL ancmsg(msgid=23,
728 . anmode=aninfo,
729 . msgtype=msgerror,
730 . i1=id,
731 . c1=titr,
732 . i2=ipm(1,mid),
733 . c2=titr1,
734 . i3=mln)
735 ENDIF
736C
737 IF (igtyp == 1 .and. ismst == 11 ) THEN
738 ! ISMST = 11 compatibility
739 ismst = 2
740 CALL ancmsg(msgid=1876,
741 . msgtype=msgwarning,
742 . anmode=aninfo_blind_2,
743 . i1=id,
744 . c1=titr,
745 . i2=mln,
746 . i3=ismst,
747 . prmod=msg_cumu)
748 ELSEIF (ismst == 10 ) THEN
749 IF (ish3n >= 30 ) THEN ! not expected
750 CALL ancmsg(msgid=3021,
751 . anmode=aninfo,
752 . msgtype=msgwarning,
753 . i1=id,
754 . c1=titr,
755 . i2=ish3n,
756 . prmod=msg_cumu)
757 ismst = 2
758 ENDIF
759 IF (mln /=42 .AND. mln /=69 .AND. mln /=88 .and. mln /= 99) THEN
760 CALL ancmsg(msgid=3020, anmode=aninfo, msgtype=msgwarning,
761 . i1=id,
762 . c1=titr,
763 . i2=mln,
764 . prmod=msg_cumu)
765 ismst = 2
766 ENDIF
767 ENDIF
768C---------Drilling dof--using NB4 -> no supper place needed---------
769 IF (idrot1>0.AND.ish3n>29) THEN
770 CALL ancmsg(msgid=854,
771 . msgtype=msgwarning,
772 . anmode=aninfo_blind_2,
773 . i1=id,
774 . c1=titr)
775 idrot1 = 0
776 END IF
777 IF(npn == 0.AND.(mln == 36.OR.mln == 86))THEN
778 IF(ipla == 0) ipla=1
779 IF(ipla == 2) ipla=0
780 ELSEIF(npn == 0.AND.mln == 3)THEN
781 IF(ipla == 2) ipla=0
782 ELSE
783 IF(ipla == 2) ipla=0
784 IF(ipla == 3) ipla=2
785 ENDIF
786 IF(ithk == 2)THEN
787 ithk = 0
788 ELSEIF(mln == 32)THEN
789 ithk = 1
790 ENDIF
791c
792 CALL zeroin(1,nparg,iparg(1,ngroup))
793 iparg(1,ngroup) = mln
794 ne1 = min( my_nvsiz, nel + nel_prec - nft)
795 iparg(2,ngroup) = ne1
796 iparg(3,ngroup)= eadd(n)-1 + nft
797 iparg(4,ngroup) = lbufel+1 ! kept in place for compatibility with
798c other groups using old buffer
799 iparg(43,ngroup) = 0
800 ifwv = 0
801C
802C-------------
803 IF (igtyp == 11)THEN
804 DO ipt = 1, npn
805 imatly = igeo(100+ipt,pid)
806 IF (mat_param(imatly)%NFAIL > 0) iparg(43,ngroup) = 1
807 IF (mat_param(imatly)%IFAILWAVE > 0) ifwv = 1
808 ENDDO
809c--------
810 ELSEIF(igtyp == 17) THEN
811 ippid = 2
812 ipmat = ippid + npn
813 DO ipt = 1, npn
814 imatly = stack%IGEO(ipmat + ipt ,isubstack)
815 IF (mat_param(imatly)%NFAIL > 0)THEN
816 iparg(43,ngroup) = 1
817 ENDIF
818 ENDDO
819c--------
820 ELSEIF (igtyp == 51 .OR. igtyp == 52 ) THEN
821C---
822C new shell property (multiple NPT through each layer)
823C---
824 nb_law58 = 0
825 ippid = 2
826 ipmat = ippid + npn
827 DO ipt = 1, npn
828 imatly = stack%IGEO(ipmat + ipt ,isubstack)
829 IF (mat_param(imatly)%NFAIL > 0)THEN
830 iparg(43,ngroup) = 1
831 ENDIF
832 IF (mat_param(imatly)%IFAILWAVE > 0) ifwv = 1
833C --- PID 51 combined with LAW58 ---
834 IF (nint(pm(19,imatly)) == 58) nb_law58 = nb_law58 + 1
835 ENDDO
836C --- set new IREP for groups:
837 IF (nb_law58 == npn) THEN
838 irep = 2
839 ELSEIF (nb_law58 > 0) THEN
840 irep = irep + 3
841 ENDIF
842c--------
843 ELSE ! IGTYP == 1
844 IF(mat_param(mid)%NFAIL > 0.AND.mln /= 0 .AND. mln /= 13)THEN
845 iparg(43,ngroup) = 1
846 ENDIF
847 IF (mat_param(mid)%IFAILWAVE > 0) ifwv = 1
848 ENDIF ! IGTYP
849C-------------
850 IF(mln == 13) irigid_mat = 1
851 jthe = nint(pm(71,mid))
852C thermal material expansion
853 iparg(49,ngroup) = 0
854 IF(ipm(218,mid) > 0 .AND. mln /=0 .AND. mln /= 13) THEN
855 iparg(49,ngroup) = 1
856 ENDIF
857C---------
858 iparg(54,ngroup) = ixfem
859 iparg(65,ngroup) = nlevxf
860C flag for group of duplicated elements in multidomains
861 IF (nsubdom>0) iparg(77,ngroup)= ipartr2r
862 iparg(5,ngroup) = 7
863 iparg(6,ngroup) = npn
864 iparg(9,ngroup) = ismst
865 iparg(11,ngroup)= kcnod
866 iparg(13,ngroup)= jthe !sh3n : 0 or 1 only
867 iparg(44,ngroup)= istrain
868 iparg(23,ngroup)= ish3n
869 iparg(28,ngroup)= ithk
870 iparg(29,ngroup)= ipla
871 iparg(35,ngroup)= irep
872 iparg(38,ngroup)= igtyp
873 iparg(39,ngroup)= icsen
874 iparg(41,ngroup)= idrot1
875 iparg(62,ngroup)= pid
876c non-local variable regularization flag for failure models
877 iparg(78,ngroup)= mat_param(mid)%NLOC ! NLOC_FAIL
878 iparg(79,ngroup)= ifwv
879c
880C Multifluid law, setting NLAY
881 IF (mln == 151) THEN
882 iparg(20, ngroup) = ipm(20, mid)
883 jale_from_mat = nint(pm(72,mid))
884 jale_from_prop = igeo(62,pid)
885 jale = max(jale_from_mat, jale_from_prop) !if inconsistent, error message was displayed in PART reader
886 jlag=0
887 jeul=0
888 IF(jale == 2)THEN
889 jale=0
890 jeul=1
891 ENDIF
892 iparg(7, ngroup) = jale
893 iparg(11, ngroup) = jeul
894 iparg(13,ngroup)=+abs(jthe) ! -1 nodal temperature +1 centroid temperature
895 ENDIF
896
897 !ALE REZONING/REMAPING : number of MAT/EOS variables to treat (used by staggered scheme only : arezon.F)
898 ! With ALE framework, since the Mesh is arbitrary, the variable must be updated to map thei expected location and not follow the arbitrary mesh displacement
899 ! this numbering here will be used in arezon.F to loop over variables to rezon/remap
900 IF(jale == 1)THEN
901 ale%REZON%NUM_NUVAR_MAT = ale%REZON%NUM_NUVAR_MAT + mat_param(mid)%REZON%NUM_NUVAR_MAT
902 ale%REZON%NUM_NUVAR_EOS = ale%REZON%NUM_NUVAR_EOS + mat_param(mid)%REZON%NUM_NUVAR_EOS
903 ENDIF
904
905 !ALE UVAR REZONING (81:MAT, 82:EOS)
906 IF(jale == 1)THEN
907 iparg(81,ngroup) = mat_param(mid)%REZON%NUM_NUVAR_MAT
908 iparg(82,ngroup) = mat_param(mid)%REZON%NUM_NUVAR_EOS
909 ENDIF
910
911 iparg(45,ngroup)= ilev
912 IF(ilev/=0 .AND. ish3n > 2)THEN
913 id=igeo(1,pid)
914 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
915 CALL ancmsg(msgid=653,
916 . msgtype=msgerror,
917 . anmode=aninfo_blind_1,
918 . i1=id,
919 . c1=titr,
920 . i2=ish3n,
921 . i3=ipart(4,prt))
922 END IF
923 IF(nadmesh/=0)THEN
924 iparg(8,ngroup)=1
925 DO j=1,ne1
926 sh3tree(4,j+eadd(n)+nft-1)=ngroup
927 ilev=sh3tree(3,j+eadd(n)+nft-1)
928 IF(ilev >= 0)iparg(8,ngroup)=0
929 END DO
930 END IF
931
932 nsg = 1
933 DO 210 j = 2,ne1
934 midn = ixtg(1,j+eadd(n)+nft-1)
935 IF(mid/=midn)THEN
936 mid = midn
937 nsg = nsg + 1
938 ENDIF
939 210 CONTINUE
940C
941 iparg(10,ngroup)= nsg
942 iparg(18,ngroup)= mid
943 iparg(32,ngroup)= p-1
944
945 nuvarr = 0
946 IF (igtyp == 11) THEN
947 mpt = iabs(npn)
948 DO ipt= 1,mpt
949 DO j=1,ne1
950 ie=j+eadd(n)+nft-1
951 imatly = igeo(100+ipt,ixtg(5,ie))
952 nuvarr = max(nuvarr,ipm(221,ixtg(1,ie)))
953 ENDDO
954 ENDDO
955 ELSE
956 DO j=1,ne1
957 ie=j+eadd(n)+nft-1
958 nuvarr = max(nuvarr,ipm(221,ixtg(1,ie)))
959 ENDDO
960 END IF
961 iparg(47,ngroup)=nuvarr
962
963 IF(ish3n == 30)THEN
964 npg=3
965 ELSE
966 npg=1
967 END IF
968 iparg(48,ngroup)=npg
969
970 jsms=0
971 IF(isms/=0)THEN
972 IF(idtgrs/=0)THEN
973 IF(tagprt_sms(iparttg(ii))/=0)jsms=1
974 ELSE
975 jsms=1
976 END IF
977 END IF
978 iparg(52,ngroup)=jsms
979C for stack
980 iparg(71,ngroup) = isubstack
981 iparg(75,ngroup) = igmat
982 iparg(92,ngroup) = idrape !
983C damping frequency range apply to group
984 idamp_freq_range = damp_range_part(iparttg(ii))
985 iparg(93,ngroup) = idamp_freq_range
986C
987 nft = nft + ne1
988c 220 CONTINUE
989 ENDDO
990 ngp(p)=ngroup-ngp(p)
991 ENDIF
992 ENDDO
993C DD_IAD => nb groupes par sous domaine
994 ngp(nspmd+1)=0
995 DO p = 1, nspmd
996 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
997 dd_iad(p,nspgroup+n)=ngp(p)
998 END DO
999 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
1000C
1001 300 CONTINUE
1002C
1003 IF (ixfem_err == 1) icrack3d = 0
1004c
1005 nspgroup = nspgroup + nd
1006C-----------
1007 CALL ancmsg(msgid=1601,
1008 . anmode=aninfo,
1009 . msgtype=msgerror,
1010 . i1=pid,
1011 . c1=titr ,
1012 . prmod=msg_print)
1013 CALL ancmsg(msgid=1770,
1014 . msgtype=msginfo,
1015 . anmode=aninfo_blind_2,
1016 . prmod=msg_print)
1017 CALL ancmsg(msgid=1771,
1018 . msgtype=msginfo,
1019 . anmode=aninfo_blind_2,
1020 . prmod=msg_print)
1021 CALL ancmsg(msgid=1772,
1022 . msgtype=msginfo,
1023 . anmode=aninfo_blind_2,
1024 . prmod=msg_print)
1025 CALL ancmsg(msgid=1876,
1026 . msgtype=msgwarning,
1027 . anmode=aninfo_blind_2,
1028 . prmod=msg_print)
1029 CALL ancmsg(msgid=1912,
1030 . anmode=aninfo_blind_2,
1031 . msgtype=msgwarning,
1032 . prmod=msg_print)
1033 CALL ancmsg(msgid=772,
1034 . anmode=aninfo_blind_2,
1035 . msgtype=msgwarning,
1036 . prmod=msg_print)
1037 CALL ancmsg(msgid=3008,
1038 . anmode=aninfo,
1039 . msgtype=msgerror,
1040 . prmod=msg_print)
1041 CALL ancmsg(msgid=3020,
1042 . anmode=aninfo,
1043 . msgtype=msgwarning,
1044 . prmod=msg_print)
1045 CALL ancmsg(msgid=3021,
1046 . anmode=aninfo,
1047 . msgtype=msgwarning,
1048 . prmod=msg_print)
1049C-----------
1050 IF(print_flag>6) THEN
1051 WRITE(iout,1000)
1052 DO n=ngr1,ngroup
1053 mln = iparg(1,n)
1054 WRITE(iout,1001)n,mln,iparg(2,n),iparg(3,n)+1,
1055 + iparg(5,n),iabs(iparg(6,n)),
1056 + iparg(9,n),iparg(10,n),iparg(44,n),iparg(43,n)
1057 ENDDO
1058 ENDIF
1059C-----------
1060 1000 FORMAT(
1061 + /10x,' 3D - TRIANGULAR SHELL ELEMENT GROUPS'/
1062 + 10x,' ------------------------------------'/
1063 +' GROUP MATERIAL ELEMENT FIRST',
1064 +' ELEMENT',
1065 +' INTEG SMALL SUB STRAIN FAILURE'/
1066 +' LAW NUMBER ELEMENT',
1067 +' TYPE',
1068 +' PTS STRAIN GROUPS OUTPUT FLAG'/)
1069 1001 FORMAT(11(1x,i10))
1070C
1071 IF (ALLOCATED(xnum_rnoise)) DEALLOCATE(xnum_rnoise)
1072
1073 DEALLOCATE(index2)
1074 DEALLOCATE( istor )
1075C-----------
1076 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
drape_mod
Definition drape_mod.F:54
drape_mod::numeltg_drape
integer numeltg_drape
Definition drape_mod.F:92
groupdef_mod
Definition groupdef_mod.F:662
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
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tag_mat
integer, dimension(:), allocatable tag_mat
Definition r2r_mod.F:136
reorder_mod
Definition reorder_mod.F:45
reorder_mod::permutation
type(reorder_struct_) permutation
Definition reorder_mod.F:54
stack_mod
Definition stack_mod.F:72
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
arret
subroutine arret(nn)
Definition arret.F:87
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47