1 : C DYVOIS SOURCE CHAT 05/01/12 23:19:23 5004
2 : SUBROUTINE DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,
3 : & ILOCAL,IROLE)
4 : IMPLICIT INTEGER(I-N)
5 : IMPLICIT REAL*8(A-H,O-Z)
6 : *-----------------------------------------------------------------------*
7 : * *
8 : * Opérateur DYNE : algorithme de Fu - de Vogelaere *
9 : * ________________________________________________ *
10 : * *
11 : * Pour la liaison Ligne_Ligne ,ligne_cercle *
12 : * Donne le noeud du maillage maitre ,le plus proche de chaque , *
13 : * point esclave *
14 : * *
15 : * Paramètres *
16 : * *
17 : * e IPALB Renseigne sur la liaison. *
18 : * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. *
19 : * e XPALB Tableau contenant les paramètres de la liaison. * *
20 : * e XPTB Tableau des d{placements des points *
21 : * e NLIAB Nombre de liaisons sur la base B. *
22 : * e NPLB Nombre total de points intervenant dans les liaisons. *
23 : * e IND Indice du pas. *
24 : * e I numéro de la liaison. *
25 : * e ILOCAL Indicateur d'une recherche locale (0) ou globale (1) sur *
26 : * les noeuds du maillage. *
27 : * e IROLE Indique quel est le maillage maitre et le maillage *
28 : * esclave *
29 : * *
30 : * *
31 : * Auteur, date de création: *
32 : * *
33 : * Samuel DURAND : le 08 Aout 1996 : Création *
34 : * Ibrahim Pinto, 05/97 , liaisons ligne_cercle *
35 : *-----------------------------------------------------------------------*
36 : *************************************************************************
37 : * *
38 : INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
39 : REAL*8 XPTB(NPLB,4,*),XPALB(NLIAB,*)
40 : REAL*8 XPCOM(3),XPCOB(3)
41 :
42 : *
43 : ITYP = IPALB(I,1)
44 : IDIM = IPALB(I,3)
45 : IF (ITYP.EQ.35 .OR. ITYP.EQ.37 .OR. ITYP.EQ.39) THEN
46 : ID1 = 6
47 : ELSE
48 : ID1 = 7
49 : ENDIF
50 : IF (IROLE.EQ.0) THEN
51 : KMAI = 0
52 : IMAI = ID1 +4*IDIM
53 : IBUT = IMAI + (IPALB(I,21))*IDIM
54 : NNOEMA = IPALB(I,21)
55 : NNOEES = IPALB(I,22)
56 : IFERMA = IPALB(I,24)
57 : KBUT = IPALB(I,21)
58 : JVOI = 26
59 : ELSE
60 : KMAI = IPALB(I,21)
61 : IBUT = ID1 + 4*IDIM
62 : IMAI = IBUT + (IPALB(I,21))*IDIM
63 : NNOEMA = IPALB(I,22)
64 : NNOEES = IPALB(I,21)
65 : IFERMA = IPALB(I,25)
66 : KBUT = 0
67 : JVOI = 26+IPALB(I,22)
68 : ENDIF
69 : *
70 : IF (ILOCAL.EQ.0) THEN
71 : *
72 : DO 100 IESC=1,NNOEES
73 : *
74 : IDESC = IBUT+(IESC-1)*IDIM
75 : IFMOIN = 1
76 : IFPLUS = 1
77 : * Recherche locale
78 : IM = IPALB(I,JVOI+IESC)
79 : XPOS = 0.D0
80 : DO 400 ID=1,IDIM
81 : IDM = IMAI + (IM-1)*IDIM + ID
82 : XPCOM(ID) = XPALB(I,IDM) +XPTB(IPLIB(I,KMAI+IM),IND,ID)
83 : XPCOB(ID) = XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),
84 : &IND,ID)
85 : XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*(XPCOM(ID)-XPCOB(ID))
86 : 400 CONTINUE
87 : XPOS = SQRT(XPOS)
88 : XREF = XPOS
89 : IREF = IM
90 : IPLUS = IM+1
91 : IMOIN = IM-1
92 : 410 CONTINUE
93 : IF (IMOIN.EQ.0) THEN
94 : IF (IFERMA.EQ.0) THEN
95 : IFMOIN = 0
96 : ELSE
97 : IMOIN = NNOEMA
98 : ENDIF
99 : ENDIF
100 : IF (IPLUS.EQ.(NNOEMA+1)) THEN
101 : IF (IFERMA.EQ.0) THEN
102 : IFPLUS = 0
103 : ELSE
104 : IPLUS = 1
105 : ENDIF
106 : ENDIF
107 : IF (IFMOIN.NE.0) THEN
108 : XPOS = 0.D0
109 : DO 412 ID=1,IDIM
110 : IDL = IMAI + (IMOIN-1)*IDIM + ID
111 : XPCOM(ID) = XPALB(I,IDL)
112 : &+XPTB(IPLIB(I,KMAI+IMOIN),IND,ID)
113 : XPCOB(ID) = XPALB(I,IDESC+ID)
114 : &+XPTB(IPLIB(I,KBUT+IESC),IND,ID)
115 : XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*
116 : &(XPCOM(ID)-XPCOB(ID))
117 : 412 CONTINUE
118 : XPOS = SQRT(XPOS)
119 : IF (XPOS.LT.XREF) THEN
120 : XREF = XPOS
121 : IREF = IMOIN
122 : IMOIN = IMOIN-1
123 : ELSE
124 : IFMOIN = 0
125 : ENDIF
126 : ENDIF
127 : IF (IFPLUS.NE.0) THEN
128 : XPOS = 0.D0
129 : DO 414 ID=1,IDIM
130 : IDN = IMAI + (IPLUS-1)*IDIM + ID
131 : XPCOM(ID) = XPALB(I,IDN)
132 : &+XPTB(IPLIB(I,KMAI+IPLUS),IND,ID)
133 : XPCOB(ID) = XPALB(I,IDESC+ID)
134 : &+XPTB(IPLIB(I,KBUT+IESC),IND,ID)
135 : XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*
136 : &(XPCOM(ID)-XPCOB(ID))
137 : 414 CONTINUE
138 : XPOS = SQRT(XPOS)
139 : IF (XPOS.LT.XREF) THEN
140 : XREF = XPOS
141 : IREF = IPLUS
142 : IPLUS = IPLUS+1
143 : ELSE
144 : IFPLUS = 0
145 : ENDIF
146 : ENDIF
147 : IF ((IFMOIN.EQ.0).AND.(IFPLUS.EQ.0)) GOTO 420
148 : GOTO 410
149 : 420 CONTINUE
150 : IPALB(I,JVOI+IESC) = IREF
151 : *
152 : 100 CONTINUE
153 : ELSE
154 : DO 200 IESC=1,NNOEES
155 : * Recherche globale
156 : XPOS = 0.D0
157 : * Premier noeud du maillage
158 : IDESC = IBUT+(IESC-1)*IDIM
159 : DO 422 ID=1,IDIM
160 : IDM = IMAI + ID
161 : XPCOM(ID) = XPALB(I,IDM) +XPTB(IPLIB(I,KMAI+1),IND,ID)
162 : XPCOB(ID) = XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),
163 : &IND,ID)
164 : XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*(XPCOM(ID)-XPCOB(ID))
165 : 422 CONTINUE
166 : XREF = XPOS
167 : IREF = 1
168 : DO 424 IM=2,NNOEMA
169 : XPOS = 0.D0
170 : DO 426 ID=1,IDIM
171 : IDM = IMAI + (IM-1)*IDIM + ID
172 : XPCOM(ID) = XPALB(I,IDM) +XPTB(IPLIB(I,KMAI+IM),
173 : &IND,ID)
174 : XPCOB(ID) = XPALB(I,IDESC+ID)
175 : &+XPTB(IPLIB(I,KBUT+IESC),IND,ID)
176 : XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*
177 : &(XPCOM(ID)-XPCOB(ID))
178 : 426 CONTINUE
179 : XPOS = SQRT(XPOS)
180 : IF (XPOS.LT.XREF) THEN
181 : XREF = XPOS
182 : IREF = IM
183 : ENDIF
184 : 424 CONTINUE
185 : IPALB(I,JVOI+IESC) = IREF
186 : 200 CONTINUE
187 : ENDIF
188 : *
189 :
190 : END
191 :
192 :
193 :
194 :
195 :
196 :
© Cast3M 2003 - All rights reserved.
Disclaimer