OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
routines_r2r.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "r2r_c.inc"
#include "scr17_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine modif_tag (tag, new_tag, modif)
integer function r2r_sys (iu, itabm1, mess)
integer function r2r_nin (iext, ntn, m, n)
integer function nodgr_r2r (igu, igs, ibuf, igrnod, itabm1, mess)
subroutine sz_r2r (tag, val)
subroutine hm_sz_r2r (tag, val, lsubmodel)
integer function r2r_exist (typ, id)
integer function r2r_listcnt (nvar, typ)
integer function grsize_r2r (igu, igrelem, grlen, typ)
integer function r2r_sys2 (iu, itabm1, mess)
subroutine r2r_nom_opt (nom_opt, inom_opt, in10, in20, snom_opt_old)
subroutine chk_flg_fsi (ixs, pm, iparts, ale_euler, igeo)
subroutine r2r_check_seg (eltag, face, ipartc, ipartg, iparts, isolnod)

Function/Subroutine Documentation

◆ chk_flg_fsi()

subroutine chk_flg_fsi ( integer, dimension(nixs,sixs/nixs) ixs,
pm,
integer, dimension(*) iparts,
integer ale_euler,
integer, dimension(npropgi,numgeo), intent(in) igeo )

Definition at line 702 of file routines_r2r.F.

703C-----------------------------------------------
704C M o d u l e s
705C-----------------------------------------------
706 USE r2r_mod
707 use element_mod , only : nixs
708C-----------------------------------------------
709C I m p l i c i t T y p e s
710C-----------------------------------------------
711#include "implicit_f.inc"
712C-----------------------------------------------
713C C o m m o n B l o c k s
714C-----------------------------------------------
715#include "com04_c.inc"
716#include "param_c.inc"
717#include "r2r_c.inc"
718#include "tabsiz_c.inc"
719C-----------------------------------------------
720C D u m m y A r g u m e n t s
721C-----------------------------------------------
722 INTEGER IXS(NIXS,SIXS/NIXS),IPARTS(*),ALE_EULER
723 INTEGER,INTENT(IN) :: IGEO(NPROPGI,NUMGEO)
724 my_real pm(npropm,nummat)
725C-----------------------------------------------
726C L o c a l V a r i a b l e s
727C-----------------------------------------------
728 INTEGER M,JALE,ID_PART,IMAT0,IPROP0,ELEM_VOID,JALE_FROM_MAT, JALE_FROM_PROP
729C-----------------------------------------------
730C S o u r c e L i n e s
731C-----------------------------------------------
732 flg_fsi = 0
733 ale_euler = 0
734 DO m=1,numels
735 id_part=iparts(m)
736C---------------id of the original material -----------C
737 imat0=ipart_r2r(1,id_part) !original mat_id
738 iprop0=ipart_r2r(4,id_part) !original prop_id
739 jale_from_mat = nint(pm(72,imat0))
740 jale_from_prop = igeo(62,iprop0)
741 jale= max(jale_from_mat, jale_from_prop)
742C
743 elem_void = 0
744 IF ((tagno(id_part)==0).AND.(tag_els(m)>0)) elem_void=1
745 IF ((jale > 0).AND.(tagno(id_part) > 0)) ale_euler = 1
746 IF ((jale == 0).OR.(elem_void == 0)) cycle
747 flg_fsi = 1
748 END DO
749C-------------------------------------------
750 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tag_els
integer, dimension(:), allocatable tag_els
Definition r2r_mod.F:133
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
r2r_mod::ipart_r2r
integer, dimension(:,:), allocatable ipart_r2r
Definition r2r_mod.F:144

◆ grsize_r2r()

integer function grsize_r2r ( integer igu,
type (group_), dimension(grlen) igrelem,
integer grlen,
integer typ )

Definition at line 539 of file routines_r2r.F.

