C TRJ803 SOURCE CHAT 05/01/13 03:48:25 5004 SUBROUTINE TRJ803(XNOEU,X,G,IER) C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C CALCUL DES COORDONNEES DE REFERENCE DANS UN CUB8 C XNOEU COORDONNEES DES SOMMETS C X REELLES C G DE REFERENCE C IER INDICE D'ERREUR C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C DIMENSION XNOEU(3,8),X(3),XN(8),G(3),DX(3),DG(3) DIMENSION Y(3),D1XN(8),D2XN(8),D3XN(8),A(3,3),B(3,3) -INC PPARAM -INC CCOPTIO C C NOEL=8 C IDIM=3 C C G(1)=0.D0 G(2)=0.D0 G(3)=0.D0 C N1=15 DO 10 K=1,N1 C XN(1)=0.125D0*(1.D0-G(1))*(1.D0-G(2))*(1.D0-G(3)) XN(2)=0.125D0*(1.D0+G(1))*(1.D0-G(2))*(1.D0-G(3)) XN(3)=0.125D0*(1.D0+G(1))*(1.D0+G(2))*(1.D0-G(3)) XN(4)=0.125D0*(1.D0-G(1))*(1.D0+G(2))*(1.D0-G(3)) XN(5)=0.125D0*(1.D0-G(1))*(1.D0-G(2))*(1.D0+G(3)) XN(6)=0.125D0*(1.D0+G(1))*(1.D0-G(2))*(1.D0+G(3)) XN(7)=0.125D0*(1.D0+G(1))*(1.D0+G(2))*(1.D0+G(3)) XN(8)=0.125D0*(1.D0-G(1))*(1.D0+G(2))*(1.D0+G(3)) C Y(1)=0.D0 Y(2)=0.D0 Y(3)=0.D0 DO 1 I =1,NOEL Y(1)=Y(1)+XN(I)*XNOEU(1,I) Y(2)=Y(2)+XN(I)*XNOEU(2,I) Y(3)=Y(3)+XN(I)*XNOEU(3,I) 1 CONTINUE C DX(1)=X(1)-Y(1) DX(2)=X(2)-Y(2) DX(3)=X(3)-Y(3) C D1XN(1)=-0.125D0*(1.D0-G(2))*(1.D0-G(3)) D1XN(2)= 0.125D0*(1.D0-G(2))*(1.D0-G(3)) D1XN(3)= 0.125D0*(1.D0+G(2))*(1.D0-G(3)) D1XN(4)=-0.125D0*(1.D0+G(2))*(1.D0-G(3)) D1XN(5)=-0.125D0*(1.D0-G(2))*(1.D0+G(3)) D1XN(6)= 0.125D0*(1.D0-G(2))*(1.D0+G(3)) D1XN(7)= 0.125D0*(1.D0+G(2))*(1.D0+G(3)) D1XN(8)=-0.125D0*(1.D0+G(2))*(1.D0+G(3)) C D2XN(1)=-0.125D0*(1.D0-G(1))*(1.D0-G(3)) D2XN(2)=-0.125D0*(1.D0+G(1))*(1.D0-G(3)) D2XN(3)= 0.125D0*(1.D0+G(1))*(1.D0-G(3)) D2XN(4)= 0.125D0*(1.D0-G(1))*(1.D0-G(3)) D2XN(5)=-0.125D0*(1.D0-G(1))*(1.D0+G(3)) D2XN(6)=-0.125D0*(1.D0+G(1))*(1.D0+G(3)) D2XN(7)= 0.125D0*(1.D0+G(1))*(1.D0+G(3)) D2XN(8)= 0.125D0*(1.D0-G(1))*(1.D0+G(3)) C D3XN(1)=-0.125D0*(1.D0-G(1))*(1.D0-G(2)) D3XN(2)=-0.125D0*(1.D0+G(1))*(1.D0-G(2)) D3XN(3)=-0.125D0*(1.D0+G(1))*(1.D0+G(2)) D3XN(4)=-0.125D0*(1.D0-G(1))*(1.D0+G(2)) D3XN(5)= 0.125D0*(1.D0-G(1))*(1.D0-G(2)) D3XN(6)= 0.125D0*(1.D0+G(1))*(1.D0-G(2)) D3XN(7)= 0.125D0*(1.D0+G(1))*(1.D0+G(2)) D3XN(8)= 0.125D0*(1.D0-G(1))*(1.D0+G(2)) C A(1,1)=0.D0 A(1,2)=0.D0 A(1,3)=0.D0 A(2,1)=0.D0 A(2,2)=0.D0 A(2,3)=0.D0 A(3,1)=0.D0 A(3,2)=0.D0 A(3,3)=0.D0 DO 75 I=1,NOEL A(1,1)=A(1,1)+D1XN(I)*XNOEU(1,I) A(1,2)=A(1,2)+D2XN(I)*XNOEU(1,I) A(1,3)=A(1,3)+D3XN(I)*XNOEU(1,I) A(2,1)=A(2,1)+D1XN(I)*XNOEU(2,I) A(2,2)=A(2,2)+D2XN(I)*XNOEU(2,I) A(2,3)=A(2,3)+D3XN(I)*XNOEU(2,I) A(3,1)=A(3,1)+D1XN(I)*XNOEU(3,I) A(3,2)=A(3,2)+D2XN(I)*XNOEU(3,I) A(3,3)=A(3,3)+D3XN(I)*XNOEU(3,I) 75 CONTINUE DET=A(1,1)*(A(2,2)*A(3,3)-A(3,2)*A(2,3)) * +A(1,2)*(A(3,1)*A(2,3)-A(2,1)*A(3,3)) * +A(1,3)*(A(2,1)*A(3,2)-A(2,2)*A(3,1)) B(1,1)=(A(2,2)*A(3,3)-A(3,2)*A(2,3))/DET B(1,2)=(A(1,3)*A(3,2)-A(1,2)*A(3,3))/DET B(1,3)=(A(1,2)*A(2,3)-A(1,3)*A(2,2))/DET B(2,1)=(A(3,1)*A(2,3)-A(3,3)*A(2,1))/DET B(2,2)=(A(1,1)*A(3,3)-A(1,3)*A(3,1))/DET B(2,3)=(A(1,3)*A(2,1)-A(1,1)*A(2,3))/DET B(3,1)=(A(2,1)*A(3,2)-A(2,2)*A(3,1))/DET B(3,2)=(A(1,2)*A(3,1)-A(1,1)*A(3,2))/DET B(3,3)=(A(1,1)*A(2,2)-A(1,2)*A(2,1))/DET C DG(1)=B(1,1)*DX(1)+B(1,2)*DX(2)+B(1,3)*DX(3) DG(2)=B(2,1)*DX(1)+B(2,2)*DX(2)+B(2,3)*DX(3) DG(3)=B(3,1)*DX(1)+B(3,2)*DX(2)+B(3,3)*DX(3) C G(1)=G(1)+DG(1) G(2)=G(2)+DG(2) G(3)=G(3)+DG(3) C DA1=ABS(DG(1)) DA2=ABS(DG(2)) DA3=ABS(DG(3)) IF(DA1.LE.1.D-04.AND.DA2.LE.1.D-04.AND.DA3.LE.1.D-04)GO TO 51 C 10 CONTINUE C C IF(K.GE.N1)WRITE(6,101)X(1),X(2),X(3),DA1,DA2,DA3 MOTERR(1:8)='TRJ803 ' REAERR(1)=X(1) REAERR(2)=X(2) REAERR(3)=X(3) C CALL ERREUR(-300) IER=-300 51 CONTINUE C C G(1)=XG1 C G(2)=YG1 C G(3)=ZG1 C RETURN 101 FORMAT(//,3X,'PB DE CONVERGENCE TRJ803 AU POINT SITUE EN ' *,3(1PE12.5),/,3X,'CONVERGENCE RELATIVE ',3(1PE12.5)) C END