1 : C PRIS15 SOURCE CHAT 05/01/13 02:27:41 5004 2 : SUBROUTINE PRIS15(ICM,XE,XEC,XX,SHPC,SGA,QSI,IG) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : DIMENSION A(3,15),AJ(3,3),X(3),XE(3,*),XEC(3,2),XX(3,2), 6 : & BJ(3,3),F(3),SHPC(6,20,*),SGA(3,5,5),QSI(3,2),DT(3),SIB(3) 7 : DATA EPSI/1.D-7/, ZE/0.D0/,UN/1.D0/,TWO/2.D0/,DE/0.5D0/ 8 : DO 10 I=1,3 9 : S11=XE(I,1)+XE(I,10) 10 : S22=XE(I,1)-XE(I,10) 11 : T11=XE(I,2)+XE(I,11) 12 : T22=XE(I,2)-XE(I,11) 13 : U11=XE(I,6)+XE(I,15) 14 : U22=XE(I,6)-XE(I,15) 15 : W11=XE(I,3)+XE(I,12) 16 : Z11=XE(I,5)+XE(I,14) 17 : A(I,1)= XE(I,7)-XX(I,IG) 18 : A(I,2)=-S11+TWO*T11-W11-XE(I,7)+XE(I,8) 19 : A(I,3)=-S11-Z11+TWO*U11-XE(I,7)+XE(I,9) 20 : A(I,4)=-DE*S22 21 : A(I,5)= S11-TWO*T11+W11 22 : A(I,6)=TWO*(S11-T11+XE(I,4)+XE(I,13)-U11) 23 : A(I,7)=S11+Z11-TWO*U11 24 : A(I,8)=1.5D0*S22+DE*(XE(I,5)-XE(I,14))-TWO*U22 25 : A(I,9)=DE*S11-XE(I,7) 26 : A(I,10)=1.5D0*S22-TWO*T22+DE*(XE(I,3)-XE(I,12)) 27 : A(I,11)=-S22-XE(I,5)+XE(I,14)+TWO*U22 28 : A(I,12)=DE*(-S11+Z11)+XE(I,7)-XE(I,9) 29 : A(I,13)=DE*(-S11+W11)+XE(I,7)-XE(I,8) 30 : A(I,14)=-S22+TWO*T22-XE(I,3)+XE(I,12) 31 : 10 A(I,15)=TWO*(-S22+T22-XE(I,4)+XE(I,13)+U22) 32 : C 33 : C --- Initialisation 34 : C 35 : X(1)=0.25 36 : X(2)=0.25 37 : X(3)=0.00 38 : C 39 : ITER=0 40 : ICRI=0 41 : 100 CONTINUE 42 : X11=X(1)*X(1) 43 : X22=X(2)*X(2) 44 : X33=X(3)*X(3) 45 : X12=X(1)*X(2) 46 : X23=X(2)*X(3) 47 : X31=X(3)*X(1) 48 : X123=X12*X(3) 49 : DO 20 I=1,3 50 : AJ(I,1)=A(I,2)+TWO*A(I,5)*X(1)+A(I,6)*X(2)+A(I,10)*X(3) 51 : & +A(I,13)*X33+TWO*A(I,14)*X31+A(I,15)*X23 52 : C 53 : AJ(I,2)=A(I,3)+A(I,6)*X(1)+TWO*A(I,7)*X(2)+A(I,8)*X(3) 54 : & +TWO*A(I,11)*X23+A(I,12)*X33+A(I,15)*X31 55 : C 56 : 20 AJ(I,3)=A(I,4)+A(I,8)*X(2)+TWO*A(I,9)*X(3)+A(I,10)*X(1) 57 : & +A(I,11)*X22+TWO*A(I,12)*X23+TWO*A(I,13)*X31 58 : & +A(I,14)*X11+A(I,15)*X12 59 : C --- Calcul de l'inverse de la matrice AJ et son determinant :BJ=inverse(AJ) 59 : CALL INVERT(AJ,BJ,DET,ICRI) 60 : DO 40 I=1,3 61 : 40 F(I)=A(I,1)+A(I,2)*X(1)+A(I,3)*X(2)+A(I,4)*X(3)+A(I,5)*X11 62 : & +A(I,6)*X12+A(I,7)*X22+A(I,8)*X23+A(I,9)*X33 63 : & +A(I,10)*X31+A(I,11)*X22*X(3)+A(I,12)*X(2)*X33 64 : & +A(I,13)*X(1)*X33+A(I,14)*X11*X(3)+A(I,15)*X123 65 : DD=SQRT(F(1)*F(1)+F(2)*F(2)+F(3)*F(3)) 66 : IF(DD.GT.EPSI) THEN 67 : ITER=ITER+1 68 : DO 50 I=1,3 69 : 50 X(I)=X(I)-BJ(I,1)*F(1)-BJ(I,2)*F(2)-BJ(I,3)*F(3) 70 : GOTO 100 71 : END IF 72 : C 73 : DO 60 I=1,3 74 : 60 QSI(I,IG)=X(I) 75 : C --- Calcul des fonctions d'interpolation leur derivees 76 : AUX=UN-X(1)-X(2) 77 : DZEM=(UN-X(3)) 78 : DZEP=(UN+X(3)) 79 : DZMP=DZEM*DZEP 80 : PAUX =X(1)-DE*X(3)-UN 81 : PAUX1=X(2)-DE*X(3)-UN 82 : PAUX2=X(1)+X(2)+DE*X(3) 83 : PAUX3=X(1)+DE*X(3)-UN 84 : PAUX4=X(2)+DE*X(3)-UN 85 : PAUX5=X(1)+X(2)-DE*X(3) 86 : TX1=TWO*X(1) 87 : TX2=TWO*X(2) 88 : TXM2=TX2*DZEM 89 : TXP2=TX2*DZEP 90 : C --- FONCTIONS D'INTERPOLATION 91 : SHPC(1,1,IG)=-AUX*DZEM*PAUX2 92 : SHPC(1,2,IG)=TX1*AUX*DZEM 93 : SHPC(1,3,IG)=X(1)*DZEM*PAUX 94 : SHPC(1,4,IG)=TX1*X(2)*DZEM 95 : SHPC(1,5,IG)=X(2)*DZEM*PAUX1 96 : SHPC(1,6,IG)=AUX*TXM2 97 : SHPC(1,7,IG)=AUX*DZMP 98 : SHPC(1,8,IG)=X(1)*DZMP 99 : SHPC(1,9,IG)=X(2)*DZMP 100 : SHPC(1,10,IG)=-AUX*DZEP*PAUX5 101 : SHPC(1,11,IG)=TX1*AUX*DZEP 102 : SHPC(1,12,IG)=X(1)*DZEP*PAUX3 103 : SHPC(1,13,IG)=TX1*X(2)*DZEP 104 : SHPC(1,14,IG)=X(2)*DZEP*PAUX4 105 : SHPC(1,15,IG)=TXP2*AUX 106 : IF(ICM.EQ.0) GOTO 3000 107 : SHPC(2,1,IG)=(PAUX2-AUX)*DZEM 108 : SHPC(2,2,IG)=TWO*(AUX-X(1))*DZEM 109 : SHPC(2,3,IG)=(PAUX+X(1))*DZEM 110 : SHPC(3,1,IG)=(PAUX2-AUX)*DZEM 111 : SHPC(3,2,IG)=-TX1*DZEM 112 : SHPC(3,3,IG)=ZE 113 : SHPC(4,1,IG)=AUX*(PAUX2-DE*DZEM) 114 : SHPC(4,2,IG)=-TX1*AUX 115 : SHPC(4,3,IG)=-X(1)*(DE*DZEM+PAUX) 116 : SHPC(2,4,IG)=TXM2 117 : SHPC(2,5,IG)=ZE 118 : SHPC(2,6,IG)=-TXM2 119 : SHPC(3,4,IG)=TX1*DZEM 120 : SHPC(3,5,IG)=(X(2)+PAUX1)*DZEM 121 : SHPC(3,6,IG)=TWO*(AUX-X(2))*DZEM 122 : SHPC(4,4,IG)=-TX1*X(2) 123 : SHPC(4,5,IG)=-X(2)*(PAUX1+DE*DZEM) 124 : SHPC(4,6,IG)=-TX2*AUX 125 : SHPC(2,7,IG)=-DZMP 126 : SHPC(2,8,IG)=DZMP 127 : SHPC(2,9,IG)=ZE 128 : SHPC(3,7,IG)=-DZMP 129 : SHPC(3,8,IG)=ZE 130 : SHPC(3,9,IG)=DZMP 131 : SHPC(4,7,IG)=-TWO*X(3)*AUX 132 : SHPC(4,8,IG)=-TX1*X(3) 133 : SHPC(4,9,IG)=-TX2*X(3) 134 : SHPC(2,10,IG)=(PAUX5-AUX)*DZEP 135 : SHPC(2,11,IG)=TWO*(AUX-X(1))*DZEP 136 : SHPC(2,12,IG)=(PAUX3+X(1))*DZEP 137 : SHPC(3,10,IG)=(PAUX5-AUX)*DZEP 138 : SHPC(3,11,IG)=-TX1*DZEP 139 : SHPC(3,12,IG)=ZE 140 : SHPC(4,10,IG)=AUX*(DE*DZEP-PAUX5) 141 : SHPC(4,11,IG)=TX1*AUX 142 : SHPC(4,12,IG)=X(1)*(PAUX3+DE*DZEP) 143 : SHPC(2,13,IG)=TXP2 144 : SHPC(2,14,IG)=ZE 145 : SHPC(2,15,IG)=-TXP2 146 : SHPC(3,13,IG)=TX1*DZEP 147 : SHPC(3,14,IG)=(X(2)+PAUX4)*DZEP 148 : SHPC(3,15,IG)=TWO*(AUX-X(2))*DZEP 149 : SHPC(4,13,IG)=TX1*X(2) 150 : SHPC(4,14,IG)=X(2)*(PAUX4+DE*DZEP) 151 : SHPC(4,15,IG)=TX2*AUX 152 : 3000 CONTINUE 152 : CALL PROSGA(ICM,XE,XEC,XX,X,SHPC,SGA,QSI,IG,15) 153 : END 154 : 155 : 156 : 157 : 158 :
© Cast3M 2003 - All rights reserved.
Disclaimer