1 : C AJUSTE SOURCE GOUNAND 12/08/01 21:15:01 7453 2 : SUBROUTINE AJUSTE(V1,V2,V3,XLTR,EPTR,XLTT,EPTT,EPRS,RT,OUVER, 3 : . W1,W2,W3,YLTR,DETR,YLTT,DETT,DERS,ST,FISSU, 4 : . ANGLE,NBVECD,KAS,MODE) 5 : C 6 : C-------------------------------------------------------------------- 7 : C CORRESPONDANCE EN FONCTION DE KAS 8 : C-------------------------------------------------------------------- 9 : C 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8(A-H,O-Z) 12 : C 13 : DIMENSION V1(*),V2(*),V3(*),XLTR(*),XLTT(*),EPTR(*),EPTT(*), 14 : . EPRS(*),OUVER(*),RT(*) 15 : DIMENSION W1(*),W2(*),W3(*),YLTR(*),YLTT(*),DETR(*),DETT(*), 16 : . DERS(*),FISSU(*),ST(*) 17 : C 18 : C MODE = 1 CORRESPONDANCE EN ENTREE 19 : C MODE = 2 CORRESPONDANCE EN SORTIE 20 : C 21 : GO TO (1,2),MODE 22 : C 23 : C==================================================================== 24 : C MODE = 1 25 : C==================================================================== 26 : C 27 : 1 CONTINUE 28 : C 29 : GO TO(11,12,13),KAS 30 : C 31 : C-------------------------------------------------------------------- 32 : C KAS = 1 33 : C-------------------------------------------------------------------- 34 : C 35 : 11 CONTINUE 36 : C 37 : YLTR(1)=XLTR(2) 38 : YLTR(2)=XLTR(3) 39 : YLTR(3)=XLTR(1) 40 : C 41 : YLTT(1)=XLTT(2) 42 : YLTT(2)=XLTT(3) 43 : YLTT(3)=XLTT(1) 44 : C 45 : DETR(1)=EPTR(2) 46 : DETR(2)=EPTR(3) 47 : DETR(3)=EPTR(1) 48 : C 49 : DETT(1)=EPTT(2) 50 : DETT(2)=EPTT(3) 51 : DETT(3)=EPTT(1) 52 : C 53 : DERS(1)=EPRS(2) 54 : DERS(2)=EPRS(3) 55 : DERS(3)=EPRS(1) 56 : C 57 : FISSU(1)=OUVER(2) 58 : FISSU(2)=OUVER(3) 59 : FISSU(3)=OUVER(1) 60 : C 61 : ST(1)=RT(2) 62 : ST(2)=RT(3) 63 : ST(3)=RT(1) 64 : C 65 : DO 111 I=1,3 66 : W1(I)=V2(I) 67 : W2(I)=V3(I) 68 : W3(I)=V1(I) 69 : 111 CONTINUE 70 : C 71 : IF(NBVECD.EQ.0) RETURN 72 : IF(NBVECD.EQ.1) IANGLE=0 73 : IF(NBVECD.EQ.2) IANGLE=2 73 : CALL CLREP(W1,W2,W3,ANGLE,IANGLE) 74 : C 75 : RETURN 76 : C 77 : C-------------------------------------------------------------------- 78 : C KAS = 2 79 : C-------------------------------------------------------------------- 80 : C 81 : 12 CONTINUE 82 : C 83 : YLTR(1)=XLTR(3) 84 : YLTR(2)=XLTR(1) 85 : YLTR(3)=XLTR(2) 86 : C 87 : YLTT(1)=XLTT(3) 88 : YLTT(2)=XLTT(1) 89 : YLTT(3)=XLTT(2) 90 : C 91 : DETR(1)=EPTR(3) 92 : DETR(2)=EPTR(1) 93 : DETR(3)=EPTR(2) 94 : C 95 : DETT(1)=EPTT(3) 96 : DETT(2)=EPTT(1) 97 : DETT(3)=EPTT(2) 98 : C 99 : DERS(1)=EPRS(3) 100 : DERS(2)=EPRS(1) 101 : DERS(3)=EPRS(2) 102 : C 103 : FISSU(1)=OUVER(3) 104 : FISSU(2)=OUVER(1) 105 : FISSU(3)=OUVER(2) 106 : C 107 : ST(1)=RT(3) 108 : ST(2)=RT(1) 109 : ST(3)=RT(2) 110 : C 111 : DO 121 I=1,3 112 : W1(I)=V3(I) 113 : W2(I)=V1(I) 114 : W3(I)=V2(I) 115 : 121 CONTINUE 116 : C 117 : IF(NBVECD.EQ.0) RETURN 118 : IF(NBVECD.EQ.1) IANGLE=0 119 : IF(NBVECD.EQ.2) IANGLE=2 119 : CALL CLREP(W1,W2,W3,ANGLE,IANGLE) 120 : C 121 : RETURN 122 : C 123 : C-------------------------------------------------------------------- 124 : C KAS = 3 125 : C-------------------------------------------------------------------- 126 : C 127 : 13 CONTINUE 128 : C 129 : DO 131 I=1,3 130 : YLTR(I)=XLTR(I) 131 : YLTT(I)=XLTT(I) 132 : DETR(I)=EPTR(I) 133 : DETT(I)=EPTT(I) 134 : DERS(I)=EPRS(I) 135 : FISSU(I)=OUVER(I) 136 : ST(I)=RT(I) 137 : W1(I)=V1(I) 138 : W2(I)=V2(I) 139 : W3(I)=V3(I) 140 : 131 CONTINUE 141 : C 142 : IF(NBVECD.EQ.0) RETURN 143 : IF(NBVECD.EQ.1) IANGLE=0 144 : IF(NBVECD.EQ.2) IANGLE=2 144 : CALL CLREP(W1,W2,W3,ANGLE,IANGLE) 145 : C 146 : RETURN 147 : C 148 : C==================================================================== 149 : C MODE = 2 150 : C==================================================================== 151 : C 152 : 2 CONTINUE 153 : C 154 : GO TO(21,22,23),KAS 155 : C 156 : C-------------------------------------------------------------------- 157 : C KAS = 1 158 : C-------------------------------------------------------------------- 159 : C 160 : 21 CONTINUE 161 : C 162 : XLTR(2)=YLTR(1) 163 : XLTR(3)=YLTR(2) 164 : XLTR(1)=YLTR(3) 165 : C 166 : XLTT(2)=YLTT(1) 167 : XLTT(3)=YLTT(2) 168 : XLTT(1)=YLTT(3) 169 : C 170 : EPTR(2)=DETR(1) 171 : EPTR(3)=DETR(2) 172 : EPTR(1)=DETR(3) 173 : C 174 : EPTT(2)=DETT(1) 175 : EPTT(3)=DETT(2) 176 : EPTT(1)=DETT(3) 177 : C 178 : EPRS(2)=DERS(1) 179 : EPRS(3)=DERS(2) 180 : EPRS(1)=DERS(3) 181 : C 182 : OUVER(2)=FISSU(1) 183 : OUVER(3)=FISSU(2) 184 : OUVER(1)=FISSU(3) 185 : C 186 : RT(2)=ST(1) 187 : RT(3)=ST(2) 188 : RT(1)=ST(3) 189 : C 190 : IF(NBVECD.EQ.0) THEN 191 : DO 211 I=1,3 192 : W1(I)=0.D0 193 : W2(I)=0.D0 194 : W3(I)=0.D0 195 : 211 CONTINUE 196 : ENDIF 197 : C 198 : IF(NBVECD.EQ.1) THEN 199 : DO 212 I=1,3 200 : W1(I)=0.D0 201 : W2(I)=0.D0 202 : 212 CONTINUE 203 : ENDIF 204 : C 205 : IF(NBVECD.EQ.2) THEN 206 : IANGLE=3 206 : CALL CLREP(W1,W2,W3,ANGLE,IANGLE) 207 : ENDIF 208 : C 209 : DO 213 I=1,3 210 : V2(I)=W1(I) 211 : V3(I)=W2(I) 212 : V1(I)=W3(I) 213 : 213 CONTINUE 214 : C 215 : RETURN 216 : C 217 : C-------------------------------------------------------------------- 218 : C KAS = 2 219 : C-------------------------------------------------------------------- 220 : C 221 : 22 CONTINUE 222 : C 223 : XLTR(3)=YLTR(1) 224 : XLTR(1)=YLTR(2) 225 : XLTR(2)=YLTR(3) 226 : C 227 : XLTT(3)=YLTT(1) 228 : XLTT(1)=YLTT(2) 229 : XLTT(2)=YLTT(3) 230 : C 231 : EPTR(3)=DETR(1) 232 : EPTR(1)=DETR(2) 233 : EPTR(2)=DETR(3) 234 : C 235 : EPTT(3)=DETT(1) 236 : EPTT(1)=DETT(2) 237 : EPTT(2)=DETT(3) 238 : C 239 : EPRS(3)=DERS(1) 240 : EPRS(1)=DERS(2) 241 : EPRS(2)=DERS(3) 242 : C 243 : OUVER(3)=FISSU(1) 244 : OUVER(1)=FISSU(2) 245 : OUVER(2)=FISSU(3) 246 : C 247 : RT(3)=ST(1) 248 : RT(1)=ST(2) 249 : RT(2)=ST(3) 250 : C 251 : IF(NBVECD.EQ.0) THEN 252 : DO 221 I=1,3 253 : W1(I)=0.D0 254 : W2(I)=0.D0 255 : W3(I)=0.D0 256 : 221 CONTINUE 257 : ENDIF 258 : C 259 : IF(NBVECD.EQ.1) THEN 260 : DO 222 I=1,3 261 : W1(I)=0.D0 262 : W2(I)=0.D0 263 : 222 CONTINUE 264 : ENDIF 265 : C 266 : IF(NBVECD.EQ.2) THEN 267 : IANGLE=3 267 : CALL CLREP(W1,W2,W3,ANGLE,IANGLE) 268 : ENDIF 269 : C 270 : DO 223 I=1,3 271 : V3(I)=W1(I) 272 : V1(I)=W2(I) 273 : V2(I)=W3(I) 274 : 223 CONTINUE 275 : C 276 : RETURN 277 : C 278 : C-------------------------------------------------------------------- 279 : C KAS = 3 280 : C-------------------------------------------------------------------- 281 : C 282 : 23 CONTINUE 283 : C 284 : DO 231 I=1,3 285 : XLTR(I)=YLTR(I) 286 : XLTT(I)=YLTT(I) 287 : EPTR(I)=DETR(I) 288 : EPTT(I)=DETT(I) 289 : EPRS(I)=DERS(I) 290 : OUVER(I)=FISSU(I) 291 : RT(I)=ST(I) 292 : 231 CONTINUE 293 : C 294 : IF(NBVECD.EQ.0) THEN 295 : DO 232 I=1,3 296 : W1(I)=0.D0 297 : W2(I)=0.D0 298 : W3(I)=0.D0 299 : 232 CONTINUE 300 : ENDIF 301 : C 302 : IF(NBVECD.EQ.1) THEN 303 : DO 233 I=1,3 304 : W1(I)=0.D0 305 : W2(I)=0.D0 306 : 233 CONTINUE 307 : ENDIF 308 : C 309 : IF(NBVECD.EQ.2) THEN 310 : IANGLE=3 310 : CALL CLREP(W1,W2,W3,ANGLE,IANGLE) 311 : ENDIF 312 : C 313 : DO 234 I=1,3 314 : V1(I)=W1(I) 315 : V2(I)=W2(I) 316 : V3(I)=W3(I) 317 : 234 CONTINUE 318 : C 319 : RETURN 320 : C 321 : END 322 : 323 :
© Cast3M 2003 - All rights reserved.
Disclaimer