OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
nintrr.F File Reference
#include "implicit_f.inc"
#include "ngr2usr_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

integer function nintri (iext, antn, m, n, m1)
integer function nintlst (list, nlist, ix, nix, numel, mess, ix1, ix2, index, kk, type, id, titr)
integer function nintlst2 (list, nlist, indexl, ix, nix, numel, mess, ix1, ix2, index, kk)
integer function ngr2usr (iu, igr, ngr)
integer function ngr2usrn (iu, igrnod, ngrnod, num)
integer function grsize (igu, igrnod, grlen)
integer function grsizen (igu, igrnod, grlen)
integer function grsize_ele (igu, igrelem, ngrelem)
integer function grsize_ele_trans (igu, igrelem, ngrelem, seatbelt_shell_to_spring)
subroutine sortgroup (ixs_s, ixs_s_ind, ixq_s, ixq_s_ind, ixc_s, ixc_s_ind, ixt_s, ixt_s_ind, ixp_s, ixp_s_ind, ixr_s, ixr_s_ind, ixtg_s, ixtg_s_ind, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, leni)
integer function user2sys (iu, ixx_s, nix, cur, last)
integer function nintlstn (list, nlist, ixx_s, nix, numel, mess, ixx_s_ind, index, type, id, titr)
integer function nintrigr (iext, igr, ngr)

Function/Subroutine Documentation

◆ grsize()

integer function grsize ( integer igu,
type (group_), dimension(ngrnod) igrnod,
integer grlen )

Definition at line 445 of file nintrr.F.

446C-----------------------------------------------
447C M o d u l e s
448C-----------------------------------------------
449 USE groupdef_mod
450C-----------------------------------------------
451C I m p l i c i t T y p e s
452C-----------------------------------------------
453#include "implicit_f.inc"
454C-----------------------------------------------
455C C o m m o n B l o c k s
456C-----------------------------------------------
457#include "com04_c.inc"
458C-----------------------------------------------
459C D u m m y A r g u m e n t s
460C-----------------------------------------------
461 INTEGER IGU,GRLEN
462C-----------------------------------------------
463 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
464C-----------------------------------------------
465C L o c a l V a r i a b l e s
466C-----------------------------------------------
467 INTEGER I,IGS
468C-----------------------------------------------
469 grsize = 0
470 IF (igu > 0) THEN
471 DO i=1,grlen
472 IF (igu == igrnod(i)%ID) THEN
473 grsize = igrnod(i)%NENTITY
474 igs = i
475 EXIT
476 ENDIF
477 ENDDO
478 ENDIF
479C-----------
480 RETURN
groupdef_mod
Definition groupdef_mod.F:668
grsize
integer function grsize(igu, igrnod, grlen)
Definition nintrr.F:446

◆ grsize_ele()

integer function grsize_ele ( integer igu,
type (group_), dimension(ngrelem) igrelem,
integer ngrelem )

Definition at line 534 of file nintrr.F.

535C-----------------------------------------------
536C M o d u l e s
537C-----------------------------------------------
538 USE groupdef_mod
539C-----------------------------------------------
540C I m p l i c i t T y p e s
541C-----------------------------------------------
542#include "implicit_f.inc"
543C-----------------------------------------------
544C D u m m y A r g u m e n t s
545C-----------------------------------------------
546 INTEGER IGU,NGRELEM
547C-----------------------------------------------
548 TYPE (GROUP_) , DIMENSION(NGRELEM) :: IGRELEM
549C-----------------------------------------------
550C L o c a l V a r i a b l e s
551C-----------------------------------------------
552 INTEGER I,IGS
553C-----------------------------------------------
554 grsize_ele = 0
555 IF (igu > 0) THEN
556 DO i=1,ngrelem
557 IF (igu == igrelem(i)%ID) THEN
558 grsize_ele = igrelem(i)%NENTITY
559 igs = i
560 EXIT
561 ENDIF
562 ENDDO
563 ENDIF
564C-----------
565 RETURN
grsize_ele
integer function grsize_ele(igu, igrelem, ngrelem)
Definition nintrr.F:535

◆ grsize_ele_trans()

