OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dim_s10edg.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr03_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine dim_s10edg (nedg, ixs10, iparg, itagnd)
subroutine ind_s10edg (icnds10, ixs, ixs10, iparg, itagnd)
subroutine reord_icnd (icnds10, itagnd)
subroutine remove_nd (nn, inn, itagnd)
subroutine remdeg_nd (nn, inn, itagnd)
subroutine rigmodif_nd (nn, inn, itagnd, icnds10, iu, titr, itab)
subroutine rigmodif1_nd (npby, lpby, itagnd)
subroutine rbe2modif_nd (nn, inn, itagnd, icnds10, iu, itab, itagm, m, itagic)
subroutine rbe2modif1_nd (irbe2, lrbe2, itagnd)
subroutine bcsmodif_nd (icode, itagnd, icnds10, itab)
subroutine fixmodif_nd (ibfv, itagnd, icnds10, itab)
logical function samefvid (id, ibfv, n)
subroutine int2modif_nd (ipari, intbuf_tab, itagnd, icnds10, itab)
subroutine pre_cndpon (icnds10, adskycnd, cepcnd, celcnd, itagnd)
subroutine fillcncnd (cncnd, addcncnd, icnds10, itagnd)
subroutine stifn0_nd (icnds10, stifn)
subroutine stifn1_nd (icnds10, stifn)
subroutine bcscycmodif_nd (ibcscyc, lbcscyc, itagnd, itab)

Function/Subroutine Documentation

◆ bcscycmodif_nd()

subroutine bcscycmodif_nd ( integer, dimension(4,*) ibcscyc,
integer, dimension(2,*) lbcscyc,
integer, dimension(*) itagnd,
integer, dimension(*) itab )

Definition at line 1387 of file dim_s10edg.F.

1388C=======================================================================
1389 USE message_mod
1390C-----------------------------------------------
1391C I m p l i c i t T y p e s
1392C-----------------------------------------------
1393#include "implicit_f.inc"
1394C-----------------------------------------------
1395C C o m m o n B l o c k s
1396C-----------------------------------------------
1397#include "com04_c.inc"
1398C-----------------------------------------------
1399C D u m m y A r g u m e n t s
1400C-----------------------------------------------
1401 INTEGER IBCSCYC(4,*), LBCSCYC(2,*), ITAGND(*),ITAB(*)
1402C-----------------------------------------------
1403C L o c a l V a r i a b l e s
1404C-----------------------------------------------
1405 INTEGER I,J,N,K,KK,NSL,NSL_N,K_N,NS,ID,N1,N2
1406C REAL
1407C------removing Nd from LBCSCYC(*)--
1408 DO i = 1, nbcscyc
1409 k = ibcscyc(1,i)
1410 nsl =ibcscyc(3,i)
1411 nsl_n = 0
1412 id =ibcscyc(4,i)
1413 DO j = 1, nsl
1414 n1 = lbcscyc(1,k+j)
1415 n2 = lbcscyc(2,k+j)
1416 IF(itagnd(n1)==0.AND.itagnd(n2)==0)THEN
1417 nsl_n = nsl_n + 1
1418 lbcscyc(1,k+nsl_n) =n1
1419 lbcscyc(2,k+nsl_n) =n2
1420 ELSEIF(itagnd(n1)/=0.AND.itagnd(n2)/=0) THEN
1421C--- remove
1422 ELSE
1423C--- error out
1424 CALL ancmsg(msgid=1758,anmode=aninfo,msgtype=msgerror,i1=id)
1425 END IF
1426 ENDDO
1427 IF (nsl>nsl_n) THEN
1428 kk = nsl-nsl_n
1429 ibcscyc(3,i) = nsl_n
1430 ibcscyc(1,i) = k+nsl_n
1431 CALL ancmsg(msgid=1759,anmode=aninfo,msgtype=msgwarning,i1=kk,i2=id)
1432 END IF
1433 ENDDO
1434C
1435 RETURN
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
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

◆ bcsmodif_nd()

subroutine bcsmodif_nd ( integer, dimension(*) icode,
integer, dimension(*) itagnd,
integer, dimension(3,*) icnds10,
integer, dimension(*) itab )

Definition at line 661 of file dim_s10edg.F.

662C=======================================================================
663 USE message_mod
664C-----------------------------------------------
665C I m p l i c i t T y p e s
666C-----------------------------------------------
667#include "implicit_f.inc"
668C-----------------------------------------------
669C D u m m y A r g u m e n t s
670C-----------------------------------------------
671 INTEGER ICODE(*), ITAGND(*),ICNDS10(3,*),ITAB(*)
672C REAL
673C-----------------------------------------------
674C C o m m o n B l o c k s
675C-----------------------------------------------
676#include "com04_c.inc"
677#include "scr03_c.inc"
678C-----------------------------------------------
679C L o c a l V a r i a b l e s
680C-----------------------------------------------
681 INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND,N1,N2,ID,IPR
682 INTEGER IS1,IS2,ISMIN
683C REAL
684C------treatment for /BCS ----------------------------
685 ipr = 0
686 DO n=1,numnod
687 IF (icode(n)>0 .AND. itagnd(n) /=0 ) THEN
688 id = iabs(itagnd(n))
689 nd = icnds10(1,id)
690 n1 = icnds10(2,id)
691 n2 = icnds10(3,id)
692 is1 = icode(n1)
693 is2 = icode(n2)
694 ismin = min(is1,is2)
695 IF (is1/=icode(n).AND.is2/=icode(n).AND.ismin<icode(n)) THEN
696C----error out ND has more /BCS than edge node
697 CALL ancmsg(msgid=1208,
698 . msgtype=msgerror,
699 . anmode=aninfo_blind_1,
700 . i1=itab(nd),
701 . c1='Boundary conditions ',
702 . c2='Boundary conditions')
703 ELSE
704C----remove Nd from /BCS +degenerating
705 icode(n) = 0
706 ipr = 1
707 IF (itagnd(n)>0)itagnd(n) = -itagnd(n)
708 IF (ipri>=5)
709 . CALL ancmsg(msgid=1207,
710 . msgtype=msginfo,
711 . anmode=aninfo_blind_1,
712 . i1=itab(nd),
713 . prmod=msg_cumu)
714 END IF
715 END IF
716 ENDDO
717 IF (ipr >0.AND.ipri>=5) THEN
718 CALL ancmsg(msgid=1207,
719 . msgtype=msginfo,
720 . anmode=aninfo_blind_1,
721 . c1='Boundary conditions ',
722 . c2='Boundary conditions',
723 . prmod=msg_print)
724 END IF
725C
726 RETURN
min
#define min(a, b)
Definition macros.h:20

◆ dim_s10edg()

subroutine dim_s10edg ( integer nedg,
integer, dimension(6,*) ixs10,
integer, dimension(nparg,ngroup) iparg,
integer, dimension(*) itagnd )

Definition at line 28 of file dim_s10edg.F.

