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, nnpby, slrbody, nrbe2l, slrbe2, npby, lpby, irbe2, lrbe2)
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 1422 of file dim_s10edg.F.

1423C=======================================================================
1424 USE message_mod
1425C-----------------------------------------------
1426C I m p l i c i t T y p e s
1427C-----------------------------------------------
1428#include "implicit_f.inc"
1429C-----------------------------------------------
1430C C o m m o n B l o c k s
1431C-----------------------------------------------
1432#include "com04_c.inc"
1433C-----------------------------------------------
1434C D u m m y A r g u m e n t s
1435C-----------------------------------------------
1436 INTEGER IBCSCYC(4,*), LBCSCYC(2,*), ITAGND(*),ITAB(*)
1437C-----------------------------------------------
1438C L o c a l V a r i a b l e s
1439C-----------------------------------------------
1440 INTEGER I,J,N,K,KK,NSL,NSL_N,K_N,NS,ID,N1,N2
1441C REAL
1442C------removing Nd from LBCSCYC(*)--
1443 DO i = 1, nbcscyc
1444 k = ibcscyc(1,i)
1445 nsl =ibcscyc(3,i)
1446 nsl_n = 0
1447 id =ibcscyc(4,i)
1448 DO j = 1, nsl
1449 n1 = lbcscyc(1,k+j)
1450 n2 = lbcscyc(2,k+j)
1451 IF(itagnd(n1)==0.AND.itagnd(n2)==0)THEN
1452 nsl_n = nsl_n + 1
1453 lbcscyc(1,k+nsl_n) =n1
1454 lbcscyc(2,k+nsl_n) =n2
1455 ELSEIF(itagnd(n1)/=0.AND.itagnd(n2)/=0) THEN
1456C--- remove
1457 ELSE
1458C--- error out
1459 CALL ancmsg(msgid=1758,anmode=aninfo,msgtype=msgerror,i1=id)
1460 END IF
1461 ENDDO
1462 IF (nsl>nsl_n) THEN
1463 kk = nsl-nsl_n
1464 ibcscyc(3,i) = nsl_n
1465 ibcscyc(1,i) = k+nsl_n
1466 CALL ancmsg(msgid=1759,anmode=aninfo,msgtype=msgwarning,i1=kk,i2=id)
1467 END IF
1468 ENDDO
1469C
1470 RETURN
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1257
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

◆ bcsmodif_nd()

subroutine bcsmodif_nd ( integer, dimension(*) icode,
integer, dimension(*) itagnd,
integer, dimension(3,*) icnds10,
integer, dimension(*) itab,
integer, intent(in) nnpby,
integer, intent(in) slrbody,
integer, intent(in) nrbe2l,
integer, intent(in) slrbe2,
integer, dimension(nnpby,nrbykin), intent(in) npby,
integer, dimension(slrbody), intent(in) lpby,
integer, dimension(nrbe2l,nrbe2), intent(in) irbe2,
integer, dimension(slrbe2), intent(in) lrbe2 )

Definition at line 663 of file dim_s10edg.F.