integer function grsize_ele_trans ( integer, intent(in) igu,
type (group_), dimension(ngrelem), intent(in) igrelem,
integer, intent(in) ngrelem,
integer, dimension(numelc,2), intent(in) seatbelt_shell_to_spring )

Definition at line 574 of file nintrr.F.

575C-----------------------------------------------
576C M o d u l e s
577C-----------------------------------------------
578 USE groupdef_mod
579C-----------------------------------------------
580C I m p l i c i t T y p e s
581C-----------------------------------------------
582#include "implicit_f.inc"
583C-----------------------------------------------
584C C o m m o n B l o c k s
585C-----------------------------------------------
586#include "com04_c.inc"
587C-----------------------------------------------
588C D u m m y A r g u m e n t s
589C-----------------------------------------------
590 INTEGER,INTENT(IN)::IGU,NGRELEM
591C-----------------------------------------------
592 TYPE (GROUP_) , DIMENSION(NGRELEM) , INTENT(IN) :: IGRELEM
593 INTEGER,INTENT(IN)::SEATBELT_SHELL_TO_SPRING(NUMELC,2)
594C-----------------------------------------------
595C L o c a l V a r i a b l e s
596C-----------------------------------------------
597 INTEGER I,J,IE
598C-----------------------------------------------
599 grsize_ele_trans = 0
600 IF (igu > 0) THEN
601 DO i=1,ngrelem
602 IF (igu == igrelem(i)%ID) THEN
603 DO j=1,igrelem(i)%NENTITY
604 ie=igrelem(i)%ENTITY(j)
605 IF(seatbelt_shell_to_spring(ie,1) /= 0)
606 . grsize_ele_trans = grsize_ele_trans + 1
607 IF(seatbelt_shell_to_spring(ie,2) /= 0)
608 . grsize_ele_trans = grsize_ele_trans + 1
609 ENDDO
610 ENDIF
611 ENDDO
612 ENDIF
613C-----------
614 RETURN
grsize_ele_trans
integer function grsize_ele_trans(igu, igrelem, ngrelem, seatbelt_shell_to_spring)
Definition nintrr.F:575

◆ grsizen()

integer function grsizen ( integer igu,
type (group_), dimension(grlen) igrnod,
integer grlen )

Definition at line 493 of file nintrr.F.

494C-----------------------------------------------
495C M o d u l e s
496C-----------------------------------------------
497 USE groupdef_mod
498C-----------------------------------------------
499C I m p l i c i t T y p e s
500C-----------------------------------------------
501#include "implicit_f.inc"
502C-----------------------------------------------
503C D u m m y A r g u m e n t s
504C-----------------------------------------------
505 INTEGER IGU,GRLEN
506C-----------------------------------------------
507 TYPE (GROUP_) , DIMENSION(GRLEN) :: IGRNOD
508C-----------------------------------------------
509C L o c a l V a r i a b l e s
510C-----------------------------------------------
511 INTEGER I,IGS
512C-----------------------------------------------
513 grsizen = 0
514 IF (igu > 0) THEN
515 DO i=1,grlen
516 IF (igu == igrnod(i)%ID) THEN
517 grsizen = igrnod(i)%NENTITY
518 igs = i
519 EXIT
520 ENDIF
521 ENDDO
522 ENDIF
523C-----------
524 RETURN
grsizen
integer function grsizen(igu, igrnod, grlen)
Definition nintrr.F:494

◆ ngr2usr()

integer function ngr2usr ( integer, intent(in) iu,
integer, dimension(*), intent(in) igr,
integer, intent(in) ngr )

Definition at line 322 of file nintrr.F.