29C=======================================================================
30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C A n a l y s e M o d u l e
36C-----------------------------------------------
37#include "param_c.inc"
38#include "com01_c.inc"
39
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER NEDG,ITAGND(*)
44 INTEGER IXS10(6,*),IPARG(NPARG,NGROUP)
45C REAL
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com04_c.inc"
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53 INTEGER I,J,NG, NEL, NFT,II, NF2, N, ITY,ISOLNOD,ISROT
54C REAL
55C-----------------------------------------------
56 nedg = 0
57 DO ng=1,ngroup
58 nel=iparg(2,ng)
59 nft=iparg(3,ng)
60 ity=iparg(5,ng)
61 isolnod = iparg(28,ng)
62 isrot = iparg(41,ng)
63 IF(isolnod == 10) isrot = iparg(74,ng)
64 IF(ity == 1.AND.isolnod == 10.AND.isrot == 2)THEN
65 nf2 = nft-numels8
66C
67 DO i=1,nel
68 ii = i+nf2
69 DO j = 1 , 6
70 n = ixs10(j,ii)
71 IF (n >0) THEN
72 IF (itagnd(n)==0) THEN
73 nedg = nedg + 1
74 itagnd(n)=nedg
75 END IF
76 END IF
77 ENDDO
78 ENDDO
79 END IF
80 ENDDO
81C
82 RETURN

◆ fillcncnd()

subroutine fillcncnd ( integer, dimension(*) cncnd,
integer, dimension(0:*) addcncnd,
integer, dimension(3,*) icnds10,
integer, dimension(*) itagnd )

Definition at line 1261 of file dim_s10edg.F.

1262C-----------------------------------------------
1263C I m p l i c i t T y p e s
1264C-----------------------------------------------
1265#include "implicit_f.inc"
1266C-----------------------------------------------
1267C C o m m o n B l o c k s
1268C-----------------------------------------------
1269#include "com04_c.inc"
1270C-----------------------------------------------
1271C D u m m y A r g u m e n t s
1272C-----------------------------------------------
1273 INTEGER ADDCNCND(0:*), CNCND(*),ICNDS10(3,*),ITAGND(*)
1274C-----------------------------------------------
1275C L o c a l V a r i a b l e s
1276C-----------------------------------------------
1277 INTEGER I, J, L, K, N, OFF, NTY, NRTS, NRTM, NSN, NMN,
1278 . KK, NIR,ADSKY(NUMNOD+1)
1279C-----------------------------------------------
1280C CALCUL DE CNE ADDCNE
1281C-----------------------------------------------
1282 DO i = 1, numnod+1
1283 adsky(i) = addcncnd(i)
1284 ENDDO
1285C
1286C ADDCNCND(I+1)-ADDCNCND(I): nb of node I (main)
1287 nir = 2
1288 DO i=1,ns10e
1289 k = icnds10(1,i)
1290 IF (itagnd(k)>ns10e) cycle
1291 DO j=1,nir
1292 kk = icnds10(1+j,i)
1293 cncnd(adsky(kk)) = i
1294 adsky(kk) = adsky(kk) + 1
1295 END DO
1296 END DO
1297C
1298 RETURN

◆ fixmodif_nd()

subroutine fixmodif_nd ( integer, dimension(nifv,*) ibfv,
integer, dimension(*) itagnd,
integer, dimension(3,*) icnds10,
integer, dimension(*) itab )

Definition at line 738 of file dim_s10edg.F.

739C=======================================================================
740 USE message_mod
741C-----------------------------------------------
742C I m p l i c i t T y p e s
743C-----------------------------------------------
744#include "implicit_f.inc"
745C-----------------------------------------------
746C C o m m o n B l o c k s
747C-----------------------------------------------
748#include "param_c.inc"
749#include "com04_c.inc"
750#include "scr03_c.inc"
751C-----------------------------------------------
752C D u m m y A r g u m e n t s
753C-----------------------------------------------
754 INTEGER IBFV(NIFV,*), ITAGND(*),ICNDS10(3,*),ITAB(*)
755C REAL
756C-----------------------------------------------
757C L o c a l V a r i a b l e s
758C-----------------------------------------------
759 INTEGER I,J,NG, NEL, DIR, N,ND,N1,N2,K,ID,IPR
760 LOGICAL IS1,IS2
761C-----------------------------------------------
762C External function
763C-----------------------------------------------
764 LOGICAL SAMEFVID
765 EXTERNAL samefvid
766C REAL
767C------treatment for tagged nodes in INN(*)----------------------------
768 ipr = 0
769 DO i=1,nfxvel
770 n = iabs(ibfv(1,i))
771 k = ibfv(12,i)
772 IF (itagnd(n) /=0 ) THEN
773 id = iabs(itagnd(n))
774 nd = icnds10(1,id)
775 n1 = icnds10(2,id)
776 n2 = icnds10(3,id)
777C--------quadratic, but---
778 is1 = samefvid(k,ibfv,n1)
779 is2 = samefvid(k,ibfv,n2)
780c IF (IS1.AND.IS2) THEN
781C----remove Nd from ICNDS10
782c ITAGND(N) = ITAGND(N) + NS10E
783 IF (.NOT.(is1).AND..NOT.(is2)) THEN
784C----error out ND is along in FV
785 CALL ancmsg(msgid=1208,
786 . msgtype=msgerror,
787 . anmode=aninfo_blind_1,
788 . i1=itab(nd),
789 . c1='Imposed VEL/DISP/ACC ',
790 . c2='Imposed VEL/DISP/ACC')
791 ELSE
792C----remove Nd from FV and warning out-- will be done in ddsplit
793 ipr = 1
794 IF (ibfv(3,i)>0) ibfv(3,i) = -ibfv(3,i)
795 IF (itagnd(n)>0)itagnd(n) = -itagnd(n)
796 IF (ipri>=5)
797 . CALL ancmsg(msgid=1207,
798 . msgtype=msginfo,
799 . anmode=aninfo_blind_1,
800 . i1=itab(nd),
801 . prmod=msg_cumu)
802 END IF
803 END IF
804 ENDDO
805C
806 IF (ipr >0.AND.ipri>=5) THEN
807 CALL ancmsg(msgid=1207,
808 . msgtype=msginfo,
809 . anmode=aninfo_blind_1,
810 . c1='Imposed VEL/DISP/ACC',
811 . c2='Imposed VEL/DISP/ACC',
812 . prmod=msg_print)
813 END IF
814C
815 RETURN
samefvid
logical function samefvid(id, ibfv, n)
Definition dim_s10edg.F:823

◆ ind_s10edg()

subroutine ind_s10edg ( integer, dimension(3,*) icnds10,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(nparg,*) iparg,
integer, dimension(*) itagnd )

Definition at line 89 of file dim_s10edg.F.

