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, trimat)

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,
integer, intent(inout) trimat )

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