323C-----------------------------------------------
324C M o d u l e s
325C-----------------------------------------------
326 USE message_mod
327 USE hm_current_option_mod
328 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
329C-----------------------------------------------
330C I m p l i c i t T y p e s
331C-----------------------------------------------
332#include "implicit_f.inc"
333C-----------------------------------------------
334C C o m m o n B l o c k s
335C-----------------------------------------------
336#include "ngr2usr_c.inc"
337C-----------------------------------------------
338C D u m m y A r g u m e n t s
339C-----------------------------------------------
340 INTEGER,INTENT(IN) :: IU,IGR(*),NGR
341C-----------------------------------------------
342C L o c a l V a r i a b l e s
343C-----------------------------------------------
344 INTEGER I, IE, ID
345 CHARACTER(LEN=NCHARKEY) :: KEY
346 CHARACTER(LEN=NCHARTITLE) :: TITR
347C-----------------------------------------------
348C S o u r c e L i n e s
349C-----------------------------------------------
350 ngr2usr=0
351 IF(iu==0)THEN
352 ngr2usr=0
353 RETURN
354 ENDIF
355 DO i=1,ngr
356 ie=igr(i)
357 IF(ie==iu)THEN
358 ngr2usr=i
359 RETURN
360 ENDIF
361 ENDDO
362 IF(iskip_ngr2usr_error==0) THEN
363
364 CALL hm_get_current_option(option_id = id,
365 . option_titr = titr,
366 . keyword1 = key)
367 CALL ancmsg(msgid=2087,
368 . msgtype=msgerror,
369 . anmode=aninfo,
370 . c1=key,
371 . i1=id,
372 . c2=key,
373 . c3=titr,
374 . i2=iu)
375 ENDIF
376 iskip_ngr2usr_error = 0
377 RETURN
hm_current_option_mod::hm_get_current_option
Definition hm_current_option_mod.F:31
id
initmumps id
Definition multiplerhs_example.m:4
hm_current_option_mod
Definition hm_current_option_mod.F:29
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
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

◆ ngr2usrn()

integer function ngr2usrn ( integer iu,
type (group_), dimension(ngrnod) igrnod,
integer ngrnod,
integer num )

Definition at line 403 of file nintrr.F.

404C-----------------------------------------------
405C M o d u l e s
406C-----------------------------------------------
407 USE message_mod
408 USE groupdef_mod
409C-----------------------------------------------
410C I m p l i c i t T y p e s
411C-----------------------------------------------
412#include "implicit_f.inc"
413C-----------------------------------------------
414C D u m m y A r g u m e n t s
415C-----------------------------------------------
416 INTEGER IU,NGRNOD,NUM
417C-----------------------------------------------
418 TYPE (GROUP_) ,DIMENSION(NGRNOD) :: IGRNOD
419C-----------------------------------------------
420C L o c a l V a r i a b l e s
421C-----------------------------------------------
422 INTEGER I
423C-----------------------------------------------
424 ngr2usrn = 0
425 IF(iu == 0)THEN
426 num = 0
427 ngr2usrn=0
428 RETURN
429 ENDIF
430 DO i=1,ngrnod
431 IF (iu == igrnod(i)%ID) THEN
432 num = igrnod(i)%NENTITY
433 ngr2usrn=i
434 RETURN
435 ENDIF
436 ENDDO
437C-----------
438 RETURN
ngr2usrn
integer function ngr2usrn(iu, igrnod, ngrnod, num)
Definition nintrr.F:404

◆ nintlst()

integer function nintlst ( integer, dimension(*) list,
integer nlist,
integer, dimension(nix,*) ix,
integer nix,
integer numel,
character mess,
integer, dimension(*) ix1,
integer, dimension(*) ix2,
integer, dimension(*) index,
integer kk,
character(len=nchartitle) type,
integer id,
character(len=nchartitle) titr )

Definition at line 77 of file nintrr.F.