90C=======================================================================
91C-----------------------------------------------
92C I m p l i c i t T y p e s
93C-----------------------------------------------
94#include "implicit_f.inc"
95C-----------------------------------------------
96C A n a l y s e M o d u l e
97C-----------------------------------------------
98#include "param_c.inc"
99#include "com01_c.inc"
100
101C-----------------------------------------------
102C D u m m y A r g u m e n t s
103C-----------------------------------------------
104 INTEGER ITAGND(*)
105 INTEGER ICNDS10(3,*),IXS(NIXS,*),IXS10(6,*),IPARG(NPARG,*)
106C REAL
107C-----------------------------------------------
108C C o m m o n B l o c k s
109C-----------------------------------------------
110#include "com04_c.inc"
111C-----------------------------------------------
112C L o c a l V a r i a b l e s
113C-----------------------------------------------
114 INTEGER I,J,K,NG, NEL, NFT,NF1, NF2, N, ITY,ISOLNOD,ISROT,NC(4)
115 INTEGER IPERM1(6),IPERM2(6),N1,N2,NEDG,ND,II,JJ
116C REAL
117 DATA iperm1/1,2,3,1,2,3/
118 DATA iperm2/2,3,1,4,4,4/
119C-----------------------------------------------
120 nedg = 0
121 DO ng=1,ngroup
122 nel=iparg(2,ng)
123 nft=iparg(3,ng)
124 ity=iparg(5,ng)
125 isolnod = iparg(28,ng)
126 isrot = iparg(41,ng)
127 IF(isolnod == 10) isrot = iparg(74,ng)
128 IF(ity == 1.AND.isolnod == 10.AND.isrot == 2)THEN
129 nf1 = nft
130 nf2 = nft-numels8
131C
132 DO i=1,nel
133 ii = i + nf1
134 jj = i + nf2
135 nc(1) =ixs(2,ii)
136 nc(2) =ixs(4,ii)
137 nc(3) =ixs(7,ii)
138 nc(4) =ixs(6,ii)
139 DO j = 1 , 6
140 n = ixs10(j,jj)
141 IF (n >0) THEN
142 IF (itagnd(n)==0) THEN
143 nedg = nedg + 1
144 itagnd(n) = nedg
145 n1=iperm1(j)
146 n2=iperm2(j)
147 icnds10(1,nedg) = n
148 icnds10(2,nedg) = nc(n1)
149 icnds10(3,nedg) = nc(n2)
150 END IF
151 END IF
152 END DO
153 END DO
154 END IF
155 ENDDO
156 IF (nedg/=ns10e) THEN
157 print *,'error!!! NEDG,NS10EDG=',nedg,ns10e
158 END IF
159
160C ----- ITAGND : > 0 < NS10E : Id of ICNDS10 (Nd)
161C < 0 to be degenerated
162C > NS10E : to be tagged first and be degenerated after
163C
164 RETURN

◆ int2modif_nd()

subroutine int2modif_nd ( integer, dimension(npari,ninter) ipari,
type(intbuf_struct_), dimension(ninter) intbuf_tab,
integer, dimension(*) itagnd,
integer, dimension(3,*) icnds10,
integer, dimension(*) itab )

Definition at line 863 of file dim_s10edg.F.