666C=======================================================================
667 USE message_mod
668C-----------------------------------------------
669C I m p l i c i t T y p e s
670C-----------------------------------------------
671#include "implicit_f.inc"
672C-----------------------------------------------
673C D u m m y A r g u m e n t s
674C-----------------------------------------------
675 INTEGER ICODE(*), ITAGND(*),ICNDS10(3,*),ITAB(*)
676C REAL
677C-----------------------------------------------
678C C o m m o n B l o c k s
679C-----------------------------------------------
680#include "com04_c.inc"
681#include "scr03_c.inc"
682 INTEGER, INTENT (IN) :: NNPBY,SLRBODY,NRBE2L,SLRBE2
683 INTEGER, DIMENSION(NNPBY,NRBYKIN),INTENT (IN) :: NPBY
684 INTEGER, DIMENSION(SLRBODY) ,INTENT (IN) :: LPBY
685 INTEGER, DIMENSION(NRBE2L,NRBE2) ,INTENT (IN) :: IRBE2
686 INTEGER, DIMENSION(SLRBE2) ,INTENT (IN) :: LRBE2
687C-----------------------------------------------
688C L o c a l V a r i a b l e s
689C-----------------------------------------------
690 INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND,N1,N2,ID,IPR
691 INTEGER IS1,IS2,ISMIN,NSL,M,K,KK
692 INTEGER, ALLOCATABLE, DIMENSION(:) :: ICODEM
693C REAL
694C------treatment for /BCS ----------------------------
695! case of BCS by RBODY or RBE2
696 ALLOCATE(icodem(numnod))
697 icodem(1:numnod) = icode(1:numnod)
698 k = 0
699 DO n = 1, nrbykin
700 m = npby(1,n)
701 IF (icodem(m) == 0) cycle
702 nsl=npby(2,n)
703 DO kk = 1, nsl
704 nd = lpby(k+kk)
705 icodem(nd)=max(icodem(nd),icodem(m))
706 ENDDO
707 k = k + nsl
708 ENDDO
709 DO n = 1, nrbe2
710 k = irbe2(1,n)
711 m = irbe2(3,n)
712 IF (icodem(m) == 0) cycle
713 nsl = irbe2(5,n)
714 DO kk = 1, nsl
715 nd = lrbe2(k+kk)
716 icodem(nd)=max(icodem(nd),icodem(m))
717 ENDDO
718 ENDDO
719 ipr = 0
720 DO n=1,numnod
721 IF (icodem(n)>0 .AND. itagnd(n) /=0 ) THEN
722 id = iabs(itagnd(n))
723 nd = icnds10(1,id)
724 n1 = icnds10(2,id)
725 n2 = icnds10(3,id)
726 is1 = icodem(n1)
727 is2 = icodem(n2)
728 ismin = min(is1,is2)
729 IF (is1/=icodem(n).AND.is2/=icodem(n).AND.ismin<icodem(n)) THEN
730C----error out ND has more /BCS than edge node
731 CALL ancmsg(msgid=1208,
732 . msgtype=msgerror,
733 . anmode=aninfo_blind_1,
734 . i1=itab(nd),
735 . c1='Boundary conditions ',
736 . c2='Boundary conditions')
737 ELSE
738C----remove Nd from /BCS +degenerating
739 icode(n) = 0
740 ipr = 1
741 IF (itagnd(n)>0)itagnd(n) = -itagnd(n)
742 IF (ipri>=5)
743 . CALL ancmsg(msgid=1207,
744 . msgtype=msginfo,
745 . anmode=aninfo_blind_1,
746 . i1=itab(nd),
747 . prmod=msg_cumu)
748 END IF
749 END IF
750 ENDDO
751 IF (ipr >0.AND.ipri>=5) THEN
752 CALL ancmsg(msgid=1207,
753 . msgtype=msginfo,
754 . anmode=aninfo_blind_1,
755 . c1='Boundary conditions ',
756 . c2='Boundary conditions',
757 . prmod=msg_print)
758 END IF
759 DEALLOCATE(icodem)
760C
761 RETURN
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ 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 1296 of file dim_s10edg.F.