540C-----------------------------------------------
541C M o d u l e s
542C-----------------------------------------------
543 USE groupdef_mod
544C-----------------------------------------------
545C I m p l i c i t T y p e s
546C-----------------------------------------------
547#include "implicit_f.inc"
548C-----------------------------------------------
549C D u m m y A r g u m e n t s
550C-----------------------------------------------
551 INTEGER IGU,GRLEN,TYP
552C-----------------------------------------------
553 TYPE (GROUP_) , DIMENSION(GRLEN) :: IGRELEM
554C-----------------------------------------------
555C L o c a l V a r i a b l e s
556C-----------------------------------------------
557 INTEGER I,IGS
558C-----------------------------------------------
559 grsize_r2r = 0
560 IF (igu > 0) THEN
561 DO i=1,grlen
562 IF (igu == igrelem(i)%ID) THEN
563 IF (typ == 8) THEN ! before split
564 grsize_r2r = igrelem(i)%R2R_ALL
565 ELSEIF (typ == 9) THEN ! shared
566 grsize_r2r = igrelem(i)%R2R_SHARE
567 ENDIF
568 igs = i
569 EXIT
570 ENDIF
571 ENDDO
572 ENDIF
573C-----------
574 RETURN
groupdef_mod
Definition groupdef_mod.F:668
grsize_r2r
integer function grsize_r2r(igu, igrelem, grlen, typ)
Definition routines_r2r.F:540

◆ hm_sz_r2r()