864C-----------------------------------------------
865C M o d u l e s
866C-----------------------------------------------
867 USE message_mod
868 USE intbufdef_mod
869 USE names_and_titles_mod , ONLY : nchartitle
870C-----------------------------------------------
871C I m p l i c i t T y p e s
872C-----------------------------------------------
873#include "implicit_f.inc"
874C-----------------------------------------------
875C C o m m o n B l o c k s
876C-----------------------------------------------
877#include "param_c.inc"
878#include "com04_c.inc"
879#include "scr03_c.inc"
880C-----------------------------------------------
881C D u m m y A r g u m e n t s
882C-----------------------------------------------
883 INTEGER IPARI(NPARI,NINTER),ITAGND(*),ITAB(*),ICNDS10(3,*)
884 TYPE(INTBUF_STRUCT_), DIMENSION(NINTER) :: INTBUF_TAB
885C-----------------------------------------------
886C External function
887C-----------------------------------------------
888 LOGICAL INTAB
889 EXTERNAL intab
890C-----------------------------------------------
891C L o c a l V a r i a b l e s
892C-----------------------------------------------
893 INTEGER I,J,N,NTY,NSN,NMN,ISL,NKIN,NOINT,IMODI,II,N1,N2,ND
894 INTEGER K,ILEV,NUVAR,IDEL7N,INTTH,IPR,IML,ICOM
895 INTEGER, DIMENSION(NUMNOD) :: ITAGS,ITAGMD
896 CHARACTER(LEN=NCHARTITLE):: TITR
897 LOGICAL IS1,IS2,ISD
898C=======================================================================
899C--------done before : switch to penalty if only ND is secnd (N1,N2 not)
900C-----------NOT necessary after tests---------------
901c DO N=1,NINTER
902c NTY = IPARI(7,N)
903c IF (NTY == 2 ) THEN
904c NSN = IPARI(5,N)
905c NOINT = IPARI(15,N)
906c IPR = 0
907c DO I=1,NS10E
908c ND = ICNDS10(1,I)
909c N1 = ICNDS10(2,I)
910c N2 = ICNDS10(3,I)
911c IF (ITAGND(ND)>NS10E) CYCLE
912c ISD = INTAB(NSN,INTBUF_TAB(N)%NSV,ND)
913c IF (.NOT.(ISD)) THEN
914c IS1 = INTAB(NSN,INTBUF_TAB(N)%NSV,N1)
915c IF (IS1) THEN
916c IS2 = INTAB(NSN,INTBUF_TAB(N)%NSV,N2)
917c IF (IS2.AND.ITAGND(ND)>0) THEN
918c ITAGND(ND)=-ITAGND(ND)
919c IPR = IPR +1
920c CALL ANCMSG(MSGID=1212,
921c . MSGTYPE=MSGWARNING,
922c . ANMODE=ANINFO_BLIND_1,
923c . I1=ITAB(ND),
924c . I2=ITAB(N1),
925c . I3=ITAB(N2),
926c . PRMOD=MSG_CUMU)
927c END IF
928c END IF
929c END IF
930c END DO
931c IF (IPR >0) THEN
932c CALL ANCMSG(MSGID=1212,
933c . MSGTYPE=MSGWARNING,
934c . ANMODE=ANINFO_BLIND_1,
935c . I1=NOINT,
936c . PRMOD=MSG_PRINT)
937c END IF
938c END IF !(NTY == 2 ) THEN
939c END DO
940C--error out in case N1,N2 are S of int2 (kinematic)and Nd is M or S (/w penality)
941 itagmd(1:numnod) = 0
942 itags(1:numnod) = 0
943 DO n=1,ninter
944 nty = ipari(7,n)
945 IF (nty == 2 ) THEN
946 nmn =ipari(6,n)
947 nsn = ipari(5,n)
948 ilev = ipari(20,n)
949 noint = ipari(15,n)
950 IF (ilev <= 5 .or. ilev == 30) THEN
951 DO i=1,nsn
952 isl = intbuf_tab(n)%NSV(i)
953 IF (itags(isl)==0) itags(isl)=noint
954 END DO
955 END IF
956 END IF
957 END DO
958C
959 DO i = 1, ns10e
960 n = iabs(icnds10(1,i))
961 itagmd(n) = i
962 END DO
963 DO n=1,ninter
964 nty = ipari(7,n)
965 ilev = ipari(20,n)
966 IF (nty == 2 ) THEN
967 nmn =ipari(6,n)
968 DO i=1,nmn
969 iml = intbuf_tab(n)%MSR(i)
970 IF (itagmd(iml)>0) itagmd(iml) = itagmd(iml) + ns10e
971 ENDDO
972 nsn = ipari(5,n)
973 IF (ilev == 27 .or. ilev == 28) THEN
974 DO i=1,nsn
975 isl = intbuf_tab(n)%NSV(i)
976 IF (itagmd(isl)>0 .AND.intbuf_tab(n)%IRUPT(i) == 1) itagmd(iml)=-itagmd(isl)
977 ENDDO
978 ELSEIF (ilev == 25 .or. ilev == 26) THEN
979 DO i=1,nsn
980 isl = intbuf_tab(n)%NSV(i)
981 IF (itagmd(isl)>0 ) itagmd(iml)=-itagmd(isl)
982 ENDDO
983 END IF
984 END IF
985 END DO
986C
987 icom = 0
988 isl=0
989 noint =0
990 DO i = 1, ns10e
991 n = iabs(icnds10(1,i))
992 n1 = icnds10(2,i)
993 n2 = icnds10(3,i)
994 IF (itagmd(n)>ns10e.OR.itagmd(n)<0) THEN
995 IF (itags(n1)>0.OR.itags(n2)>0) THEN
996 icom=icom+1
997 IF (itags(n1)>0) itags(n1)=-itags(n1)
998 IF (itags(n2)>0) itags(n2)=-itags(n2)
999 IF (isl==0) isl = n
1000 IF (noint==0.AND.itags(n1)<0)noint = -itags(n1)
1001 IF (noint==0.AND.itags(n2)<0)noint = -itags(n2)
1002 END IF
1003 END IF
1004 END DO
1005 IF (icom>0) THEN
1006 CALL ancmsg(msgid=1638,
1007 . msgtype=msgerror,
1008 . anmode=aninfo_blind_1,
1009 . i1=icom,
1010 . i2=itab(isl),
1011 . i3=noint,
1012 . i4=noint)
1013 END IF
1014C
1015 DO n=1,ninter
1016 nty = ipari(7,n)
1017 ilev = ipari(20,n)
1018 IF (nty == 2 ) THEN
1019 nsn = ipari(5,n)
1020 noint = ipari(15,n)
1021 imodi = 0
1022 ipr = 0
1023 IF (ilev == 25 .or. ilev == 26) THEN
1024 ELSEIF (ilev == 27 .or. ilev == 28) THEN
1025 DO i=1,nsn
1026 isl = intbuf_tab(n)%NSV(i)
1027 IF (itagnd(isl)/=0 .AND.intbuf_tab(n)%IRUPT(i) /= 1)THEN
1028 intbuf_tab(n)%NSV(i) = -isl
1029 IF (itagnd(isl)>0 ) itagnd(isl) = -itagnd(isl)
1030 imodi = imodi + 1
1031 END IF
1032 ENDDO
1033 ELSE
1034 DO i=1,nsn
1035 isl = intbuf_tab(n)%NSV(i)
1036 IF (itagnd(isl)/=0 )THEN
1037 intbuf_tab(n)%NSV(i) = -isl
1038 IF (itagnd(isl)>0 ) itagnd(isl) = -itagnd(isl)
1039 imodi = imodi + 1
1040 END IF
1041 ENDDO
1042 END IF
1043C-----------------------------------------------
1044C Compact INT,REAL BUFFER
1045C-----------------------------------------------
1046 IF (imodi > 0 ) THEN
1047 idel7n = ipari(17,n)
1048 nuvar = ipari(35,n)
1049 intth = ipari(47,n)
1050 ii = 0
1051 DO i = 1,nsn
1052 IF (intbuf_tab(n)%NSV(i) > 0) THEN
1053 ii = ii+1
1054 intbuf_tab(n)%NSV(ii) = intbuf_tab(n)%NSV(i)
1055 intbuf_tab(n)%IRTLM(ii) = intbuf_tab(n)%IRTLM(i)
1056 IF ((ilev >= 10.AND.ilev <= 22).OR.ilev == 27.OR.ilev == 28) THEN
1057 intbuf_tab(n)%IRUPT(ii) = intbuf_tab(n)%IRUPT(i)
1058 END IF
1059 intbuf_tab(n)%CSTS(1+2*(ii-1)) = intbuf_tab(n)%CSTS(1+2*(i-1))
1060 intbuf_tab(n)%CSTS(1+2*(ii-1)+1) = intbuf_tab(n)%CSTS(1+2*(i-1)+1)
1061 intbuf_tab(n)%DPARA(1+7*(ii-1)) = intbuf_tab(n)%DPARA(1+7*(i-1))
1062 intbuf_tab(n)%DPARA(1+7*(ii-1)+1) = intbuf_tab(n)%DPARA(1+7*(i-1)+1)
1063 intbuf_tab(n)%DPARA(1+7*(ii-1)+2) = intbuf_tab(n)%DPARA(1+7*(i-1)+2)
1064 intbuf_tab(n)%DPARA(1+7*(ii-1)+3) = intbuf_tab(n)%DPARA(1+7*(i-1)+3)
1065 intbuf_tab(n)%DPARA(1+7*(ii-1)+4) = intbuf_tab(n)%DPARA(1+7*(i-1)+4)
1066 intbuf_tab(n)%DPARA(1+7*(ii-1)+5) = intbuf_tab(n)%DPARA(1+7*(i-1)+5)
1067 intbuf_tab(n)%DPARA(1+7*(ii-1)+6) = intbuf_tab(n)%DPARA(1+7*(i-1)+6)
1068 IF (idel7n /= 0)THEN
1069 intbuf_tab(n)%SMAS(ii) = intbuf_tab(n)%SMAS(i)
1070 intbuf_tab(n)%SINER(ii) = intbuf_tab(n)%SINER(i)
1071 END IF
1072 IF ((ilev>=10 .AND. ilev<=22 ).OR. intth > 0) THEN
1073 intbuf_tab(n)%AREAS2(ii) = intbuf_tab(n)%AREAS2(i)
1074 DO k = 0,nuvar-1
1075 intbuf_tab(n)%UVAR(1+nuvar*(ii-1)+k) =
1076 . intbuf_tab(n)%UVAR(1+nuvar*(i-1)+k)
1077 ENDDO
1078 END IF
1079 IF (( ilev>=10 .AND. ilev<=12).OR.( ilev>=20 .AND. ilev<=22)) THEN
1080 intbuf_tab(n)%SMAS(ii) = intbuf_tab(n)%SMAS(i)
1081 intbuf_tab(n)%SINER(ii) = intbuf_tab(n)%SINER(i)
1082 DO k = 0,nuvar-1
1083 intbuf_tab(n)%UVAR(1+nuvar*(ii-1)+k) =
1084 . intbuf_tab(n)%UVAR(1+nuvar*(i-1)+k)
1085 ENDDO
1086 DO k = 0,2
1087 intbuf_tab(n)%XM0(1+3*(ii-1)+k) = intbuf_tab(n)%XM0(1+3*(i-1)+k)
1088 intbuf_tab(n)%DSM(1+3*(ii-1)+k) = intbuf_tab(n)%DSM(1+3*(i-1)+k)
1089 intbuf_tab(n)%FSM(1+3*(ii-1)+k) = intbuf_tab(n)%FSM(1+3*(i-1)+k)
1090 ENDDO
1091 ELSEIF (ilev==27 .OR. ilev==28) THEN
1092 intbuf_tab(n)%SMAS(ii) = intbuf_tab(n)%SMAS(i)
1093 intbuf_tab(n)%SINER(ii) = intbuf_tab(n)%SINER(i)
1094 intbuf_tab(n)%SPENALTY(ii) = intbuf_tab(n)%SPENALTY(i)
1095 intbuf_tab(n)%STFR_PENALTY(ii) = intbuf_tab(n)%STFR_PENALTY(i)
1096 DO k = 0,8
1097 intbuf_tab(n)%SKEW(1+9*(ii-1)+k) = intbuf_tab(n)%SKEW(1+9*(i-1)+k)
1098 ENDDO
1099 DO k = 0,2
1100 intbuf_tab(n)%DSM(1+3*(ii-1)+k) = intbuf_tab(n)%DSM(1+3*(i-1)+k)
1101 intbuf_tab(n)%FSM(1+3*(ii-1)+k) = intbuf_tab(n)%FSM(1+3*(i-1)+k)
1102 intbuf_tab(n)%FINI(1+3*(ii-1)+k) = intbuf_tab(n)%FINI(1+3*(i-1)+k)
1103 ENDDO
1104 END IF
1105 IF (intbuf_tab(n)%S_CSTS_BIS>0) THEN
1106 DO k = 0,1
1107 intbuf_tab(n)%CSTS_BIS(1+2*(ii-1)+k) = intbuf_tab(n)%CSTS_BIS(1+2*(i-1)+k)
1108 ENDDO
1109 END IF
1110 ELSE
1111C-----warning out
1112 isl = -intbuf_tab(n)%NSV(i)
1113 ipr = 1
1114 IF (ipri>=5)
1115 . CALL ancmsg(msgid=1209,
1116 . msgtype=msginfo,
1117 . anmode=aninfo_blind_1,
1118 . i1=itab(isl),
1119 . prmod=msg_cumu)
1120 ENDIF
1121 ENDDO
1122 ipari(5,n) = ii
1123 END IF !(IMODI > 0 )
1124 IF (ipr >0.AND.ipri>=5) THEN
1125 CALL ancmsg(msgid=1209,
1126 . msgtype=msginfo,
1127 . anmode=aninfo_blind_1,
1128 . c1='Interface Type2 ',
1129 . i1=noint,
1130 . prmod=msg_print)
1131 END IF
1132 END IF !(NTY == 2 )
1133 ENDDO
1134C
1135c-----------
1136 RETURN
intab
logical function intab(nic, ic, n)
Definition i24tools.F:95
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