80C-----------------------------------------------
81C M o d u l e s
82C-----------------------------------------------
83 USE message_mod
84 USE names_and_titles_mod , ONLY : nchartitle
85C FUNCTION RETURNS SYSTEM ID FROM A LIST OF USER ELEMENTS
86C-----------------------------------------------
87C I m p l i c i t T y p e s
88C-----------------------------------------------
89#include "implicit_f.inc"
90C-----------------------------------------------
91C C o m m o n B l o c k s
92C-----------------------------------------------
93C-----------------------------------------------
94C D u m m y A r g u m e n t s
95C-----------------------------------------------
96 INTEGER NLIST,KK,NIX,NUMEL
97 CHARACTER MESS*40
98 INTEGER LIST(*),IX(NIX,*),INDEX(*),IX1(*),IX2(*)
99 INTEGER ID
100 CHARACTER(LEN=NCHARTITLE) :: TYPE,TITR
101C-----------------------------------------------
102C L o c a l V a r i a b l e s
103C-----------------------------------------------
104 INTEGER I, J,NEL,NOLD,K,
105 . IWORK(70000)
106C-----------------------
107C TRI DE LIST EN ORDRE CROISSANT
108C WITH REMOVAL OF DUPLICATE NOS
109C-----------------------
110 CALL my_orders(0,iwork,list,index,nlist,1)
111 DO i=1,nlist
112 index(nlist+i) = list(index(i))
113 ENDDO
114 k=1
115 nold = index(nlist+1)
116 DO i=1,nlist
117 IF(nold/=index(nlist+i))k=k+1
118 list(k) = index(nlist+i)
119 nold = index(nlist+i)
120 ENDDO
121 nel=k
122C-----------------------
123C TRI DE IX EN ORDRE CROISSANT si KK = 0
124C-----------------------
125 IF(kk==0)THEN
126 DO i=1,numel
127 ix2(i) = ix(nix,i)
128 ENDDO
129 CALL my_orders(0,iwork,ix2,index,numel,1)
130 DO i=1,numel
131 ix1(i) = ix2(index(i))
132 ENDDO
133 DO i=1,numel
134 ix2(i) = index(i)
135 ENDDO
136 ENDIF
137C-----------------------
138C SEARCH FOR ELEMENTS OF LIST() IN IX()
139C ALGO < NLIST+NUMEL
140C-----------------------
141 i=1
142 j=1
143 DO i=1,nel
144 DO WHILE(list(i)>ix1(j).AND.j<numel)
145 j=j+1
146 ENDDO
147 IF(list(i)==ix1(j))THEN
148 list(i)=ix2(j)
149 ELSE
150 CALL ancmsg(msgid=70,
151 . msgtype=msgerror,
152 . anmode=aninfo,
153 . c1=TYPE,
154 . I1=id,
155 . c2=titr,
156 . i2=list(i))
157 nintlst=i-1
158 RETURN
159 ENDIF
160 ENDDO
161C
162 nintlst=nel
163 RETURN
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
nintlst
integer function nintlst(list, nlist, ix, nix, numel, mess, ix1, ix2, index, kk, type, id, titr)
Definition nintrr.F:80

◆ nintlst2()

integer function nintlst2 ( integer, dimension(*) list,
integer nlist,
integer, dimension(*) indexl,
integer, dimension(nix,*) ix,
integer nix,
integer numel,
character mess,
integer, dimension(*) ix1,
integer, dimension(*) ix2,
integer, dimension(*) index,
integer kk )

Definition at line 175 of file nintrr.F.

177 USE message_mod
178C FUNCTION RETURNS SYSTEM ID FROM A LIST OF USER ELEMENTS, ALLOWS ZEROS.
179C-----------------------------------------------
180C I m p l i c i t T y p e s
181C-----------------------------------------------
182#include "implicit_f.inc"
183C-----------------------------------------------
184C D u m m y A r g u m e n t s
185C-----------------------------------------------
186 INTEGER NLIST,KK,NIX,NUMEL
187 CHARACTER MESS*40
188 INTEGER LIST(*),INDEXL(*),IX(NIX,*),INDEX(*),IX1(*),IX2(*)
189C-----------------------------------------------
190C L o c a l V a r i a b l e s
191C-----------------------------------------------
192 INTEGER I, J,
193 . IWORK(70000)
194C-----------------------
195C TRI DE LIST EN ORDRE CROISSANT
196C-----------------------
197 CALL my_orders(0,iwork,list,indexl,nlist,1)
198C-----------------------
199C TRI DE IX EN ORDRE CROISSANT si KK = 0
200C-----------------------
201 IF(kk==0)THEN
202 DO i=1,numel
203 ix2(i) = ix(nix,i)
204 ENDDO
205 CALL my_orders(0,iwork,ix2,index,numel,1)
206 DO i=1,numel
207 ix1(i) = ix2(index(i))
208 ENDDO
209 DO i=1,numel
210 ix2(i) = index(i)
211 ENDDO
212 ENDIF
213C-----------------------
214C SEARCH FOR ELEMENTS OF LIST() IN IX()
215C ALGO < NLIST+NUMEL
216C-----------------------
217 i=1
218 j=1
219 DO i=1,nlist
220 DO WHILE(list(indexl(i))>ix1(j).AND.j<numel)
221 j=j+1
222 ENDDO
223 IF(list(indexl(i))==ix1(j))THEN
224 list(indexl(i))=ix2(j)
225 ELSEIF(list(indexl(i))/=0)THEN
226C WRITE(IOUT,*)MESS
227C WRITE(IOUT,*)' ** ERROR : ELEMENT ',LIST(I),
228C . ' DOESNT''EXIST'
229C WRITE(ISTDO,*)MESS
230C WRITE(ISTDO,*)' ** ERROR : ELEMENT ',LIST(I),
231C . ' DOESNT''EXIST'
232C IERR=IERR+1
233 CALL ancmsg(msgid=71,
234 . msgtype=msgerror,
235 . anmode=aninfo,
236 . c1=mess,
237 . i1=list(indexl(i)))
238 nintlst2=i-1
239 RETURN
240 ENDIF
241 ENDDO
242C
243 nintlst2=nlist
244 RETURN
nintlst2
integer function nintlst2(list, nlist, indexl, ix, nix, numel, mess, ix1, ix2, index, kk)
Definition nintrr.F:177