1297C-----------------------------------------------
1298C I m p l i c i t T y p e s
1299C-----------------------------------------------
1300#include "implicit_f.inc"
1301C-----------------------------------------------
1302C C o m m o n B l o c k s
1303C-----------------------------------------------
1304#include "com04_c.inc"
1305C-----------------------------------------------
1306C D u m m y A r g u m e n t s
1307C-----------------------------------------------
1308 INTEGER ADDCNCND(0:*), CNCND(*),ICNDS10(3,*),ITAGND(*)
1309C-----------------------------------------------
1310C L o c a l V a r i a b l e s
1311C-----------------------------------------------
1312 INTEGER I, J, L, K, N, OFF, NTY, NRTS, NRTM, NSN, NMN,
1313 . KK, NIR,ADSKY(NUMNOD+1)
1314C-----------------------------------------------
1315C CALCULATION OF CNE ADDCNE
1316C-----------------------------------------------
1317 DO i = 1, numnod+1
1318 adsky(i) = addcncnd(i)
1319 ENDDO
1320C
1321C ADDCNCND(I+1)-ADDCNCND(I): nb of node I (main)
1322 nir = 2
1323 DO i=1,ns10e
1324 k = icnds10(1,i)
1325 IF (itagnd(k)>ns10e) cycle
1326 DO j=1,nir
1327 kk = icnds10(1+j,i)
1328 cncnd(adsky(kk)) = i
1329 adsky(kk) = adsky(kk) + 1
1330 END DO
1331 END DO
1332C
1333 RETURN

◆ fixmodif_nd()

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

Definition at line 773 of file dim_s10edg.F.

774C=======================================================================
775 USE message_mod
776C-----------------------------------------------
777C I m p l i c i t T y p e s
778C-----------------------------------------------
779#include "implicit_f.inc"
780C-----------------------------------------------
781C C o m m o n B l o c k s
782C-----------------------------------------------
783#include "param_c.inc"
784#include "com04_c.inc"
785#include "scr03_c.inc"
786C-----------------------------------------------
787C D u m m y A r g u m e n t s
788C-----------------------------------------------
789 INTEGER IBFV(NIFV,*), ITAGND(*),ICNDS10(3,*),ITAB(*)
790C REAL
791C-----------------------------------------------
792C L o c a l V a r i a b l e s
793C-----------------------------------------------
794 INTEGER I,J,NG, NEL, DIR, N,ND,N1,N2,K,ID,IPR
795 LOGICAL IS1,IS2
796C-----------------------------------------------
797C External function
798C-----------------------------------------------
799 LOGICAL SAMEFVID
800 EXTERNAL samefvid
801C REAL
802C------treatment for tagged nodes in INN(*)----------------------------
803 ipr = 0
804 DO i=1,nfxvel
805 n = iabs(ibfv(1,i))
806 k = ibfv(12,i)
807 IF (itagnd(n) /=0 ) THEN
808 id = iabs(itagnd(n))
809 nd = icnds10(1,id)
810 n1 = icnds10(2,id)
811 n2 = icnds10(3,id)
812C--------quadratic, but---
813 is1 = samefvid(k,ibfv,n1)
814 is2 = samefvid(k,ibfv,n2)
815c IF (IS1.AND.IS2) THEN
816C----remove Nd from ICNDS10
817c ITAGND(N) = ITAGND(N) + NS10E
818 IF (.NOT.(is1).AND..NOT.(is2)) THEN
819C----error out ND is along in FV
820 CALL ancmsg(msgid=1208,
821 . msgtype=msgerror,
822 . anmode=aninfo_blind_1,
823 . i1=itab(nd),
824 . c1='Imposed VEL/DISP/ACC ',
825 . c2='Imposed VEL/DISP/ACC')
826 ELSE
827C----remove Nd from FV and warning out-- will be done in ddsplit
828 ipr = 1
829 IF (ibfv(3,i)>0) ibfv(3,i) = -ibfv(3,i)
830 IF (itagnd(n)>0)itagnd(n) = -itagnd(n)
831 IF (ipri>=5)
832 . CALL ancmsg(msgid=1207,
833 . msgtype=msginfo,
834 . anmode=aninfo_blind_1,
835 . i1=itab(nd),
836 . prmod=msg_cumu)
837 END IF
838 END IF
839 ENDDO
840C
841 IF (ipr >0.AND.ipri>=5) THEN
842 CALL ancmsg(msgid=1207,
843 . msgtype=msginfo,
844 . anmode=aninfo_blind_1,
845 . c1='Imposed VEL/DISP/ACC',
846 . c2='Imposed VEL/DISP/ACC',
847 . prmod=msg_print)
848 END IF
849C
850 RETURN
samefvid
logical function samefvid(id, ibfv, n)
Definition dim_s10edg.F:858