◆ pre_cndpon()

subroutine pre_cndpon ( integer, dimension(3,*) icnds10,
integer, dimension(0:*) adskycnd,
integer, dimension(*) cepcnd,
integer, dimension(*) celcnd,
integer, dimension(*) itagnd )

Definition at line 1145 of file dim_s10edg.F.

1146C-----------------------------------------------
1147C I m p l i c i t T y p e s
1148C-----------------------------------------------
1149#include "implicit_f.inc"
1150C-----------------------------------------------
1151C C o m m o n B l o c k s
1152C-----------------------------------------------
1153#include "com04_c.inc"
1154#include "com01_c.inc"
1155C-----------------------------------------------
1156C D u m m y A r g u m e n t s
1157C-----------------------------------------------
1158 INTEGER
1159 . ICNDS10(3,*), ADSKYCND(0:*),CEPCND(*),CELCND(*),ITAGND(*)
1160C-----------------------------------------------
1161C E x t e r n a l F u n c t i o n s
1162C-----------------------------------------------
1163 INTEGER NLOCAL
1164 EXTERNAL nlocal
1165C-----------------------------------------------
1166C L o c a l V a r i a b l e s
1167C-----------------------------------------------
1168 INTEGER K, I, IS,IAD, J, KK, N, NL,NIR,NL_L,P,NI,ICOMP(NSPMD)
1169C-----------------------------------------------------
1170C S o u r c e L i n e s
1171C-----------------------------------------------------
1172C
1173C Itet=2 of Tetra10 same than int2
1174C
1175C-----------------------------------------------------
1176C Preparation de ADDCNCND : Adresse matrice CNCND
1177C-----------------------------------------------------
1178 DO n=0,numnod+1
1179 adskycnd(n) = 0
1180 ENDDO
1181C
1182 nir = 2
1183 DO i=1,ns10e
1184 k = iabs(icnds10(1,i))
1185 IF (itagnd(k)>ns10e) cycle
1186 DO j=1,nir
1187 kk = icnds10(1+j,i)
1188 adskycnd(kk) = adskycnd(kk) + 1
1189 END DO
1190 END DO
1191C-----------------------------------------------
1192C CALCUL DES ADRESSES DU VECTEUR SKYLINE
1193C-----------------------------------------------
1194C------remove zero value nodes at the beginning---
1195 IF (adskycnd(1)>0) THEN
1196 ni= 1
1197 ELSE
1198 ni = 0
1199 DO i=2,numnod
1200 IF (adskycnd(i)>0) THEN
1201 ni = i
1202 GOTO 100
1203 END IF
1204 ENDDO
1205 100 CONTINUE
1206 END IF
1207C-----------first activate node should begin from 1
1208 IF (ni==1) THEN
1209 adskycnd(1) = adskycnd(1)+1
1210 ELSE
1211 adskycnd(1) = 1
1212 END IF
1213 DO i=2,numnod+1
1214 adskycnd(i)=adskycnd(i)+adskycnd(i-1)
1215 ENDDO
1216 DO i=numnod+1,ni+1,-1
1217 adskycnd(i)=adskycnd(i-1)
1218 ENDDO
1219 adskycnd(1:ni) = 1
1220C-----------------------------------------------
1221C Remplissage de CEPCND : connection Element/Local
1222C-----------------------------------------------
1223 icomp(1:nspmd)=0
1224 DO i=1,ns10e
1225 k = iabs(icnds10(1,i))
1226 IF (itagnd(k)>ns10e) cycle
1227 DO p = 1, nspmd
1228 IF(nlocal(k,p)==1)THEN
1229 cepcnd(i) = p-1
1230 icomp(p) = icomp(p) + 1
1231 celcnd(i)= icomp(p)
1232 GOTO 200
1233 ENDIF
1234 ENDDO
1235 200 CONTINUE
1236 ENDDO
1237C-----------------------------------------------
1238C Remplissage de CEL : connection Element/Local
1239C-----------------------------------------------
1240c DO P = 1, NSPMD
1241c NL_L = 0
1242c DO I=1,NS10E
1243c K = IABS(ICNDS10(1,I))
1244c IF (ITAGND(K)>NS10E) CYCLE
1245c IF(CELCND(I)==0) THEN
1246c IF(NLOCAL(K,P)==1)THEN
1247c NL_L = NL_L + 1
1248c CELCND(I) = NL_L
1249c END IF
1250c END IF
1251c END DO
1252c END DO
1253C
1254 RETURN
nlocal
integer function nlocal(n, p)
Definition ddtools.F:349

