1 : C TRJ803 SOURCE CHAT 05/01/13 03:48:25 5004 2 : SUBROUTINE TRJ803(XNOEU,X,G,IER) 3 : C 4 : C 5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 6 : C 7 : C CALCUL DES COORDONNEES DE REFERENCE DANS UN CUB8 8 : C XNOEU COORDONNEES DES SOMMETS 9 : C X REELLES 10 : C G DE REFERENCE 11 : C IER INDICE D'ERREUR 12 : C 13 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 14 : C 15 : C 16 : C 17 : IMPLICIT INTEGER(I-N) 18 : IMPLICIT REAL*8 (A-H,O-Z) 19 : C 20 : DIMENSION XNOEU(3,8),X(3),XN(8),G(3),DX(3),DG(3) 21 : DIMENSION Y(3),D1XN(8),D2XN(8),D3XN(8),A(3,3),B(3,3) 22 : -INC CCOPTIO 23 : C 24 : C 25 : NOEL=8 26 : C IDIM=3 27 : C 28 : C 29 : G(1)=0.D0 30 : G(2)=0.D0 31 : G(3)=0.D0 32 : C 33 : N1=15 34 : DO 10 K=1,N1 35 : C 36 : XN(1)=0.125D0*(1.D0-G(1))*(1.D0-G(2))*(1.D0-G(3)) 37 : XN(2)=0.125D0*(1.D0+G(1))*(1.D0-G(2))*(1.D0-G(3)) 38 : XN(3)=0.125D0*(1.D0+G(1))*(1.D0+G(2))*(1.D0-G(3)) 39 : XN(4)=0.125D0*(1.D0-G(1))*(1.D0+G(2))*(1.D0-G(3)) 40 : XN(5)=0.125D0*(1.D0-G(1))*(1.D0-G(2))*(1.D0+G(3)) 41 : XN(6)=0.125D0*(1.D0+G(1))*(1.D0-G(2))*(1.D0+G(3)) 42 : XN(7)=0.125D0*(1.D0+G(1))*(1.D0+G(2))*(1.D0+G(3)) 43 : XN(8)=0.125D0*(1.D0-G(1))*(1.D0+G(2))*(1.D0+G(3)) 44 : C 45 : Y(1)=0.D0 46 : Y(2)=0.D0 47 : Y(3)=0.D0 48 : DO 1 I =1,NOEL 49 : Y(1)=Y(1)+XN(I)*XNOEU(1,I) 50 : Y(2)=Y(2)+XN(I)*XNOEU(2,I) 51 : Y(3)=Y(3)+XN(I)*XNOEU(3,I) 52 : 1 CONTINUE 53 : C 54 : DX(1)=X(1)-Y(1) 55 : DX(2)=X(2)-Y(2) 56 : DX(3)=X(3)-Y(3) 57 : C 58 : D1XN(1)=-0.125D0*(1.D0-G(2))*(1.D0-G(3)) 59 : D1XN(2)= 0.125D0*(1.D0-G(2))*(1.D0-G(3)) 60 : D1XN(3)= 0.125D0*(1.D0+G(2))*(1.D0-G(3)) 61 : D1XN(4)=-0.125D0*(1.D0+G(2))*(1.D0-G(3)) 62 : D1XN(5)=-0.125D0*(1.D0-G(2))*(1.D0+G(3)) 63 : D1XN(6)= 0.125D0*(1.D0-G(2))*(1.D0+G(3)) 64 : D1XN(7)= 0.125D0*(1.D0+G(2))*(1.D0+G(3)) 65 : D1XN(8)=-0.125D0*(1.D0+G(2))*(1.D0+G(3)) 66 : C 67 : D2XN(1)=-0.125D0*(1.D0-G(1))*(1.D0-G(3)) 68 : D2XN(2)=-0.125D0*(1.D0+G(1))*(1.D0-G(3)) 69 : D2XN(3)= 0.125D0*(1.D0+G(1))*(1.D0-G(3)) 70 : D2XN(4)= 0.125D0*(1.D0-G(1))*(1.D0-G(3)) 71 : D2XN(5)=-0.125D0*(1.D0-G(1))*(1.D0+G(3)) 72 : D2XN(6)=-0.125D0*(1.D0+G(1))*(1.D0+G(3)) 73 : D2XN(7)= 0.125D0*(1.D0+G(1))*(1.D0+G(3)) 74 : D2XN(8)= 0.125D0*(1.D0-G(1))*(1.D0+G(3)) 75 : C 76 : D3XN(1)=-0.125D0*(1.D0-G(1))*(1.D0-G(2)) 77 : D3XN(2)=-0.125D0*(1.D0+G(1))*(1.D0-G(2)) 78 : D3XN(3)=-0.125D0*(1.D0+G(1))*(1.D0+G(2)) 79 : D3XN(4)=-0.125D0*(1.D0-G(1))*(1.D0+G(2)) 80 : D3XN(5)= 0.125D0*(1.D0-G(1))*(1.D0-G(2)) 81 : D3XN(6)= 0.125D0*(1.D0+G(1))*(1.D0-G(2)) 82 : D3XN(7)= 0.125D0*(1.D0+G(1))*(1.D0+G(2)) 83 : D3XN(8)= 0.125D0*(1.D0-G(1))*(1.D0+G(2)) 84 : C 85 : A(1,1)=0.D0 86 : A(1,2)=0.D0 87 : A(1,3)=0.D0 88 : A(2,1)=0.D0 89 : A(2,2)=0.D0 90 : A(2,3)=0.D0 91 : A(3,1)=0.D0 92 : A(3,2)=0.D0 93 : A(3,3)=0.D0 94 : DO 75 I=1,NOEL 95 : A(1,1)=A(1,1)+D1XN(I)*XNOEU(1,I) 96 : A(1,2)=A(1,2)+D2XN(I)*XNOEU(1,I) 97 : A(1,3)=A(1,3)+D3XN(I)*XNOEU(1,I) 98 : A(2,1)=A(2,1)+D1XN(I)*XNOEU(2,I) 99 : A(2,2)=A(2,2)+D2XN(I)*XNOEU(2,I) 100 : A(2,3)=A(2,3)+D3XN(I)*XNOEU(2,I) 101 : A(3,1)=A(3,1)+D1XN(I)*XNOEU(3,I) 102 : A(3,2)=A(3,2)+D2XN(I)*XNOEU(3,I) 103 : A(3,3)=A(3,3)+D3XN(I)*XNOEU(3,I) 104 : 75 CONTINUE 105 : DET=A(1,1)*(A(2,2)*A(3,3)-A(3,2)*A(2,3)) 106 : * +A(1,2)*(A(3,1)*A(2,3)-A(2,1)*A(3,3)) 107 : * +A(1,3)*(A(2,1)*A(3,2)-A(2,2)*A(3,1)) 108 : B(1,1)=(A(2,2)*A(3,3)-A(3,2)*A(2,3))/DET 109 : B(1,2)=(A(1,3)*A(3,2)-A(1,2)*A(3,3))/DET 110 : B(1,3)=(A(1,2)*A(2,3)-A(1,3)*A(2,2))/DET 111 : B(2,1)=(A(3,1)*A(2,3)-A(3,3)*A(2,1))/DET 112 : B(2,2)=(A(1,1)*A(3,3)-A(1,3)*A(3,1))/DET 113 : B(2,3)=(A(1,3)*A(2,1)-A(1,1)*A(2,3))/DET 114 : B(3,1)=(A(2,1)*A(3,2)-A(2,2)*A(3,1))/DET 115 : B(3,2)=(A(1,2)*A(3,1)-A(1,1)*A(3,2))/DET 116 : B(3,3)=(A(1,1)*A(2,2)-A(1,2)*A(2,1))/DET 117 : C 118 : DG(1)=B(1,1)*DX(1)+B(1,2)*DX(2)+B(1,3)*DX(3) 119 : DG(2)=B(2,1)*DX(1)+B(2,2)*DX(2)+B(2,3)*DX(3) 120 : DG(3)=B(3,1)*DX(1)+B(3,2)*DX(2)+B(3,3)*DX(3) 121 : C 122 : G(1)=G(1)+DG(1) 123 : G(2)=G(2)+DG(2) 124 : G(3)=G(3)+DG(3) 125 : C 126 : DA1=ABS(DG(1)) 127 : DA2=ABS(DG(2)) 128 : DA3=ABS(DG(3)) 129 : IF(DA1.LE.1.D-04.AND.DA2.LE.1.D-04.AND.DA3.LE.1.D-04)GO TO 51 130 : C 131 : 10 CONTINUE 132 : C 133 : C IF(K.GE.N1)WRITE(6,101)X(1),X(2),X(3),DA1,DA2,DA3 134 : MOTERR(1:8)='TRJ803 ' 135 : REAERR(1)=X(1) 136 : REAERR(2)=X(2) 137 : REAERR(3)=X(3) 137 : C CALL ERREUR(-300) 138 : IER=-300 139 : 51 CONTINUE 140 : C 141 : C G(1)=XG1 142 : C G(2)=YG1 143 : C G(3)=ZG1 144 : C 145 : RETURN 146 : 101 FORMAT(//,3X,'PB DE CONVERGENCE TRJ803 AU POINT SITUE EN ' 147 : *,3(1PE12.5),/,3X,'CONVERGENCE RELATIVE ',3(1PE12.5)) 148 : C 149 : END 150 : 151 :
© Cast3M 2003 - All rights reserved.
Disclaimer