◆ nintlstn()

integer function nintlstn ( integer, dimension(*) list,
integer nlist,
integer, dimension(*) ixx_s,
integer nix,
integer numel,
character mess,
integer, dimension(*) ixx_s_ind,
integer, dimension(*) index,
character type,
integer id,
character(len=nchartitle) titr )

Definition at line 796 of file nintrr.F.

798 USE message_mod
799 USE names_and_titles_mod , ONLY : nchartitle
800C FUNCTION RETURNS SYSTEM ID FROM A LIST OF USER ELEMENTS
801C-----------------------------------------------
802C I m p l i c i t T y p e s
803C-----------------------------------------------
804#include "implicit_f.inc"
805C-----------------------------------------------
806C D u m m y A r g u m e n t s
807C-----------------------------------------------
808 INTEGER NLIST,NIX,NUMEL
809 CHARACTER MESS*40
810 INTEGER LIST(*),IXX_S(*),INDEX(*),IXX_S_IND(*)
811 INTEGER ID
812 CHARACTER(LEN=NCHARTITLE) :: TITR
813 CHARACTER TYPE*4
814C-----------------------------------------------
815C L o c a l V a r i a b l e s
816C-----------------------------------------------
817 INTEGER I, J,NEL,NOLD,K,
818 . IWORK(70000)
819 INTEGER USER2SYS
820C-----------------------
821C TRI DE LIST EN ORDRE CROISSANT
822C WITH REMOVAL OF DUPLICATE NOS
823C-----------------------
824 CALL my_orders(0,iwork,list,index,nlist,1)
825 DO i=1,nlist
826 index(nlist+i) = list(index(i))
827 ENDDO
828 k=1
829 nold = index(nlist+1)
830 DO i=1,nlist
831 IF(nold/=index(nlist+i))k=k+1
832 list(k) = index(nlist+i)
833 nold = index(nlist+i)
834 ENDDO
835 nel=k
836C-----------------------
837C SEARCH FOR ELEMENTS OF LIST() IN IXX_S (sorted)
838C-----------------------
839 j=0
840 DO i=1,nel
841 j=user2sys(list(i),ixx_s,nix,j+1,numel)
842 IF(j /= 0)THEN
843 list(i)=ixx_s_ind(j)
844 ELSE
845 CALL ancmsg(msgid=70,
846 . msgtype=msgerror,
847 . anmode=aninfo,
848 . c1=TYPE,
849 . I1=id,
850 . c2=titr,
851 . i2=list(i))
852 nintlstn=i-1
853 RETURN
854 ENDIF
855 ENDDO
856C
857 nintlstn=nel
858
859 RETURN
nintlstn
integer function nintlstn(list, nlist, ixx_s, nix, numel, mess, ixx_s_ind, index, type, id, titr)
Definition nintrr.F:798
user2sys
integer function user2sys(iu, ixx_s, nix, cur, last)
Definition nintrr.F:740

◆ nintri()