◆ rbe2modif1_nd()

subroutine rbe2modif1_nd ( integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer, dimension(*) itagnd )

Definition at line 608 of file dim_s10edg.F.

609C=======================================================================
610 USE message_mod
611C-----------------------------------------------
612C I m p l i c i t T y p e s
613C-----------------------------------------------
614#include "implicit_f.inc"
615C-----------------------------------------------
616C C o m m o n B l o c k s
617C-----------------------------------------------
618#include "com04_c.inc"
619#include "param_c.inc"
620C-----------------------------------------------
621C D u m m y A r g u m e n t s
622C-----------------------------------------------
623 INTEGER IRBE2(NRBE2L,*), LRBE2(*), ITAGND(*)
624C REAL
625C-----------------------------------------------
626C L o c a l V a r i a b l e s
627C-----------------------------------------------
628 INTEGER I,J,N,K,KK,NSL,NSL_N,K_N,NS
629 INTEGER ITAG(NUMNOD)
630C REAL
631C-----
632 IF (nrbe2==0) RETURN
633 itag(1:numnod) = itagnd(1:numnod)
634 DO i = 1, nrbe2
635 nsl = irbe2(5,i)
636 k = irbe2(1,i)
637 nsl_n = 0
638 DO j = 1, nsl
639 ns = lrbe2(k+j)
640 IF(itag(ns)>ns10e)THEN
641 IF(itagnd(ns)>ns10e) itagnd(ns) = -(itagnd(ns)-ns10e)
642 ELSE
643 nsl_n = nsl_n + 1
644 lrbe2(k+nsl_n) =ns
645 END IF
646 ENDDO
647 irbe2(5,i) = nsl_n
648 ENDDO
649C
650 RETURN

◆ rbe2modif_nd()

subroutine rbe2modif_nd ( integer nn,
integer, dimension(*) inn,
integer, dimension(*) itagnd,
integer, dimension(3,*) icnds10,
integer iu,
integer, dimension(*) itab,
integer, dimension(*) itagm,
integer m,
integer, dimension(*) itagic )

Definition at line 455 of file dim_s10edg.F.

456C=======================================================================
457 USE message_mod
458C-----------------------------------------------
459C I m p l i c i t T y p e s
460C-----------------------------------------------
461#include "implicit_f.inc"
462C-----------------------------------------------
463C D u m m y A r g u m e n t s
464C-----------------------------------------------
465 INTEGER NN, INN(*), ITAGND(*),ICNDS10(3,*),ITAGM(*),IU,ITAB(*),
466 . M,ITAGIC(*)
467C REAL
468C-----------------------------------------------
469C External function
470C-----------------------------------------------
471 LOGICAL INTAB
472 EXTERNAL intab
473C-----------------------------------------------
474C C o m m o n B l o c k s
475C-----------------------------------------------
476#include "com04_c.inc"
477#include "scr03_c.inc"
478C-----------------------------------------------
479C L o c a l V a r i a b l e s
480C-----------------------------------------------
481 INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND,N1,N2,NNEW,IER1,ID,IER2,M_1,M_2
482 LOGICAL IS1,IS2
483C REAL
484C----- IER >0 warning; <0 error out
485C--- 1: (1,nd,2) are in RBE2, nd will be removed from RBE2
486C--- 2: (1,nd) or (2,nd) are in RBE2, nd will be removed from RBE2
487C--- -1: nd alone is in RBE2
488C--- -2: RBE2 has partial dof
489C------treatment for tagged nodes in INN(*)---ICPAT=1: partial dof------------
490 nnew = 0
491 ier1 = 0
492 ier2 = 0
493C----Allow only +2 Hierarchy levers
494 m_1= itagm(m)
495 IF (m_1==0) THEN
496 m_2=0
497 ELSE
498 m_2= itagm(m_1)
499 END IF
500 DO i=1,nn
501 n = inn(i)
502C---- ITAGND(N) > NS10E due the same N defined in sereval RBE2 (per dof)
503 IF (itagnd(n) > ns10e) THEN
504C---- removed in the 2nd passe
505 nnew = nnew + 1
506 inn(nnew) =inn(i)
507 ELSEIF (itagnd(n) /=0 ) THEN
508 id = iabs(itagnd(n))
509 nd = icnds10(1,id)
510 n1 = icnds10(2,id)
511 n2 = icnds10(3,id)
512 IF (n1==m.OR.n1==m_1.OR.n1==m_2) THEN
513 is1 = .true.
514 ELSEIF (itagm(n1)==0) THEN
515 is1 = .false.
516 ELSEIF (itagm(n1)==m.OR.itagm(n1)==m_1.OR.itagm(n1)==m_2) THEN
517 IF (itagic(n1)==itagic(nd)) THEN
518 is1 = .true.
519 ELSE
520 is1 = .false.
521 END IF
522 ELSE
523 is1 = .false.
524 END IF
525C
526 IF (n2==m.OR.n2==m_1.OR.n2==m_2) THEN
527 is2 = .true.
528 ELSEIF (itagm(n2)==0) THEN
529 is2 = .false.
530 ELSEIF (itagm(n2)==m.OR.itagm(n2)==m_1.OR.itagm(n2)==m_2) THEN
531 IF (itagic(n2)==itagic(nd)) THEN
532 is2 = .true.
533 ELSE
534C------!!!!add detail for message
535 is2 = .false.
536 END IF
537 ELSE
538 is2 = .false.
539 END IF
540 IF (is1.AND.is2) THEN
541C----degenerating in 2nd passe------ and removed from RBE2 in 2nd passe
542 nnew = nnew + 1
543 inn(nnew) =inn(i)
544 itagnd(n) = itagnd(n) + ns10e
545 ier1 = 1
546 IF (ipri>=5)
547 . CALL ancmsg(msgid=1213,
548 . msgtype=msginfo,
549 . anmode=aninfo_blind_1,
550 . i1=itab(nd),
551 . c1='RBE2 ',
552 . prmod=msg_cumu)
553 ELSEIF (.NOT.(is1).AND..NOT.(is2)) THEN
554C----error out ND is along in RBE2
555 CALL ancmsg(msgid=1216,
556 . msgtype=msgerror,
557 . anmode=aninfo_blind_1,
558 . i1=itab(nd),
559 . c1='RBE2 ',
560 . i2=iu,
561 . c2='RBE2 ')
562 ELSE
563C----remove Nd from RBE2 directly
564 ier2 = 1
565 IF (ipri>=5)
566 . CALL ancmsg(msgid=1210,
567 . msgtype=msginfo,
568 . anmode=aninfo_blind_1,
569 . c1='RBE2 ',
570 . i1=itab(nd),
571 . prmod=msg_cumu)
572 END IF
573 ELSE
574 nnew = nnew + 1
575 inn(nnew) =inn(i)
576 END IF !IF (ITAGND(N) /=0 )
577 ENDDO
578C
579 nn = nnew
580 IF (ier1 >0.AND.ipri>=5) THEN
581 CALL ancmsg(msgid=1213,
582 . msgtype=msginfo,
583 . anmode=aninfo_blind_1,
584 . c1='RBE2 ',
585 . c2='RBE2 ',
586 . i1=iu,
587 . prmod=msg_print)
588 END IF
589 IF (ier2 >0.AND.ipri>=5) THEN
590 CALL ancmsg(msgid=1210,
591 . msgtype=msginfo,
592 . anmode=aninfo_blind_1,
593 . c1='RBE2 ',
594 . c2='RBE2 ',
595 . i1=iu,
596 . prmod=msg_print)
597 END IF
598C
599 RETURN

