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 448 of file nintrr.F.

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

◆ grsize_ele()

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

Definition at line 537 of file nintrr.F.

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

◆ 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 577 of file nintrr.F.

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

◆ grsizen()

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

Definition at line 496 of file nintrr.F.

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

◆ ngr2usr()

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

Definition at line 324 of file nintrr.F.

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

◆ ngr2usrn()

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

Definition at line 406 of file nintrr.F.

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

◆ 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 78 of file nintrr.F.

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

◆ 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 176 of file nintrr.F.

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

◆ 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 799 of file nintrr.F.

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

◆ nintri()

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

Definition at line 45 of file nintrr.F.

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

◆ nintrigr()

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

Definition at line 871 of file nintrr.F.

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

◆ 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 625 of file nintrr.F.

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

◆ user2sys()

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

Definition at line 741 of file nintrr.F.

742C FONCTION DONNE N0 SYSTEME D'UNE LISTE D'ELEMENTS USER OR ZERO IF NOT FOUND
743C-----------------------------------------------
744C I m p l i c i t T y p e s
745C-----------------------------------------------
746#include "implicit_f.inc"
747C-----------------------------------------------
748C D u m m y A r g u m e n t s
749C-----------------------------------------------
750 INTEGER NIX,NUMEL, CUR, LAST
751 INTEGER IU,IXX_S(*)
752C-----------------------------------------------
753C L o c a l V a r i a b l e s
754C-----------------------------------------------
755 INTEGER I, J, JINF, JSUP
756C-----------------------
757
758 IF (last==0) THEN
759 user2sys=0
760 RETURN
761 END IF
762 jinf=cur
763 jsup=last
764 j=min(cur,(last+cur)/2)
765 10 IF(jsup<=jinf.AND.(iu-ixx_s(j))/=0) THEN
766C >CAS ELEM non trouve
767 user2sys=0
768 RETURN
769 ENDIF
770 IF((iu-ixx_s(j))==0)THEN
771C >CAS IU=TABM FIN DE LA RECHERCHE
772 user2sys=j
773 RETURN
774 ELSE IF (iu-ixx_s(j)<0) THEN
775C >CAS IU<TABM
776 jsup=j-1
777 ELSE
778C >CAS IU>TABM
779 jinf=j+1
780 ENDIF
781 j=(jsup+jinf)/2
782 GO TO 10
783
784 RETURN
min
#define min(a, b)
Definition macros.h:20