◆ 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 90 of file dim_s10edg.F.

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

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

◆ 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 1180 of file dim_s10edg.F.

1181C-----------------------------------------------
1182C I m p l i c i t T y p e s
1183C-----------------------------------------------
1184#include "implicit_f.inc"
1185C-----------------------------------------------
1186C C o m m o n B l o c k s
1187C-----------------------------------------------
1188#include "com04_c.inc"
1189#include "com01_c.inc"
1190C-----------------------------------------------
1191C D u m m y A r g u m e n t s
1192C-----------------------------------------------
1193 INTEGER
1194 . ICNDS10(3,*), ADSKYCND(0:*),CEPCND(*),CELCND(*),ITAGND(*)
1195C-----------------------------------------------
1196C E x t e r n a l F u n c t i o n s
1197C-----------------------------------------------
1198 INTEGER NLOCAL
1199 EXTERNAL nlocal
1200C-----------------------------------------------
1201C L o c a l V a r i a b l e s
1202C-----------------------------------------------
1203 INTEGER K, I, IS,IAD, J, KK, N, NL,NIR,NL_L,P,NI,ICOMP(NSPMD)
1204C-----------------------------------------------------
1205C S o u r c e L i n e s
1206C-----------------------------------------------------
1207C
1208C Itet=2 of Tetra10 same than int2
1209C
1210C-----------------------------------------------------
1211C Preparation of ADDCNCND : Address matrix CNCND
1212C-----------------------------------------------------
1213 DO n=0,numnod+1
1214 adskycnd(n) = 0
1215 ENDDO
1216C
1217 nir = 2
1218 DO i=1,ns10e
1219 k = iabs(icnds10(1,i))
1220 IF (itagnd(k)>ns10e) cycle
1221 DO j=1,nir
1222 kk = icnds10(1+j,i)
1223 adskycnd(kk) = adskycnd(kk) + 1
1224 END DO
1225 END DO
1226C-----------------------------------------------
1227C CALCULATION OF SKYLINE VECTOR ADDRESSES
1228C-----------------------------------------------
1229C------remove zero value nodes at the beginning---
1230 IF (adskycnd(1)>0) THEN
1231 ni= 1
1232 ELSE
1233 ni = 0
1234 DO i=2,numnod
1235 IF (adskycnd(i)>0) THEN
1236 ni = i
1237 GOTO 100
1238 END IF
1239 ENDDO
1240 100 CONTINUE
1241 END IF
1242C-----------first activate node should begin from 1
1243 IF (ni==1) THEN
1244 adskycnd(1) = adskycnd(1)+1
1245 ELSE
1246 adskycnd(1) = 1
1247 END IF
1248 DO i=2,numnod+1
1249 adskycnd(i)=adskycnd(i)+adskycnd(i-1)
1250 ENDDO
1251 DO i=numnod+1,ni+1,-1
1252 adskycnd(i)=adskycnd(i-1)
1253 ENDDO
1254 adskycnd(1:ni) = 1
1255C-----------------------------------------------
1256C Filling of Cepcnd: Element/Local Connection
1257C-----------------------------------------------
1258 icomp(1:nspmd)=0
1259 DO i=1,ns10e
1260 k = iabs(icnds10(1,i))
1261 IF (itagnd(k)>ns10e) cycle
1262 DO p = 1, nspmd
1263 IF(nlocal(k,p)==1)THEN
1264 cepcnd(i) = p-1
1265 icomp(p) = icomp(p) + 1
1266 celcnd(i)= icomp(p)
1267 GOTO 200
1268 ENDIF
1269 ENDDO
1270 200 CONTINUE
1271 ENDDO
1272C-----------------------------------------------
1273C CEL filling: Element/Local Connection
1274C-----------------------------------------------
1275c DO P = 1, NSPMD
1276c NL_L = 0
1277c DO I=1,NS10E
1278c K = IABS(ICNDS10(1,I))
1279c IF (ITAGND(K)>NS10E) CYCLE
1280c IF(CELCND(I)==0) THEN
1281c IF(NLOCAL(K,P)==1)THEN
1282c NL_L = NL_L + 1
1283c CELCND(I) = NL_L
1284c END IF
1285c END IF
1286c END DO
1287c END DO
1288C
1289 RETURN
nlocal
integer function nlocal(n, p)
Definition ddtools.F:350