◆ remdeg_nd()

subroutine remdeg_nd ( integer nn,
integer, dimension(*) inn,
integer, dimension(*) itagnd )

Definition at line 250 of file dim_s10edg.F.

251C=======================================================================
252C-----------------------------------------------
253C I m p l i c i t T y p e s
254C-----------------------------------------------
255#include "implicit_f.inc"
256C-----------------------------------------------
257C D u m m y A r g u m e n t s
258C-----------------------------------------------
259 INTEGER NN, INN(*), ITAGND(*)
260C-----------------------------------------------
261C L o c a l V a r i a b l e s
262C-----------------------------------------------
263 INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND
264C REAL
265C------remove tagged nodes in INN(*) and will be degenerated-----------
266 nd = 0
267 DO i=1,nn
268 n = inn(i)
269 IF (itagnd(n) ==0 ) THEN
270 nd = nd + 1
271 inn(nd) =inn(i)
272 ELSEIF (itagnd(n) >0 ) THEN
273 itagnd(n) = -itagnd(n)
274 END IF
275 ENDDO
276C
277 nn = nd
278C
279 RETURN

◆ remove_nd()

subroutine remove_nd ( integer nn,
integer, dimension(*) inn,
integer, dimension(*) itagnd )

Definition at line 218 of file dim_s10edg.F.

219C=======================================================================
220C-----------------------------------------------
221C I m p l i c i t T y p e s
222C-----------------------------------------------
223#include "implicit_f.inc"
224C-----------------------------------------------
225C D u m m y A r g u m e n t s
226C-----------------------------------------------
227 INTEGER NN, INN(*), ITAGND(*)
228C-----------------------------------------------
229C L o c a l V a r i a b l e s
230C-----------------------------------------------
231 INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND
232C REAL
233C------remove tagged nodes in INN(*)----------------------------
234 nd = 0
235 DO i=1,nn
236 n = inn(i)
237 IF (itagnd(n) ==0 ) THEN
238 nd = nd + 1
239 inn(nd) =inn(i)
240 END IF
241 ENDDO
242C
243 nn = nd
244C
245 RETURN

◆ reord_icnd()

subroutine reord_icnd ( integer, dimension(3,*) icnds10,
integer, dimension(*) itagnd )

Definition at line 171 of file dim_s10edg.F.

172C=======================================================================
173C-----------------------------------------------
174C I m p l i c i t T y p e s
175C-----------------------------------------------
176#include "implicit_f.inc"
177C-----------------------------------------------
178C D u m m y A r g u m e n t s
179C-----------------------------------------------
180 INTEGER ICNDS10(3,*), ITAGND(*)
181C REAL
182C-----------------------------------------------
183C C o m m o n B l o c k s
184C-----------------------------------------------
185#include "com04_c.inc"
186C-----------------------------------------------
187C L o c a l V a r i a b l e s
188C-----------------------------------------------
189 INTEGER I,J,ICND_CP(3,NS10E),IE,N
190C REAL
191C------reordering for P/ON----------------------------
192 icnd_cp(1:3,1:ns10e)=icnds10(1:3,1:ns10e)
193C
194 ie = 0
195 DO n= 1,numnod
196 IF (itagnd(n)>0) THEN
197 j = itagnd(n)
198 ie = ie + 1
199 icnds10(1:3,ie)=icnd_cp(1:3,j)
200 itagnd(n) = ie
201 END IF
202 END DO
203 IF (ie /= ns10e) print *,'Error of re-ordering in REORD_ICND',ie,ns10e
204C
205 RETURN

◆ rigmodif1_nd()

subroutine rigmodif1_nd ( integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) itagnd )

Definition at line 402 of file dim_s10edg.F.

403C=======================================================================
404C-----------------------------------------------
405C I m p l i c i t T y p e s
406C-----------------------------------------------
407#include "implicit_f.inc"
408C-----------------------------------------------
409C C o m m o n B l o c k s
410C-----------------------------------------------
411#include "com04_c.inc"
412#include "param_c.inc"
413C-----------------------------------------------
414C D u m m y A r g u m e n t s
415C-----------------------------------------------
416 INTEGER NPBY(NNPBY,*), LPBY(*) ,ITAGND(*)
417C REAL
418C-----------------------------------------------
419C L o c a l V a r i a b l e s
420C-----------------------------------------------
421 INTEGER I,J,N,K,KK,NSL,NSL_N,K_N,NN
422C REAL
423C------removing Nd from LPBY(*)--degenerating--
424 k = 0
425 k_n = 0
426 DO n = 1, nrbykin
427 nsl=npby(2,n)
428 nsl_n = 0
429 DO kk = 1, nsl
430 nn = lpby(k+kk)
431 IF(itagnd(nn)>ns10e)THEN
432 itagnd(nn) = -(itagnd(nn)-ns10e)
433 ELSE
434 nsl_n = nsl_n + 1
435 lpby(k_n+nsl_n) =nn
436 END IF
437 ENDDO
438 k = k + nsl
439 k_n = k_n + nsl_n
440 npby(2,n) = nsl_n
441 ENDDO
442C
443 RETURN

◆ rigmodif_nd()

subroutine rigmodif_nd ( integer nn,
integer, dimension(*) inn,
integer, dimension(*) itagnd,
integer, dimension(3,*) icnds10,
integer iu,
character, dimension(*) titr,
integer, dimension(*) itab )

Definition at line 291 of file dim_s10edg.F.

