OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sgrhead.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "sms_c.inc"
#include "r2r_c.inc"
#include "sphcom.inc"
#include "boltpr_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sgrhead (ixs, pm, geo, inum, isel, itr1, eadd, index, itri, iparts, nd, igrsurf, igrbric, isolnod, cep, xep, ixs10, ixs20, ixs16, igeo, ipm, nod2els, isoloff, tagprt_sms, sph2sol, sol2sph, mat_param, sol2sph_typ, iflag_bpreload, clusters, rnoise, damp_range_part)

Function/Subroutine Documentation

◆ sgrhead()

subroutine sgrhead ( integer, dimension(nixs,numels) ixs,
dimension(npropm,nummat), intent(in) pm,
dimension(npropg,numgeo), intent(in) geo,
integer, dimension(16,*) inum,
integer, dimension(*) isel,
integer, dimension(*) itr1,
integer, dimension(*) eadd,
integer, dimension(*) index,
integer, dimension(8,*) itri,
integer, dimension(*) iparts,
integer nd,
type (surf_), dimension(nsurf) igrsurf,
type (group_), dimension(ngrbric) igrbric,
integer, dimension(*) isolnod,
integer, dimension(*) cep,
integer, dimension(*) xep,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
integer, dimension(npropgi,numgeo), intent(inout) igeo,
integer, dimension(npropmi,nummat), intent(in) ipm,
integer, dimension(*) nod2els,
integer, dimension(*) isoloff,
integer, dimension(*) tagprt_sms,
integer, dimension(*) sph2sol,
integer, dimension(2,*) sol2sph,
type(matparam_struct_), dimension(nummat), intent(in), target mat_param,
integer, dimension(*) sol2sph_typ,
integer, dimension(*) iflag_bpreload,
type (cluster_), dimension(ncluster) clusters,
dimension(nperturb,numels), intent(inout) rnoise,
integer, dimension(npart), intent(in) damp_range_part )

Definition at line 35 of file sgrhead.F.