integer function nintri ( integer iext,
integer, dimension(m,n) antn,
integer m,
integer n,
integer m1 )

Definition at line 44 of file nintrr.F.

45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER IEXT, M, N, M1, ANTN(M,N)
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER I, IE
57 DO i=1,n
58 ie=antn(m1,i)
59 IF(ie==iext)THEN
60 nintri=i
61 RETURN
62 ENDIF
63 ENDDO
64 nintri=0
65 RETURN
nintri
integer function nintri(iext, antn, m, n, m1)
Definition nintrr.F:45

◆ nintrigr()

integer function nintrigr ( integer iext,
type (group_), dimension(ngr) igr,
integer ngr )

Definition at line 868 of file nintrr.F.

869C-----------------------------------------------
870C M o d u l e s
871C-----------------------------------------------
872 USE groupdef_mod
873C-----------------------------------------------
874C I m p l i c i t T y p e s
875C-----------------------------------------------
876#include "implicit_f.inc"
877C-----------------------------------------------
878C D u m m y A r g u m e n t s
879C-----------------------------------------------
880 INTEGER IEXT,NGR
881C-----------------------------------------------
882 TYPE (GROUP_) , DIMENSION(NGR) :: IGR
883C-----------------------------------------------
884C L o c a l V a r i a b l e s
885C-----------------------------------------------
886 INTEGER I, IE
887C-----------------------------------------------
888 DO i=1,ngr
889 ie=igr(i)%ID
890 IF(ie==iext)THEN
891 nintrigr=i
892 RETURN
893 ENDIF
894 ENDDO
895 nintrigr=0
896!
897 RETURN
nintrigr
integer function nintrigr(iext, igr, ngr)
Definition nintrr.F:869

◆ sortgroup()

subroutine sortgroup ( integer, dimension(*) ixs_s,
integer, dimension(*) ixs_s_ind,
integer, dimension(*) ixq_s,
integer, dimension(*) ixq_s_ind,
integer, dimension(*) ixc_s,
integer, dimension(*) ixc_s_ind,
integer, dimension(*) ixt_s,
integer, dimension(*) ixt_s_ind,
integer, dimension(*) ixp_s,
integer, dimension(*) ixp_s_ind,
integer, dimension(*) ixr_s,
integer, dimension(*) ixr_s_ind,
integer, dimension(*) ixtg_s,
integer, dimension(*) ixtg_s_ind,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer leni )

Definition at line 623 of file nintrr.F.