292C=======================================================================
293 USE message_mod
294C-----------------------------------------------
295C I m p l i c i t T y p e s
296C-----------------------------------------------
297#include "implicit_f.inc"
298C-----------------------------------------------
299C C o m m o n B l o c k s
300C-----------------------------------------------
301#include "com04_c.inc"
302#include "scr03_c.inc"
303C-----------------------------------------------
304C D u m m y A r g u m e n t s
305C-----------------------------------------------
306 INTEGER NN, INN(*), ITAGND(*),ICNDS10(3,*),IU,ITAB(*)
307 CHARACTER TITR*(*)
308C REAL
309C-----------------------------------------------
310C External function
311C-----------------------------------------------
312 LOGICAL INTAB
313 EXTERNAL intab
314C-----------------------------------------------
315C L o c a l V a r i a b l e s
316C-----------------------------------------------
317 INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND,N1,N2,NNEW,ID,IER1,IER2
318 LOGICAL IS1,IS2
319C REAL
320C------treatment for tagged nodes in INN(*) first passe-
321C----- IER >0 warning; <0 error out
322C--- 1: (1,nd,2) are in Rbody, nd will be removed from Rbody
323C--- 2: (1,nd) or (2,nd) are in Rbody, nd will be removed from Rbody
324C--- -1: nd alone is in Rbody
325 nnew = 0
326 ier1 = 0
327 ier2 = 0
328 DO i=1,nn
329 n = inn(i)
330 IF (itagnd(n) /=0 ) THEN
331 id = iabs(itagnd(n))
332 nd = icnds10(1,id)
333 n1 = icnds10(2,id)
334 n2 = icnds10(3,id)
335 is1 = intab(nn,inn,n1)
336 is2 = intab(nn,inn,n2)
337 IF (is1.AND.is2) THEN
338C----removed from INN and degenerating in 2nd passe----------
339 itagnd(n) = itagnd(n) + ns10e
340 nnew = nnew + 1
341 inn(nnew) =inn(i)
342 ier1 =1
343 IF (ipri>=5)
344 . CALL ancmsg(msgid=1213,
345 . msgtype=msginfo,
346 . anmode=aninfo_blind_1,
347 . c1='RIGID BODY ',
348 . i1=itab(nd),
349 . prmod=msg_cumu)
350 ELSEIF (.NOT.(is1).AND..NOT.(is2)) THEN
351C----error out ND is along in RB
352 CALL ancmsg(msgid=1216,
353 . msgtype=msgerror,
354 . anmode=aninfo_blind_1,
355 . i1=itab(nd),
356 . c1='RIGID BODY ',
357 . i2=iu,
358 . c2='RIGID BODY ')
359 ELSE
360C----removed from INN directly----------
361 ier2 =1
362 IF (ipri>=5)
363 . CALL ancmsg(msgid=1210,
364 . msgtype=msginfo,
365 . anmode=aninfo_blind_1,
366 . c1='RIGID BODY ',
367 . i1=itab(nd),
368 . prmod=msg_cumu)
369 END IF
370 ELSE
371 nnew = nnew + 1
372 inn(nnew) =inn(i)
373 END IF
374 ENDDO
375C
376 nn = nnew
377 IF (ier1 >0.AND.ipri>=5) THEN
378 CALL ancmsg(msgid=1213,
379 . msgtype=msginfo,
380 . anmode=aninfo_blind_1,
381 . c1='RIGID BODY ',
382 . c2='RIGID BODY ',
383 . i1=iu,
384 . prmod=msg_print)
385 END IF
386 IF (ier2 >0.AND.ipri>=5) THEN
387 CALL ancmsg(msgid=1210,
388 . msgtype=msginfo,
389 . anmode=aninfo_blind_1,
390 . c1='RIGID BODY ',
391 . c2='RIGID BODY ',
392 . i1=iu,
393 . prmod=msg_print)
394 END IF
395 RETURN

◆ samefvid()

logical function samefvid ( integer id,
integer, dimension(nifv,*) ibfv,
integer n )

Definition at line 822 of file dim_s10edg.F.

823C----6---------------------------------------------------------------7---------8
824C I m p l i c i t T y p e s
825C-----------------------------------------------
826#include "implicit_f.inc"
827C-----------------------------------------------
828C C o m m o n B l o c k s
829C-----------------------------------------------
830#include "param_c.inc"
831#include "com04_c.inc"
832C-----------------------------------------------------------------
833C D u m m y A r g u m e n t s
834C-----------------------------------------------
835 INTEGER ID,IBFV(NIFV,*),N
836C-----------------------------------------------
837C L o c a l V a r i a b l e s
838C-----------------------------------------------
839 INTEGER I,J,NI,K
840C----6---------------------------------------------------------------7---------8
841 samefvid=.false.
842 DO i =1,nfxvel
843 ni = iabs(ibfv(1,i))
844 IF (ni==n) THEN
845 k = ibfv(12,i)
846 IF (k==id) samefvid=.true.
847 RETURN
848 ENDIF
849 ENDDO
850C
851 RETURN

◆ stifn0_nd()

subroutine stifn0_nd ( integer, dimension(3,*) icnds10,
stifn )

Definition at line 1305 of file dim_s10edg.F.

1306C=======================================================================
1307C-----------------------------------------------
1308C I m p l i c i t T y p e s
1309C-----------------------------------------------
1310#include "implicit_f.inc"
1311C-----------------------------------------------
1312C C o m m o n B l o c k s
1313C-----------------------------------------------
1314#include "com04_c.inc"
1315C-----------------------------------------------
1316C D u m m y A r g u m e n t s
1317C-----------------------------------------------
1318 INTEGER ICNDS10(3,*)
1319C REAL
1320 my_real
1321 . stifn(*)
1322C-----------------------------------------------
1323C L o c a l V a r i a b l e s
1324C-----------------------------------------------
1325 INTEGER I,J,ND
1326C REAL
1327C------put STIFN(ND)=0 for mscalling dt estimation
1328 DO i=1,ns10e
1329 nd = iabs(icnds10(1,i))
1330 stifn(nd)=zero
1331 ENDDO
1332C
1333 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ stifn1_nd()

subroutine stifn1_nd ( integer, dimension(3,*) icnds10,
stifn )

Definition at line 1340 of file dim_s10edg.F.

1341C=======================================================================
1342C-----------------------------------------------
1343C I m p l i c i t T y p e s
1344C-----------------------------------------------
1345#include "implicit_f.inc"
1346C-----------------------------------------------
1347C C o m m o n B l o c k s
1348C-----------------------------------------------
1349#include "com04_c.inc"
1350C-----------------------------------------------
1351C D u m m y A r g u m e n t s
1352C-----------------------------------------------
1353 INTEGER ICNDS10(3,*)
1354C REAL
1355 my_real
1356 . stifn(*)
1357C-----------------------------------------------
1358C L o c a l V a r i a b l e s
1359C-----------------------------------------------
1360 INTEGER I,J,ND,N1,N2
1361C REAL
1362 my_real
1363 . stif
1364C------condense STIFN(ND)
1365 DO i=1,ns10e
1366 nd = iabs(icnds10(1,i))
1367 IF (stifn(nd)<=zero) cycle
1368 stif =half*stifn(nd)
1369 n1 = icnds10(2,i)
1370 n2 = icnds10(3,i)
1371 stifn(n1)=stifn(n1)+stif
1372 stifn(n2)=stifn(n2)+stif
1373 stifn(nd)=zero
1374 ENDDO
1375C
1376 RETURN