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