627C GROUP SORTING vs USER ID
628 use element_mod , only : nixs,nixq,nixc,nixp,nixt,nixr,nixtg
629C-----------------------------------------------
630C I m p l i c i t T y p e s
631C-----------------------------------------------
632#include "implicit_f.inc"
633C-----------------------------------------------
634C C o m m o n B l o c k s
635C-----------------------------------------------
636#include "com04_c.inc"
637C-----------------------------------------------
638C D u m m y A r g u m e n t s
639C-----------------------------------------------
640 INTEGER IXS_S(*),IXS_S_IND(*),IXQ_S(*),IXQ_S_IND(*),IXC_S(*),
641 1 IXC_S_IND(*),IXT_S(*),IXT_S_IND(*),IXP_S(*),
642 2 IXP_S_IND(*),IXR_S(*),IXR_S_IND(*),
643 3 IXTG_S(*),IXTG_S_IND(*),
644 4 IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*),
645 5 IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*),
646 6 LENI
647C-----------------------------------------------
648C L o c a l V a r i a b l e s
649C-----------------------------------------------
650 INTEGER I,
651 . IWORK(70000)
652 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX ! LENI*2
653C-----------------------
654 ALLOCATE(index(leni*2))
655 DO i=1,numels
656 ixs_s_ind(i) = ixs(nixs,i)
657 ENDDO
658 CALL my_orders(0,iwork,ixs_s_ind,index,numels,1)
659 DO i=1,numels
660 ixs_s(i) = ixs_s_ind(index(i))
661 ENDDO
662 DO i=1,numels
663 ixs_s_ind(i) = index(i)
664 ENDDO
665
666 DO i=1,numelq
667 ixq_s_ind(i) = ixq(nixq,i)
668 ENDDO
669 CALL my_orders(0,iwork,ixq_s_ind,index,numelq,1)
670 DO i=1,numelq
671 ixq_s(i) = ixq_s_ind(index(i))
672 ENDDO
673 DO i=1,numelq
674 ixq_s_ind(i) = index(i)
675 ENDDO
676
677 DO i=1,numelc
678 ixc_s_ind(i) = ixc(nixc,i)
679 ENDDO
680 CALL my_orders(0,iwork,ixc_s_ind,index,numelc,1)
681 DO i=1,numelc
682 ixc_s(i) = ixc_s_ind(index(i))
683 ENDDO
684 DO i=1,numelc
685 ixc_s_ind(i) = index(i)
686 ENDDO
687
688 DO i=1,numelt
689 ixt_s_ind(i) = ixt(nixt,i)
690 ENDDO
691 CALL my_orders(0,iwork,ixt_s_ind,index,numelt,1)
692 DO i=1,numelt
693 ixt_s(i) = ixt_s_ind(index(i))
694 ENDDO
695 DO i=1,numelt
696 ixt_s_ind(i) = index(i)
697 ENDDO
698
699 DO i=1,numelp
700 ixp_s_ind(i) = ixp(nixp,i)
701 ENDDO
702 CALL my_orders(0,iwork,ixp_s_ind,index,numelp,1)
703 DO i=1,numelp
704 ixp_s(i) = ixp_s_ind(index(i))
705 ENDDO
706 DO i=1,numelp
707 ixp_s_ind(i) = index(i)
708 ENDDO
709
710 DO i=1,numelr
711 ixr_s_ind(i) = ixr(nixr,i)
712 ENDDO
713 CALL my_orders(0,iwork,ixr_s_ind,index,numelr,1)
714 DO i=1,numelr
715 ixr_s(i) = ixr_s_ind(index(i))
716 ENDDO
717 DO i=1,numelr
718 ixr_s_ind(i) = index(i)
719 ENDDO
720
721 DO i=1,numeltg
722 ixtg_s_ind(i) = ixtg(nixtg,i)
723 ENDDO
724 CALL my_orders(0,iwork,ixtg_s_ind,index,numeltg,1)
725 DO i=1,numeltg
726 ixtg_s(i) = ixtg_s_ind(index(i))
727 ENDDO
728 DO i=1,numeltg
729 ixtg_s_ind(i) = index(i)
730 ENDDO
731 DEALLOCATE(index)
732 RETURN

◆ user2sys()

integer function user2sys ( integer iu,
integer, dimension(*) ixx_s,
integer nix,
integer cur,
integer last )

Definition at line 739 of file nintrr.F.

740C FUNCTION RETURNS SYSTEM ID FROM A LIST OF USER ELEMENTS OR ZERO IF NOT FOUND
741C-----------------------------------------------
742C I m p l i c i t T y p e s
743C-----------------------------------------------
744#include "implicit_f.inc"
745C-----------------------------------------------
746C D u m m y A r g u m e n t s
747C-----------------------------------------------
748 INTEGER NIX, CUR, LAST
749 INTEGER IU,IXX_S(*)
750C-----------------------------------------------
751C L o c a l V a r i a b l e s
752C-----------------------------------------------
753 INTEGER J, JINF, JSUP
754C-----------------------
755
756 IF (last==0) THEN
757 user2sys=0
758 RETURN
759 END IF
760 jinf=cur
761 jsup=last
762 j=min(cur,(last+cur)/2)
763 10 IF(jsup<=jinf.AND.(iu-ixx_s(j))/=0) THEN
764C > Elem case not find
765 user2sys=0
766 RETURN
767 ENDIF
768 IF((iu-ixx_s(j))==0)THEN
769C >CASE IU=TABM END OF SEARCH
770 user2sys=j
771 RETURN
772 ELSE IF (iu-ixx_s(j)<0) THEN
773C >CAS IU<TABM
774 jsup=j-1
775 ELSE
776C >CAS IU>TABM
777 jinf=j+1
778 ENDIF
779 j=(jsup+jinf)/2
780 GO TO 10
781
782 RETURN
min
#define min(a, b)
Definition macros.h:20