◆ rbe2modif1_nd()

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

Definition at line 610 of file dim_s10edg.F.

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

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

◆ remdeg_nd()

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

Definition at line 252 of file dim_s10edg.F.

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

◆ remove_nd()

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

Definition at line 220 of file dim_s10edg.F.

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

◆ reord_icnd()

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

Definition at line 173 of file dim_s10edg.F.

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

◆ rigmodif1_nd()

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

Definition at line 404 of file dim_s10edg.F.

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

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

◆ samefvid()

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

Definition at line 857 of file dim_s10edg.F.

858C----6---------------------------------------------------------------7---------8
859C I m p l i c i t T y p e s
860C-----------------------------------------------
861#include "implicit_f.inc"
862C-----------------------------------------------
863C C o m m o n B l o c k s
864C-----------------------------------------------
865#include "param_c.inc"
866#include "com04_c.inc"
867C-----------------------------------------------------------------
868C D u m m y A r g u m e n t s
869C-----------------------------------------------
870 INTEGER ID,IBFV(NIFV,*),N
871C-----------------------------------------------
872C L o c a l V a r i a b l e s
873C-----------------------------------------------
874 INTEGER I,J,NI,K
875C----6---------------------------------------------------------------7---------8
876 samefvid=.false.
877 DO i =1,nfxvel
878 ni = iabs(ibfv(1,i))
879 IF (ni==n) THEN
880 k = ibfv(12,i)
881 IF (k==id) samefvid=.true.
882 RETURN
883 ENDIF
884 ENDDO
885C
886 RETURN

◆ stifn0_nd()

subroutine stifn0_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
1361C REAL
1362C------put STIFN(ND)=0 for mscalling dt estimation
1363 DO i=1,ns10e
1364 nd = iabs(icnds10(1,i))
1365 stifn(nd)=zero
1366 ENDDO
1367C
1368 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ stifn1_nd()

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

Definition at line 1375 of file dim_s10edg.F.

1376C=======================================================================
1377C-----------------------------------------------
1378C I m p l i c i t T y p e s
1379C-----------------------------------------------
1380#include "implicit_f.inc"
1381C-----------------------------------------------
1382C C o m m o n B l o c k s
1383C-----------------------------------------------
1384#include "com04_c.inc"
1385C-----------------------------------------------
1386C D u m m y A r g u m e n t s
1387C-----------------------------------------------
1388 INTEGER ICNDS10(3,*)
1389C REAL
1390 my_real
1391 . stifn(*)
1392C-----------------------------------------------
1393C L o c a l V a r i a b l e s
1394C-----------------------------------------------
1395 INTEGER I,J,ND,N1,N2
1396C REAL
1397 my_real
1398 . stif
1399C------condense STIFN(ND)
1400 DO i=1,ns10e
1401 nd = iabs(icnds10(1,i))
1402 IF (stifn(nd)<=zero) cycle
1403 stif =half*stifn(nd)
1404 n1 = icnds10(2,i)
1405 n2 = icnds10(3,i)
1406 stifn(n1)=stifn(n1)+stif
1407 stifn(n2)=stifn(n2)+stif
1408 stifn(nd)=zero
1409 ENDDO
1410C
1411 RETURN