44C-----------------------------------------------
45C A R G U M E N T S
46C-----------------------------------------------
47C IXS(11,NUMELS) ARRAY: CONECS+PID+MID+NOS SOLIDS E
48C PM(NPROPM,NUMMAT) ARRAY: MATERIAL PARAMETERS (real) E
49C IPM(NPROPMI,NUMMAT) ARRAY: MATERIAL PARAMETERS (integer) E
50C GEO(NPROPG,NUMGEO) ARRAY: PROPERTY PARAMETERS (real) E
51C IGEO(NPROPGI,NUMGEO) ARRAY: PROPERTY PARAMETERS (integer) E
52C INUM(13,NUMELS) ARRAY: WORKING E/S
53C ISEL(NSELS) ARRAY: SELECTED SOLIDS FOR TH E/S
54C ITR1(NSELS) ARRAY: WORKING E/S
55C EADD(NUMELS) ARRAY: IDAM INDEXES / checkboard S
56C INDEX(NUMELS) ARRAY: WORKING E/S
57C ITRI(8,NUMELS) ARRAY: WORKING E/S
58C IPARTS(NUMELS) ARRAY: PART E/S
59C CEP(NUMELS) ARRAY: WORKING E/S
60C XEP(NUMELS) ARRAY: WORKING E/S
61C NOD2ELS(8*NUMELS+6*NUMELS10+12*NUMELS20+16*NUMELS16) E/S
62C ISOLOFF(NUMELS) FLAG ELEM RBY ON/OFF E/S
63C-----------------------------------------------
64C M o d u l e s
65C-----------------------------------------------
66 USE my_alloc_mod
67 USE message_mod
68 USE r2r_mod
69 USE reorder_mod
70 USE groupdef_mod
71 USE cluster_mod
72 USE matparam_def_mod
73 USE names_and_titles_mod , ONLY : nchartitle
74C-----------------------------------------------
75C I M P L I C I T T Y P E S
76C-----------------------------------------------
77#include "implicit_f.inc"
78C-----------------------------------------------
79C C O M M O N B L O C K S
80C-----------------------------------------------
81#include "vect01_c.inc"
82#include "com04_c.inc"
83#include "param_c.inc"
84#include "sms_c.inc"
85#include "r2r_c.inc"
86#include "sphcom.inc"
87#include "boltpr_c.inc"
88C-----------------------------------------------
89C D U M M Y A R G U M E N T S
90C-----------------------------------------------
91 INTEGER IXS(NIXS,NUMELS),ISEL(*),INUM(16,*),IPARTS(*),
92 . EADD(*),ITR1(*),INDEX(*),ITRI(8,*),
93 . ND, ISOLNOD(*), CEP(*),
94 . XEP(*),IXS10(6,*),IXS20(12,*),IXS16(8,*),
95 . NOD2ELS(*), ISOLOFF(*),
96 . TAGPRT_SMS(*), SPH2SOL(*),
97 . SOL2SPH(2,*),SOL2SPH_TYP(*),IFLAG_BPRELOAD(*)
98 INTEGER,INTENT(IN) :: IPM(NPROPMI,NUMMAT)
99 INTEGER,INTENT(INOUT) :: IGEO(NPROPGI,NUMGEO)
100 INTEGER, INTENT(IN) :: DAMP_RANGE_PART(NPART) ! < flag to compute the damping range
101 my_real,INTENT(IN) :: pm(npropm,nummat), geo(npropg,numgeo)
102 my_real,INTENT(INOUT) :: rnoise(nperturb,numels)
103C-----------------------------------------------
104 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
105 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
106 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS
107 TYPE(MATPARAM_STRUCT_) , TARGET, DIMENSION(NUMMAT),INTENT(IN) :: MAT_PARAM
108C-----------------------------------------------
109C L O C A L V A R I A B L E S
110C-----------------------------------------------
111 INTEGER
112 . I,J,K,L,IL,MLN, NG, ISSN, NPN, NN, N, MID, PID ,IREP,
113 . II,II0,JJ0,II1,JJ1,II2,JJ2,JJ,II3,JJ3,II4,JJ4,II5,JJ5,
114 . II6,JJ6,JHBE,ISO,IGT,IINT,MODE,IEOS,IVISC,IVISC0,TSHELL,
115 . IPLAST, IALEL,MT,NFAIL,NFAIL0,ITET4,ICPRE,ICSTR,IRB ,
116 . NLAY,NPTR,NPTS,NPTT,IMAT,INUM_R2R(1+R2R_SIU*NUMELS),
117 . NSPHDIR,IPARTSPH,NUVAR,ISVIS,IBOLTP,ITET10,NLOC_FAIL,
118 . IPERT,STAT
119 INTEGER WORK(70000)
120 EXTERNAL my_shiftl,my_shiftr,my_and
121 INTEGER MY_SHIFTL,MY_SHIFTR,MY_AND
122 INTEGER ID, JALE_FROM_MAT, JALE_FROM_PROP
123 CHARACTER(LEN=NCHARTITLE) :: TITR
124 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX2
125 INTEGER :: CLUSTER_TYP,CLUSTER_NEL
126 INTEGER, DIMENSION(:), ALLOCATABLE :: SAVE_CLUSTER
127 my_real, DIMENSION(:,:), ALLOCATABLE :: xnum_rnoise
128C-----------------------------------------------
129C S O U R C E L I N E S
130C-----------------------------------------------
131
132C GLOBAL SORTING ON ALL CRITERIA FOR ALL ELEMENTS
133
134 CALL my_alloc(index2,numels)
135C
136 IF (nperturb > 0) THEN
137 ALLOCATE(xnum_rnoise(nperturb,numels),stat=stat)
138 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
139 . msgtype=msgerror,
140 . c1='XNUM_RNOISE')
141 ENDIF
142C
143 DO i=1,numels
144 index2(i)=permutation%SOLID(i)
145 eadd(i)=1
146 itri(5,i)=i
147 index(i)=i
148 inum(1,i)=iparts(i)
149 inum(2,i)=ixs(1,i)
150 inum(3,i)=ixs(2,i)
151 inum(4,i)=ixs(3,i)
152 inum(5,i)=ixs(4,i)
153 inum(6,i)=ixs(5,i)
154 inum(7,i)=ixs(6,i)
155 inum(8,i)=ixs(7,i)
156 inum(9,i)=ixs(8,i)
157 inum(10,i)=ixs(9,i)
158 inum(11,i)=ixs(10,i)
159 inum(12,i)=ixs(11,i)
160 inum(13,i)=isolnod(i)
161 IF (nsubdom>0) inum_r2r(i) = tag_elsf(i)
162 IF (nperturb > 0) THEN
163 DO ipert = 1, nperturb
164 xnum_rnoise(ipert,i) = rnoise(ipert,i)
165 ENDDO
166 ENDIF
167 ENDDO
168 IF(nsphsol /= 0)THEN
169 DO i=1,numels8
170 inum(14,i)=sol2sph(1,i)
171 inum(15,i)=sol2sph(2,i)
172 inum(16,i)=sol2sph_typ(i)
173 ENDDO
174 END IF
175C
176 DO i=1,numels
177 xep(i)=cep(i)
178 ENDDO
179C
180 DO i = 1, numels
181 ii = i
182 npn = 1
183 jhbe= 1
184 jpor=0
185 mid = ixs(1,ii)
186 mln = nint(pm(19,abs(mid)))
187 IF (mid < 0) THEN
188 IF (mln==6.AND.jpor/=2) mln=17
189 IF (mln==46) mln=47
190 mid = iabs(mid)
191 ENDIF
192 IF (mln == 36 .or. mln == 47) THEN
193 nuvar = ipm(8,mid)
194 ELSE
195 nuvar = 0 ! no matter what
196 ENDIF
197 pid= ixs(10,ii)
198 iso= isolnod(ii)
199 iplast= 1
200 icpre = 0
201 icstr = 0
202 irep = 0
203 istrain = 0
204 nfail0 = mat_param(mid)%NFAIL
205 nloc_fail = mat_param(mid)%NLOC
206 ieos = 0
207 ivisc0 = 0
208 nlay = 1
209 tshell = 0
210 isvis = 0
211 IF (pid/=0) THEN
212 npn = igeo(4,pid)
213 issn = iabs(igeo(5,pid))
214 irep = igeo(6,pid)
215 jhbe = igeo(10,pid)
216 igt = igeo(11,pid)
217 istrain = igeo(12,pid)
218 icpre = iabs(igeo(13,pid))
219 icstr = igeo(14,pid)
220 iint = igeo(15,pid)
221 jcvt = iabs(igeo(16,pid))
222 itet4 = igeo(20,pid)
223 itet10 = igeo(50,pid)
224 IF (igt == 22) THEN
225 nlay = igeo(30,pid)
226 DO il=1,nlay
227 imat = igeo(100+il,pid)
228 nfail0 = max(nfail0,mat_param(imat)%NFAIL)
229 IF (mat_param(imat)%IVISC > 0) ivisc0 = 1
230 ENDDO
231 ELSEIF (mat_param(mid)%IVISC > 0) THEN
232 ivisc0 = 1
233 ENDIF
234C IVISCO0 cannot put in the PID because is for MID (it can be used in IGEO)
235 igeo(34,pid) = ivisc0
236c----------
237 IF (igt /= 15) iplast = igeo(9,pid)
238 IF (igt==15) jpor=2*nint(geo(28,pid))
239 jclos=0
240 IF (geo(130,pid)>0.) jclos=1
241C--------------Navier Storks Vis
242 IF (geo(16,pid)/=zero.OR.geo(17,pid)/=zero) isvis=1
243 ENDIF
244 IF((jhbe == 14 .OR. jhbe == 222).AND.iso==8) numels8a=numels8a+1
245 IF (jhbe == 12) jhbe = 4
246 IF (jhbe==2) jhbe = 0
247c
248 jale_from_mat = nint(pm(72,mid))
249 jale_from_prop = igeo(62,pid)
250 jale = max(jale_from_mat, jale_from_prop) !if inconsistent, error message was displayed in PART reader
251 jlag=0
252 IF(jale == 0 .AND. mln /= 18)jlag=1
253 jeul=0
254 IF(jale==2)THEN
255 jale=0
256 jeul=1
257 ELSEIF(jale == 3) THEN
258 jlag = 1
259 jale = 1
260 ENDIF
261 IF(mln/=50)jtur=nint(pm(70,mid))
262 jthe=nint(pm(71,mid))
263 IF (jlag==0 .AND. pid/=0) issn=4
264C sorting on elem delete for rigidbody
265C IRB = 0 : active elem
266C IRB = 1 : inactive elem and optimized for SPMD
267C IRB = 2 : inactive elem but optimized to be active in SPMD
268 irb = isoloff(i)
269C
270 jsms=0
271 IF(isms/=0)THEN
272 IF(idtgrs/=0)THEN
273 IF(tagprt_sms(iparts(ii))/=0)jsms=1
274 ELSE
275 jsms=1
276 END IF
277 END IF
278 ieos = ipm(4,mid)
279C
280 nsphdir =igeo(37,pid)
281 ipartsph=igeo(38,pid)
282 igeo(35,pid) = isvis
283C Bolt preloading flag
284 iboltp = 0
285 IF(npreload > 0)THEN
286 iboltp = iflag_bpreload(ii)
287 ENDIF
288
289C
290C 1---------------------------------
291C
292C classify shell16 after brick20
293 IF(iso==16)iso=21
294C IGT =MY_SHIFTL(IGT,0)
295 jsms=my_shiftl(jsms,26)
296 iso =my_shiftl(iso,27)
297C attention ISO doit rester en poids le plus fort
298 itri(1,i)=iso+jsms+igt
299C 2---------------------------------
300C IPARTSPH=MY_SHIFTL(IPARTSPH,0)
301 itri(2,i)=ipartsph ! must remain alone for this key (part index)
302C 3---------------------------------
303C JTHE=MY_SHIFTL(JTHE,0)
304 jtur=my_shiftl(jtur,1)
305 jeul=my_shiftl(jeul,2)
306 jlag=my_shiftl(jlag,3)
307 jale=my_shiftl(jale,4)
308 issn=my_shiftl(issn,5)
309 jhbe=my_shiftl(jhbe,9)
310 jpor=my_shiftl(jpor,13)
311 irb=my_shiftl(irb,18)
312 mln =my_shiftl(mln,22)
313 itri(3,i)=mln+jhbe+issn+jale+jlag+jeul+jtur+jthe+jpor+irb
314C
315C 4---------------------------------
316 npn =my_shiftl(npn,3)
317 iplast=my_shiftl(iplast,13)
318 icpre =my_shiftl(icpre,16)
319 icstr =icstr/100+2*mod(icstr/10,10)+4*mod(icstr,10)
320 icstr =my_shiftl(icstr,18)
321 irep=my_shiftl(irep,20)
322 jcvt=my_shiftl(jcvt,22)
323 iint=my_shiftl(iint,24)
324 istrain=my_shiftl(istrain,26)
325 itet4=my_shiftl(itet4,27)
326 nfail = my_shiftl(nfail0,29)
327 itri(4,i)=jclos+npn+iplast+icpre+icstr+irep+iint+jcvt+istrain
328 . +itet4+nfail
329C 5---------------------------------
330 itri(5,i)=mid
331C 6---------------------------------
332 itri(6,i)=pid
333C 7---------------------------------
334 ieos = my_shiftl(ieos,0)
335 ivisc = my_shiftl(ivisc0,4)
336 nuvar = my_shiftl(nuvar,5)
337 isvis = my_shiftl(isvis,15)
338 iboltp = my_shiftl(iboltp,16)
339 itet10 = my_shiftl(itet10,17)
340 nloc_fail = my_shiftl(nloc_fail,19)
341C next = MY_SHIFTL(next,21)
342 itri(7,i)=ieos+ivisc+nuvar+isvis+iboltp+itet10+nloc_fail
343C 8---------------------------------
344 itri(8,i )= damp_range_part(iparts(ii))
345 ENDDO
346C
347 mode=0
348 CALL my_orders( mode, work, itri, index, numels , 8)
349C
350 DO i=1,numels
351 iparts(i) =inum(1,index(i))
352 isolnod(i)=inum(13,index(i))
353 IF (nsubdom>0) tag_elsf(i)=inum_r2r(index(i))
354 IF (nperturb > 0) THEN
355 DO ipert = 1, nperturb
356 rnoise(ipert,i) = xnum_rnoise(ipert,index(i))
357 ENDDO
358 ENDIF
359 ENDDO
360
361 DO i=1,numels
362 cep(i)=xep(index(i))
363 permutation%SOLID(i)=index2(index(i))
364 ENDDO
365
366 DO k=1,11
367 DO i=1,numels
368 ixs(k,i)=inum(k+1,index(i))
369 ENDDO
370 ENDDO
371C
372C ISOLOFF
373C
374 DO i = 1, numels
375 inum(3,i) = isoloff(i)
376 END DO
377C
378 DO i = 1, numels
379 isoloff(i) = inum(3,index(i))
380 END DO
381C
382C BOLT_PRELOAD
383C
384 IF (npreload > 0) THEN
385 DO i = 1, numels
386 inum(4,i) = iflag_bpreload(i)
387 END DO
388C
389 DO i = 1, numels
390 iflag_bpreload(i) = inum(4,index(i))
391 END DO
392 ENDIF
393
394C
395 IF (numels10+numels20+numels16 > 0) THEN
396 DO i = 1, numels10
397 ii = i + numels8
398 inum(1,ii)=ixs10(1,i)
399 inum(2,ii)=ixs10(2,i)
400 inum(3,ii)=ixs10(3,i)
401 inum(4,ii)=ixs10(4,i)
402 inum(5,ii)=ixs10(5,i)
403 inum(6,ii)=ixs10(6,i)
404 ENDDO
405C
406 DO i = 1, numels10
407 ii = i + numels8
408 ixs10(1,i)=inum(1,index(ii))
409 ixs10(2,i)=inum(2,index(ii))
410 ixs10(3,i)=inum(3,index(ii))
411 ixs10(4,i)=inum(4,index(ii))
412 ixs10(5,i)=inum(5,index(ii))
413 ixs10(6,i)=inum(6,index(ii))
414 ENDDO
415C
416 DO i = 1, numels20
417 ii = i + numels8 + numels10
418 inum(1,ii) =ixs20(1,i)
419 inum(2,ii) =ixs20(2,i)
420 inum(3,ii) =ixs20(3,i)
421 inum(4,ii) =ixs20(4,i)
422 inum(5,ii) =ixs20(5,i)
423 inum(6,ii) =ixs20(6,i)
424 inum(7,ii) =ixs20(7,i)
425 inum(8,ii) =ixs20(8,i)
426 inum(9,ii) =ixs20(9,i)
427 inum(10,ii)=ixs20(10,i)
428 inum(11,ii)=ixs20(11,i)
429 inum(12,ii)=ixs20(12,i)
430 ENDDO
431C
432 DO i = 1, numels20
433 ii = i + numels8 + numels10
434 ixs20(1,i)=inum(1,index(ii))
435 ixs20(2,i)=inum(2,index(ii))
436 ixs20(3,i)=inum(3,index(ii))
437 ixs20(4,i)=inum(4,index(ii))
438 ixs20(5,i)=inum(5,index(ii))
439 ixs20(6,i)=inum(6,index(ii))
440 ixs20(7,i)=inum(7,index(ii))
441 ixs20(8,i)=inum(8,index(ii))
442 ixs20(9,i)=inum(9,index(ii))
443 ixs20(10,i)=inum(10,index(ii))
444 ixs20(11,i)=inum(11,index(ii))
445 ixs20(12,i)=inum(12,index(ii))
446 ENDDO
447C
448 DO i = 1, numels16
449 ii = i + numels8 + numels10 + numels20
450 inum(1,ii) =ixs16(1,i)
451 inum(2,ii) =ixs16(2,i)
452 inum(3,ii) =ixs16(3,i)
453 inum(4,ii) =ixs16(4,i)
454 inum(5,ii) =ixs16(5,i)
455 inum(6,ii) =ixs16(6,i)
456 inum(7,ii) =ixs16(7,i)
457 inum(8,ii) =ixs16(8,i)
458 ENDDO
459C
460 DO i = 1, numels16
461 ii = i + numels8 + numels10 + numels20
462 ixs16(1,i)=inum(1,index(ii))
463 ixs16(2,i)=inum(2,index(ii))
464 ixs16(3,i)=inum(3,index(ii))
465 ixs16(4,i)=inum(4,index(ii))
466 ixs16(5,i)=inum(5,index(ii))
467 ixs16(6,i)=inum(6,index(ii))
468 ixs16(7,i)=inum(7,index(ii))
469 ixs16(8,i)=inum(8,index(ii))
470 ENDDO
471C
472 ENDIF
473C
474C INDEX INVERSION (IN ITR1)
475C
476 DO i=1,numels
477 itr1(index(i))=i
478 ENDDO
479C
480C RENUMBERING FOR SURFACES
481C
482 DO i=1,nsurf
483 nn=igrsurf(i)%NSEG
484 DO j=1,nn
485 IF (igrsurf(i)%ELTYP(j) == 1)
486 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
487 ENDDO
488 ENDDO
489C
490C RENUMBERING FOR SOLID GROUPS
491C
492 DO i=1,ngrbric
493 nn=igrbric(i)%NENTITY
494 DO j=1,nn
495 igrbric(i)%ENTITY(j) = itr1(igrbric(i)%ENTITY(j))
496 ENDDO
497 ENDDO
498C
499C RENUMBERING FOR SPH CONVERSION
500C
501 IF(nsphsol /= 0)THEN
502 DO i=1,numsph
503 IF(sph2sol(i) /= 0)sph2sol(i)=itr1(sph2sol(i))
504 ENDDO
505C
506C rebuild SOL2SPH
507 DO i=1,numels8
508 sol2sph(1,i)=inum(14,index(i))
509 sol2sph(2,i)=inum(15,index(i))
510 sol2sph_typ(i)=inum(16,index(i))
511 END DO
512 END IF
513C
514C renumbering INVERSE CONNECTIVITY
515C
516 DO i=1,8*numels+6*numels10+12*numels20+8*numels16
517 IF(nod2els(i) /= 0)nod2els(i)=itr1(nod2els(i))
518 END DO
519
520! -----------------------
521! reordering for cluster typ=1 (solid cluster)
522 DO i=1,ncluster
523 cluster_typ = clusters(i)%TYPE
524 IF(cluster_typ==1) THEN
525 cluster_nel = clusters(i)%NEL
526 ALLOCATE( save_cluster( cluster_nel ) )
527 save_cluster( 1:cluster_nel ) = clusters(i)%ELEM( 1:cluster_nel )
528 DO j=1,cluster_nel
529 clusters(i)%ELEM(j) = itr1( save_cluster( j ) )
530 ENDDO
531 DEALLOCATE( save_cluster )
532 ENDIF
533 ENDDO
534! -----------------------
535C
536C--------------------------------------------------------------
537C SUPER_GROUPS DETERMINATION
538C--------------------------------------------------------------
539 nd=1
540 DO i=2,numels
541 ii0=itri(1,index(i))
542 jj0=itri(1,index(i-1))
543 ii=itri(2,index(i))
544 jj=itri(2,index(i-1))
545 ii1=itri(3,index(i))
546 jj1=itri(3,index(i-1))
547 ii2=itri(4,index(i))
548 jj2=itri(4,index(i-1))
549 ii3=itri(5,index(i))
550 jj3=itri(5,index(i-1))
551 ii4=itri(6,index(i))
552 jj4=itri(6,index(i-1))
553 ii5=itri(7,index(i))
554 jj5=itri(7,index(i-1))
555 ii6=itri(8,index(i))
556 jj6=itri(8,index(i-1))
557 IF(ii0/=jj0.OR.ii/=jj.OR.ii1/=jj1.OR.ii2/=jj2.OR.
558 . ii5/=jj5.OR.ii3/=jj3.OR.ii4/=jj4.OR.
559 . ii6/=jj6) THEN
560 nd=nd+1
561 eadd(nd)=i
562 ENDIF
563 ENDDO
564 eadd(nd+1) = numels+1
565 DEALLOCATE(index2)
566c
567 IF (nperturb > 0) THEN
568 IF (ALLOCATED(xnum_rnoise)) DEALLOCATE(xnum_rnoise)
569 ENDIF
570C-----------
571 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
cluster_mod
Definition cluster_mod.F:40
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_elsf
integer, dimension(:), allocatable tag_elsf
Definition r2r_mod.F:141
reorder_mod
Definition reorder_mod.F:45
reorder_mod::permutation
type(reorder_struct_) permutation
Definition reorder_mod.F:54
my_shiftr
int my_shiftr(int *a, int *n)
Definition precision.c:45
my_shiftl
int my_shiftl(int *a, int *n)
Definition precision.c:36
my_and
int my_and(int *a, int *b)
Definition precision.c:54
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