subroutine hm_sz_r2r ( integer, dimension(*) tag,
integer val,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 298 of file routines_r2r.F.

299C-----------------------------------------------
300C M o d u l e s
301C-----------------------------------------------
302 USE submodel_mod
303 USE hm_option_read_mod
304C-----------------------------------------------
305C I m p l i c i t T y p e s
306C-----------------------------------------------
307#include "implicit_f.inc"
308C-----------------------------------------------
309C D u m m y A r g u m e n t s
310C-----------------------------------------------
311 INTEGER VAL,TAG(*)
312 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
313C-----------------------------------------------
314C
315 DO WHILE (tag(val) == 0)
316 CALL hm_option_read_key(lsubmodel)
317 val=val+1
318 END DO
319C
320 RETURN
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
hm_option_read_mod
Definition hm_option_read_mod.F:412
submodel_mod
Definition submodel_mod.F:717

◆ modif_tag()

subroutine modif_tag ( integer tag,
integer new_tag,
integer modif )

Definition at line 30 of file routines_r2r.F.

31C-----------------------------------------------
32C I m p l i c i t T y p e s
33C-----------------------------------------------
34#include "implicit_f.inc"
35C-----------------------------------------------
36C D u m m y A r g u m e n t s
37C-----------------------------------------------
38 INTEGER TAG,NEW_TAG,MODIF
39C-----------------------------------------------
40C L o c a l V a r i a b l e s
41C-----------------------------------------------
42 INTEGER OLD_TAG
43C=======================================================================
44
45 old_tag = tag
46 tag = new_tag
47
48 IF (old_tag/=new_tag) modif = modif+1
49
50C-----------
51 RETURN

◆ nodgr_r2r()

integer function nodgr_r2r ( integer igu,
integer igs,
integer, dimension(*) ibuf,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(*) itabm1,
character mess )

Definition at line 171 of file routines_r2r.F.

173C-----------------------------------------------
174C M o d u l e s
175C-----------------------------------------------
176 USE groupdef_mod
177 USE message_mod
178 USE r2r_mod
179C-----------------------------------------------
180C I m p l i c i t T y p e s
181C-----------------------------------------------
182#include "implicit_f.inc"
183C-----------------------------------------------
184C C o m m o n B l o c k s
185C-----------------------------------------------
186#include "com04_c.inc"
187C-----------------------------------------------
188 INTEGER IGU,IGS,IBUF(*),ITABM1(*)
189 CHARACTER MESS*40
190C-----------------------------------------------
191 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
192C-----------------------------------------------
193 INTEGER I,COMPT
194C=======================================================================
195 nodgr_r2r = 0
196 IF (igu > 0) THEN
197 igs=0
198 DO i=1,ngrnod
199 IF(igrnod(i)%ID == igu) THEN
200 igs=i
201 nodgr_r2r = igrnod(igs)%NENTITY
202 EXIT
203 ENDIF
204 ENDDO
205C
206 IF (igs == 0)THEN
207 CALL ancmsg(msgid=53,
208 . msgtype=msgerror,
209 . anmode=aninfo,
210 . c1= mess,
211 . i1=igu)
212 RETURN
213 ENDIF
214C
215 compt = 0
216 DO i=1,nodgr_r2r
217 IF (tagno(igrnod(igs)%ENTITY(i)+npart)/=2) THEN
218 compt = compt + 1
219 ibuf(compt)=igrnod(igs)%ENTITY(i)
220 ENDIF
221 ENDDO
222!
223 nodgr_r2r = nodgr_r2r - igrnod(igs)%R2R_SHARE
224 ENDIF
225C---
226 RETURN
message_mod
Definition message_mod.F:1257
nodgr_r2r
integer function nodgr_r2r(igu, igs, ibuf, igrnod, itabm1, mess)
Definition routines_r2r.F:173
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

◆ r2r_check_seg()

subroutine r2r_check_seg ( integer eltag,
integer, dimension(4) face,
integer, dimension(*) ipartc,
integer, dimension(*) ipartg,
integer, dimension(*) iparts,
integer, dimension(*) isolnod )

Definition at line 762 of file routines_r2r.F.

763C-----------------------------------------------
764C M o d u l e s
765C-----------------------------------------------
766 USE restmod
767 USE nod2el_mod
768 USE r2r_mod
769 use element_mod , only : nixs,nixc,nixtg
770C-----------------------------------------------
771C I m p l i c i t T y p e s
772C-----------------------------------------------
773#include "implicit_f.inc"
774C-----------------------------------------------
775C C o m m o n B l o c k s
776C-----------------------------------------------
777#include "com04_c.inc"
778C-----------------------------------------------
779C D u m m y A r g u m e n t s
780C-----------------------------------------------
781 INTEGER ELTAG,FACE(4),IPARTC(*),IPARTG(*),IPARTS(*),ISOLNOD(*)
782C-----------------------------------------------
783C L o c a l V a r i a b l e s
784C-----------------------------------------------
785 INTEGER CUR_ID,CUR_10,CUR_20,CUR_16,FLG_T4,L,K
786 INTEGER ITAGL(NUMNOD),NF,SUM,OFFSET
787C-----------------------------------------------
788
789 nf = face(1)
790 eltag = 0
791
792C--> check of shell elements <---
793 DO l = knod2elc(nf)+1,knod2elc(nf+1)
794 cur_id = nod2elc(l)
795 flg_t4 = 0
796 DO k = 1,4
797 itagl(face(k)) = 0
798 END DO
799 DO k = 2,5
800 itagl(ixc(nixc*(cur_id-1)+k)) = 1
801 IF (tagno(npart+ixc(nixc*(cur_id-1)+k))==2) flg_t4 = 1
802 END DO
803 sum=itagl(face(1))+itagl(face(2))+itagl(face(3))+itagl(face(4))
804 IF ((sum==4).AND.((tagno(ipartc(cur_id))==1).OR.(flg_t4==0))) eltag = 1
805 END DO
806
807C--> check of sh3n elements <---
808 DO l = knod2eltg(nf)+1,knod2eltg(nf+1)
809 cur_id = nod2eltg(l)
810 flg_t4 = 0
811 DO k = 1,4
812 itagl(face(k)) = 0
813 END DO
814 DO k = 2,4
815 itagl(ixtg(nixtg*(cur_id-1)+k)) = 1
816 IF (tagno(npart+ixtg(nixtg*(cur_id-1)+k))==2) flg_t4 = 1
817 END DO
818 sum=itagl(face(1))+itagl(face(2))+itagl(face(3))+itagl(face(4))
819 IF (sum==4) eltag = 1
820 IF ((sum==4).AND.((tagno(ipartg(cur_id))==1).OR.(flg_t4==0))) eltag = 1
821 END DO
822
823C--> check of solid elements <---
824 DO l = knod2els(nf)+1,knod2els(nf+1)
825 cur_id = nod2els(l)
826 flg_t4 = 0
827 DO k = 1,4
828 itagl(face(k)) = 0
829 END DO
830 DO k = 2,9
831 itagl(ixs(nixs*(cur_id-1)+k)) = 1
832 IF (tagno(npart+ixs(nixs*(cur_id-1)+k))==2) flg_t4 = 1
833 END DO
834 IF (isolnod(cur_id)==10) THEN
835 offset = nixs*numels
836 cur_10 = cur_id-numels8
837 DO k=1,6
838 itagl(ixs(offset+6*(cur_10-1)+k)) = 1
839 IF (tagno(npart+ixs(offset+6*(cur_10-1)+k))==2) flg_t4 = 1
840 ENDDO
841 ELSEIF (isolnod(cur_id)==20) THEN
842 offset = nixs*numels+6*numels10
843 cur_20 = cur_id-(numels8+numels10)
844 DO k=1,12
845 itagl(ixs(offset+12*(cur_20-1)+k)) = 1
846 IF (tagno(npart+ixs(offset+12*(cur_20-1)+k))==2) flg_t4 = 1
847 ENDDO
848 ELSEIF (isolnod(cur_id)==16) THEN
849 offset = nixs*numels+6*numels10+12*numels20
850 cur_16 = cur_id-(numels8+numels10+numels20)
851 DO k=1,8
852 itagl(ixs(offset+8*(cur_16-1)+k)) = 1
853 IF (tagno(npart+ixs(offset+8*(cur_16-1)+k))==2) flg_t4 = 1
854 ENDDO
855 ENDIF
856 sum=itagl(face(1))+itagl(face(2))+itagl(face(3))+itagl(face(4))
857 IF (sum==4) eltag = 1
858 IF ((sum==4).AND.((tagno(iparts(cur_id))==1).OR.(flg_t4==0))) eltag = 1
859 END DO
860
861C-----------
862 RETURN
nod2el_mod
Definition nod2el_mod.F:36
nod2el_mod::knod2elc
integer, dimension(:), allocatable knod2elc
Definition nod2el_mod.F:58
nod2el_mod::knod2els
integer, dimension(:), allocatable knod2els
Definition nod2el_mod.F:58
nod2el_mod::nod2eltg
integer, dimension(:), allocatable nod2eltg
Definition nod2el_mod.F:58
nod2el_mod::nod2elc
integer, dimension(:), allocatable nod2elc
Definition nod2el_mod.F:58
nod2el_mod::nod2els
integer, dimension(:), allocatable nod2els
Definition nod2el_mod.F:58
nod2el_mod::knod2eltg
integer, dimension(:), allocatable knod2eltg
Definition nod2el_mod.F:58
restmod::ixs
integer, dimension(:), allocatable, target ixs
Definition restart_mod.F:60
restmod::ixtg
integer, dimension(:), allocatable, target ixtg
Definition restart_mod.F:60
restmod::ixc
integer, dimension(:), allocatable ixc
Definition restart_mod.F:60

◆ r2r_exist()

integer function r2r_exist ( integer typ,
integer id )

Definition at line 344 of file routines_r2r.F.

345C-----------------------------------------------
346C M o d u l e s
347C-----------------------------------------------
348 USE r2r_mod
349 USE restmod
350 USE message_mod
351 USE groupdef_mod
352 USE group_mod
353 USE reader_old_mod , ONLY : kinter, nslash
354C-----------------------------------------------
355C I m p l i c i t T y p e s
356C-----------------------------------------------
357#include "implicit_f.inc"
358C-----------------------------------------------
359C C o m m o n B l o c k s
360C-----------------------------------------------
361#include "scr17_c.inc"
362#include "com04_c.inc"
363C-----------------------------------------------
364 INTEGER ID,TYP
365 INTEGER I,CURS
366C--------------------------------------------------------
367C------ --> TH : check if corresponding option is kept---
368C--------------------------------------------------------
369
370 r2r_exist=0
371 curs = 0
372
373 IF (typ==107) THEN
374C-----------MONVOL------------------
375 DO i=1,nvolu
376 curs=curs+1
377 DO WHILE (tagmon(curs)==0)
378 curs=curs+1
379 END DO
380 IF (tagmon(curs)==id) r2r_exist=1
381 END DO
382 ELSEIF (typ==101) THEN
383C-----------INTER------------------
384 DO i=1,hm_ninter+nslash(kinter)
385 curs=curs+1
386 DO WHILE (tagint(curs)==0)
387 curs=curs+1
388 END DO
389 IF (tagint(curs)==id) r2r_exist=1
390 END DO
391 ELSEIF (typ==103) THEN
392C-----------RBY------------------
393 DO i=1,nrbody
394 curs=curs+1
395 DO WHILE (tagrby(curs)==0)
396 curs=curs+1
397 END DO
398 IF (tagrby(curs)==id) r2r_exist=1
399 END DO
400 ELSEIF (typ==105) THEN
401C-----------CYL_JOIN--------------
402 DO i=1,njoint
403 curs=curs+1
404 DO WHILE (tagcyl(curs)==0)
405 curs=curs+1
406 END DO
407 IF (tagcyl(curs)==id) r2r_exist=1
408 END DO
409 ELSEIF (typ==1001) THEN
410C-----------PART------------------
411 DO i=1,npart
412 IF (ipart(lipart1*(i-1)+4)==id) curs = i
413 END DO
414 IF (curs == 0) THEN
415 CALL ancmsg(msgid=258,
416 . msgtype=msgerror,
417 . anmode=aninfo_blind_1,
418 . c1="PART",
419 . i1=id)
420 ENDIF
421 IF (tag_part(curs)>0) r2r_exist=1
422 ELSEIF (typ==1002) THEN
423C-----------SUBSET------------------
424 DO i=1,nsubs
425 IF (subsets(i)%ID==id) curs = i
426 END DO
427 IF (curs == 0) THEN
428 CALL ancmsg(msgid=258,
429 . msgtype=msgerror,
430 . anmode=aninfo_blind_1,
431 . c1="SUBSET",
432 . i1=id)
433 ENDIF
434 r2r_exist=1
435 ELSEIF (typ==102) THEN
436C-----------RWALL-------------------
437 r2r_exist=1
438 ELSEIF (typ==104) THEN
439C-----------SECTION-----------------
440 DO i=1,nsect
441 curs=curs+1
442 DO WHILE (tagsec(curs)==0)
443 curs=curs+1
444 END DO
445 IF (tagsec(curs)==id) r2r_exist=1
446 END DO
447 ELSEIF (typ==108) THEN
448C-----------ACCELEROMETER-----------
449 r2r_exist=1
450 ELSEIF (typ==110) THEN
451C-----------FRAMES------------------
452 r2r_exist=1
453 ELSEIF (typ==113) THEN
454C-----------GAUGES------------------
455 DO i=1,nbgauge
456 curs=curs+1
457 DO WHILE (taggau(curs)==0)
458 curs=curs+1
459 END DO
460 IF (taggau(curs)==id) r2r_exist=1
461 END DO
462 ENDIF
463
464 RETURN
id
initmumps id
Definition multiplerhs_example.m:4
group_mod
Definition group_mod.F:31
group_mod::subsets
type(subset_), dimension(:), allocatable, target subsets
Definition group_mod.F:45
r2r_mod::tagsec
integer, dimension(:), allocatable tagsec
Definition r2r_mod.F:137
r2r_mod::tagrby
integer, dimension(:), allocatable tagrby
Definition r2r_mod.F:132
r2r_mod::tag_part
integer, dimension(:), allocatable tag_part
Definition r2r_mod.F:134
r2r_mod::tagint
integer, dimension(:), allocatable tagint
Definition r2r_mod.F:132
r2r_mod::tagmon
integer, dimension(:), allocatable tagmon
Definition r2r_mod.F:132
r2r_mod::taggau
integer, dimension(:), allocatable taggau
Definition r2r_mod.F:142
r2r_mod::tagcyl
integer, dimension(:), allocatable tagcyl
Definition r2r_mod.F:137
restmod::ipart
integer, dimension(:), allocatable, target ipart
Definition restart_mod.F:60
r2r_exist
integer function r2r_exist(typ, id)
Definition routines_r2r.F:345

◆ r2r_listcnt()

integer function r2r_listcnt ( integer nvar,
integer typ )

Definition at line 479 of file routines_r2r.F.

480C-----------------------------------------------
481C M o d u l e s
482C-----------------------------------------------
483 USE r2r_mod
484 USE format_mod , ONLY : fmt_10i
485 USE reader_old_mod , ONLY : line, irec
486C-----------------------------------------------
487C I m p l i c i t T y p e s
488C-----------------------------------------------
489#include "implicit_f.inc"
490C-----------------------------------------------
491C C o m m o n B l o c k s
492C-----------------------------------------------
493#include "scr17_c.inc"
494#include "units_c.inc"
495C-----------------------------------------------
496 INTEGER NVAR,TYP
497C-----------------------------------------------
498C E x t e r n a l F u n c t i o n s
499C-----------------------------------------------
500 INTEGER R2R_EXIST
501C-----------------------------------------------
502 INTEGER I,JREC,J10(10),NVAR_TMP
503C-----------------------------------------------------------
504C------ --> TH : re-count of nb of entities in TH groups----
505C-----------------------------------------------------------
506
507 r2r_listcnt=0
508 nvar=0
509 jrec=irec
510 jrec=jrec+1
511 READ(iin,rec=jrec,err=999,fmt='(A)')line
512 DO WHILE(line(1:1)/='/')
513 nvar_tmp = nvar
514 READ(line,err=999,fmt=fmt_10i) j10
515 DO i=1,10
516 IF(j10(i)/=0) THEN
517C-----------entity is counted if it is kept-------------------
518 IF (r2r_exist(typ,j10(i))==1) nvar=nvar+1
519C-------------------------------------------------------------
520 ENDIF
521 ENDDO
522 r2r_listcnt=r2r_listcnt+1
523 jrec=jrec+1
524 READ(iin,rec=jrec,err=999,fmt='(A)')line
525 ENDDO
526 RETURN
527 999 CALL freerr(1)
528 CALL my_exit(2)
my_exit
void my_exit(int *i)
Definition analyse.c:1038
nvar
integer function nvar(text)
Definition nvar.F:32
r2r_listcnt
integer function r2r_listcnt(nvar, typ)
Definition routines_r2r.F:480
freerr
subroutine freerr(it)
Definition freform.F:501

◆ r2r_nin()

integer function r2r_nin ( integer iext,
integer, dimension(m,n) ntn,
integer m,
integer n )

Definition at line 135 of file routines_r2r.F.

136C-----------------------------------------------
137C I m p l i c i t T y p e s
138C-----------------------------------------------
139#include "implicit_f.inc"
140C-----------------------------------------------
141C D u m m y A r g u m e n t s
142C-----------------------------------------------
143 INTEGER IEXT, M, N
144 INTEGER NTN(M,N)
145C-----------------------------------------------
146C L o c a l V a r i a b l e s
147C-----------------------------------------------
148 INTEGER I
149C-----------------------------------------------
150 DO i=1,n
151 IF(ntn(m,i)==iext)THEN
152 r2r_nin=i
153 RETURN
154 ENDIF
155 ENDDO
156 r2r_nin=0
157C-------------------------------------------
158 RETURN
r2r_nin
integer function r2r_nin(iext, ntn, m, n)
Definition routines_r2r.F:136

◆ r2r_nom_opt()

subroutine r2r_nom_opt ( integer, dimension(*) nom_opt,
integer, dimension(*) inom_opt,
integer in10,
integer in20,
integer snom_opt_old )

Definition at line 648 of file routines_r2r.F.

649C-----------------------------------------------
650C M o d u l e s
651C-----------------------------------------------
652 USE r2r_mod
653 USE submodel_mod , ONLY : nsubmod
654C-----------------------------------------------
655C I m p l i c i t T y p e s
656C-----------------------------------------------
657#include "implicit_f.inc"
658C-----------------------------------------------
659C C o m m o n B l o c k s
660C-----------------------------------------------
661#include "scr17_c.inc"
662#include "com04_c.inc"
663C-----------------------------------------------
664C D u m m y A r g u m e n t s
665C-----------------------------------------------
666 INTEGER NOM_OPT(*),INOM_OPT(*),IN10,IN20,SNOM_OPT_OLD
667C-----------------------------------------------
668C L o c a l V a r i a b l e s
669C-----------------------------------------------
670 INTEGER I
671C=======================================================================
672C-- Split of NOM_OPT
673
674 ALLOCATE (nom_opt_temp(snom_opt_old))
675 DO i=1,snom_opt_old
676 nom_opt_temp(i) = nom_opt(i)
677 nom_opt(i) = 0
678 ENDDO
679
680C--- FUNCTIONS / TABLES --
681 DO i=1,lnopt1*nfunct
682 nom_opt(lnopt1*inom_opt(20)+i)=nom_opt_temp(lnopt1*in20+i)
683 END DO
684C--- FRAMES --
685 DO i=1,lnopt1*(numskw+1+numfram+1+nsubmod)
686 nom_opt(lnopt1*inom_opt(10)+i)=nom_opt_temp(lnopt1*in10+i)
687 END DO
688
689 DEALLOCATE (nom_opt_temp)
690
691C-----------
692 RETURN
r2r_mod::nom_opt_temp
integer, dimension(:), allocatable nom_opt_temp
Definition r2r_mod.F:142
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725

◆ r2r_sys()

integer function r2r_sys ( integer iu,
integer, dimension(*), target itabm1,
character mess )

Definition at line 65 of file routines_r2r.F.

66C-----------------------------------------------
67C I m p l i c i t T y p e s
68C-----------------------------------------------
69#include "implicit_f.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER IU
74 CHARACTER MESS*40
75 INTEGER ITABM1(*)
76C-----------------------------------------------
77C C o m m o n B l o c k s
78C-----------------------------------------------
79#include "com04_c.inc"
80#include "r2r_c.inc"
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER JINF, JSUP, J,SAUV,NN
85 INTEGER, DIMENSION(:), POINTER :: ITABM2
86 TARGET :: itabm1
87C-----------------------------------------------
88C E x t e r n a l F u n c t i o n s
89C-----------------------------------------------
90 INTEGER R2R_SYS2
91C-----------------------------------------------
92
93 jinf=1
94 jsup=numnod
95 j=max(1,numnod/2)
96
97 10 IF(jsup<=jinf.AND.(iu-itabm1(j))/=0) THEN
98 r2r_sys=0
99C------------Check of the list of removed nodes-------------
100 itabm2 => itabm1(2*numnod+1:2*(numnod+nodsupr))
101 sauv = numnod
102 numnod = nodsupr
103 nn=r2r_sys2(iu,itabm2,mess)
104 IF (nn==0) r2r_sys=-1
105 numnod = sauv
106C-----------------------------------------------------------
107 RETURN
108 ENDIF
109
110 IF((iu-itabm1(j))==0)THEN
111C >IU=TABM - end of the search
112 r2r_sys=itabm1(j+numnod)
113 RETURN
114 ELSE IF (iu-itabm1(j)<0) THEN
115C >IU<TABM
116 jsup=j-1
117 ELSE
118C >IU>TABM
119 jinf=j+1
120 ENDIF
121 j=(jsup+jinf)/2
122 IF (j > 0) THEN
123 GO TO 10
124 ELSE
125 r2r_sys=0
126 ENDIF
127C
r2r_sys
integer function r2r_sys(iu, itabm1, mess)
Definition routines_r2r.F:66
r2r_sys2
integer function r2r_sys2(iu, itabm1, mess)
Definition routines_r2r.F:587

◆ r2r_sys2()

integer function r2r_sys2 ( integer iu,
integer, dimension(*) itabm1,
character mess )

Definition at line 586 of file routines_r2r.F.

587 USE message_mod
588C-----------------------------------------------
589C I m p l i c i t T y p e s
590C-----------------------------------------------
591#include "implicit_f.inc"
592C-----------------------------------------------
593C D u m m y A r g u m e n t s
594C-----------------------------------------------
595 INTEGER IU
596 CHARACTER MESS*40
597 INTEGER ITABM1(*)
598C-----------------------------------------------
599C C o m m o n B l o c k s
600C-----------------------------------------------
601#include "com04_c.inc"
602C-----------------------------------------------
603C L o c a l V a r i a b l e s
604C-----------------------------------------------
605 INTEGER JINF, JSUP, J
606C-----------------------------------------------
607C-- Same routine as USR2SYS -> used to avoid infinite loop in R2R_SYS
608
609 jinf=1
610 jsup=numnod
611 j=max(1,numnod/2)
612 10 IF(jsup<=jinf.AND.(iu-itabm1(j))/=0) THEN
613 CALL ancmsg(msgid=78,
614 . msgtype=msgerror,
615 . anmode=aninfo,
616 . c1=mess,
617 . i1=iu)
618 r2r_sys2=0
619 RETURN
620 ENDIF
621 IF((iu-itabm1(j))==0)THEN
622C >IU=TABM - end of search
623 r2r_sys2=itabm1(j+numnod)
624 RETURN
625 ELSE IF (iu-itabm1(j)<0) THEN
626C >IU<TABM
627 jsup=j-1
628 ELSE
629C >IU>TABM
630 jinf=j+1
631 ENDIF
632 j=(jsup+jinf)/2
633 IF (j > 0) THEN
634 GO TO 10
635 ELSE
636 r2r_sys2=0
637 ENDIF

◆ sz_r2r()

subroutine sz_r2r ( integer, dimension(*) tag,
integer val )

Definition at line 240 of file routines_r2r.F.

241C-----------------------------------------------
242C M o d u l e s
243C-----------------------------------------------
244 USE reader_old_mod , ONLY : irec, nslash
245C-----------------------------------------------
246C I m p l i c i t T y p e s
247C-----------------------------------------------
248#include "implicit_f.inc"
249C-----------------------------------------------
250C C o m m o n B l o c k s
251C-----------------------------------------------
252#include "scr17_c.inc"
253C-----------------------------------------------
254C D u m m y A r g u m e n t s
255C-----------------------------------------------
256 INTEGER VAL,TAG(*)
257C-----------------------------------------------
258
259 CALL nextsla
260 DO WHILE (tag(val) == 0)
261 val=val+1
262 irec=irec+1
263 CALL nextsla
264 END DO
265
266 RETURN
nextsla
subroutine nextsla
Definition freform.F:841