1 : C RLOSHB SOURCE CHAT 07/10/22 21:17:48 5921 2 : SUBROUTINE RLOSHB(XCOQ,XCENT,PPP,XL,XV24,XV13,XJ) 3 : implicit real*8(a-h,o-z) 4 : implicit integer (i-n) 5 : 6 : * 7 : * ------------------------------------------------------------------ 8 : * 9 : * REPERE LOCAL DE LA COQUE BELYTCHKO 10 : * ===> MATRICE DE PASSAGE PPP 11 : * H. BUNG 02-93 12 : * ------------------------------------------------------------------ 13 : * 14 : * XCOQ : COORDONNEES DES 4 NOEUDS COQUES(REPERE GLOBAL) 15 : * PPP : MATRICE DE PASSAGE GLOBAL -> LOCAL 16 : * XCENT : COORDONNEES DANS LE REPERE GLOBAL DU CENTRE DE L ELEMENT 17 : * XL : COORDONNEES DES 4 NOEUDS COQUES DANS LE 18 : * LE REPERE LOCAL (XCENT, E1, E2, E3) 19 : * 20 : * IMPLICIT NONE 21 : * 22 : *--- VARIABLES GLOBALES 23 : * REAL *8 XCOQ(3,*),XCENT(*),PPP(3,*),XL(3,*),XV13(3),XV24(3),XJ 24 : dimension XCOQ(3,*),XCENT(*),PPP(3,*),XL(3,*),XV13(3),XV24(3) 25 : * 26 : *--- VARIABLES LOCALES 27 : * INTEGER NBN 28 : PARAMETER(NBN=4) 29 : * 30 : * REAL *8 XMEAN(3,4),SS(3),AUX,TMP 31 : * INTEGER IP,II 32 : dimension XMEAN(3,4),SS(3) 33 : * 34 : * 35 : *---- DEFINITION DES 4 POINTS MILIEUX DES COTES 36 : II=NBN 37 : DO IP=1,NBN 38 : XMEAN(1,IP) = 0.5D0*(XCOQ(1,II)+XCOQ(1,IP)) 39 : XMEAN(2,IP) = 0.5D0*(XCOQ(2,II)+XCOQ(2,IP)) 40 : XMEAN(3,IP) = 0.5D0*(XCOQ(3,II)+XCOQ(3,IP)) 41 : II=IP 42 : END DO 43 : * 44 : XCENT(1) = 0.5D0*(XMEAN(1,1)+XMEAN(1,3)) 45 : XCENT(2) = 0.5D0*(XMEAN(2,1)+XMEAN(2,3)) 46 : XCENT(3) = 0.5D0*(XMEAN(3,1)+XMEAN(3,3)) 47 : C 48 : C XV13 EST DANS LA DIRECTION DE E2 49 : C 50 : XV13(1) = 0.5D0*(XMEAN(1,3)-XMEAN(1,1)) 51 : XV13(2) = 0.5D0*(XMEAN(2,3)-XMEAN(2,1)) 52 : XV13(3) = 0.5D0*(XMEAN(3,3)-XMEAN(3,1)) 53 : C 54 : C XV24 = E1 55 : C 56 : XV24(1) = 0.5D0*(XMEAN(1,4)-XMEAN(1,2)) 57 : XV24(2) = 0.5D0*(XMEAN(2,4)-XMEAN(2,2)) 58 : XV24(3) = 0.5D0*(XMEAN(3,4)-XMEAN(3,2)) 59 : * 60 : *----- REPERE LOCAL 61 : * 62 : C 63 : C LE VECTEUR UNITAIRE E1 (PPP(;,1))= XV24 / ||XV24|| 64 : C 65 : TMP=SQRT(XV24(1)*XV24(1)+XV24(2)*XV24(2)+XV24(3)*XV24(3)) 66 : PPP(1,1)=XV24(1)/TMP 67 : PPP(2,1)=XV24(2)/TMP 68 : PPP(3,1)=XV24(3)/TMP 69 : C 70 : C LE VECTEUR UNITAIRE E3 (PPP(;,3)) = XV24 ^ XV13 71 : C 72 : SS(1) = XV24(2)*XV13(3) - XV24(3)*XV13(2) 73 : SS(2) = XV24(3)*XV13(1) - XV24(1)*XV13(3) 74 : SS(3) = XV24(1)*XV13(2) - XV24(2)*XV13(1) 75 : XJ = SQRT (SS(1)*SS(1)+SS(2)*SS(2)+SS(3)*SS(3)) 76 : IF(XJ.GT.0) THEN 77 : AUX=1/XJ 78 : PPP(1,3) = SS(1) * AUX 79 : PPP(2,3) = SS(2) * AUX 80 : PPP(3,3) = SS(3) * AUX 81 : ELSE 82 : STOP 'RLOSHB_3' 83 : ENDIF 84 : C 85 : C LE VECTEUR UNITAIRE E2 = E3 ^ E1 86 : C 87 : PPP(1,2) = PPP(2,3)*PPP(3,1) - PPP(3,3)*PPP(2,1) 88 : PPP(2,2) = PPP(3,3)*PPP(1,1) - PPP(1,3)*PPP(3,1) 89 : PPP(3,2) = PPP(1,3)*PPP(2,1) - PPP(2,3)*PPP(1,1) 90 : C 91 : C DANS XMEAN, ON MET XCOQ DANS LE REPERE GLOBAL TRANSLATE AU POINT XCENT 92 : C 93 : DO IP=1,NBN 94 : XMEAN(1,IP) = XCOQ(1,IP)-XCENT(1) 95 : XMEAN(2,IP) = XCOQ(2,IP)-XCENT(2) 96 : XMEAN(3,IP) = XCOQ(3,IP)-XCENT(3) 97 : END DO 98 : C 99 : C XL : COORD DES 4 NOEUDS COQUE DANS LE REPERE LOCAL (XCENT,E1,E2,E3) 100 : C 101 : DO IP=1,NBN 102 : XL(1,IP) = PPP(1,1)*XMEAN(1,IP) + PPP(2,1)*XMEAN(2,IP) 103 : & + PPP(3,1)*XMEAN(3,IP) 104 : XL(2,IP) = PPP(1,2)*XMEAN(1,IP) + PPP(2,2)*XMEAN(2,IP) 105 : & + PPP(3,2)*XMEAN(3,IP) 106 : XL(3,IP) = PPP(1,3)*XMEAN(1,IP) + PPP(2,3)*XMEAN(2,IP) 107 : & + PPP(3,3)*XMEAN(3,IP) 108 : END DO 109 : * 110 : END 111 : 112 :
© Cast3M 2003 - All rights reserved.
Disclaimer