1 : C PB603 SOURCE MAGN 10/05/19 21:15:12 6676 2 : SUBROUTINE PB603(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG,NOM2) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C************************************************************************ 6 : C 7 : C 8 : C 9 : C************************************************************************ 10 : 11 : REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG) 12 : CHARACTER*4 NOM2 13 : DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG) 14 : DIMENSION FM(MP,NPG),GM(ND,MP,NPG) 15 : * TC n'a pas l'air de servir 16 : * DIMENSION U(5),H(5),XA(3),XB(3),XC(3),XD(3),XX(3) 17 : ** SAVE XA,XB,XC,XD 18 : * DATA XA/3*0.25D0/,XB/0.75D0,0.25D0,0.75D0/ 19 : * DATA XC/2*0.75D0,0.25D0/,XD/0.25D0,2*0.75D0/ 20 : C*** 21 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 22 : R2=SQRT(2.D0) 23 : NP2=NP*ND 24 : 25 : XREF(1,1)=0.D0 26 : XREF(2,1)=0.D0 27 : XREF(3,1)=0.D0 28 : XREF(1,2)=R2 29 : XREF(2,2)=0.D0 30 : XREF(3,2)=0.D0 31 : XREF(1,3)=0.D0 32 : XREF(2,3)=R2 33 : XREF(3,3)=0.D0 34 : 35 : XREF(1,4)=0.D0 36 : XREF(2,4)=0.D0 37 : XREF(3,4)=1.D0 38 : XREF(1,5)=R2 39 : XREF(2,5)=0.D0 40 : XREF(3,5)=1.D0 41 : XREF(1,6)=0.D0 42 : XREF(2,6)=R2 43 : XREF(3,6)=1.D0 44 : 45 : C Verification des coordonnées 46 : C IF(.TRUE.)THEN 47 : IF(.FALSE.)THEN 48 : DO 11 L=1,NP 49 : X(L)=XREF(1,L) 50 : Y(L)=XREF(2,L) 51 : Z(L)=XREF(3,L) 52 : 11 CONTINUE 53 : 54 : DO 12 L=1,NP 55 : FN(1,L)=(X(L)+Y(L)-R2)*(Z(L)-1.D0)/R2 56 : FN(2,L)=-X(L)*(Z(L)-1.D0)/R2 57 : FN(3,L)=-Y(L)*(Z(L)-1.D0)/R2 58 : FN(4,L)=-(X(L)+Y(L)-R2)*Z(L)/R2 59 : FN(5,L)=X(L)*Z(L)/R2 60 : FN(6,L)=Y(L)*Z(L)/R2 61 : write(6,1033)L,FN(1,L),FN(2,L),FN(3,L),FN(4,L),FN(5,L),FN(6,L) 62 : 12 CONTINUE 63 : 1033 FORMAT(1X,I4,' FN',10(1X,1PD11.4)) 64 : ENDIF 65 : C Fin Vérification 66 : 67 : 68 : 69 : 69 : CALL CALHPR(X,Y,Z,PG,NPG) 70 : 71 : DO 1 L=1,NPG 72 : C 73 : FN(1,L)=(X(L)+Y(L)-R2)*(Z(L)-1.D0)/R2 74 : FN(2,L)=-X(L)*(Z(L)-1.D0)/R2 75 : FN(3,L)=-Y(L)*(Z(L)-1.D0)/R2 76 : FN(4,L)=-(X(L)+Y(L)-R2)*Z(L)/R2 77 : FN(5,L)=X(L)*Z(L)/R2 78 : FN(6,L)=Y(L)*Z(L)/R2 79 : C 80 : GR(1,1,L)=(Z(L)-1.D0)/R2 81 : GR(2,1,L)=(Z(L)-1.D0)/R2 82 : GR(3,1,L)=(X(L)+Y(L)-R2)/R2 83 : GR(1,2,L)=-(Z(L)-1.D0)/R2 84 : GR(2,2,L)=0.D0 85 : GR(3,2,L)=-X(L)/R2 86 : GR(1,3,L)=0.D0 87 : GR(2,3,L)=-(Z(L)-1.D0)/R2 88 : GR(3,3,L)=-Y(L)/R2 89 : GR(1,4,L)=-Z(L)/R2 90 : GR(2,4,L)=-Z(L)/R2 91 : GR(3,4,L)=-(X(L)+Y(L)-R2)/R2 92 : GR(1,5,L)=Z(L)/R2 93 : GR(2,5,L)=0.D0 94 : GR(3,5,L)=X(L)/R2 95 : GR(1,6,L)=0.D0 96 : GR(2,6,L)=Z(L)/R2 97 : GR(3,6,L)=Y(L)/R2 98 : C 99 : 100 : IF(NOM2.EQ.'P1P1')THEN 101 : FM(1,L)=FN(1,L) 102 : FM(2,L)=FN(2,L) 103 : FM(3,L)=FN(3,L) 104 : FM(4,L)=FN(4,L) 105 : FM(5,L)=FN(5,L) 106 : FM(6,L)=FN(6,L) 107 : C 108 : GM(1,1,L)=(Z(L)-1.D0)/R2 109 : GM(2,1,L)=(Z(L)-1.D0)/R2 110 : GM(3,1,L)=(X(L)+Y(L)-R2)/R2 111 : GM(1,2,L)=-(Z(L)-1.D0)/R2 112 : GM(2,2,L)=0.D0 113 : GM(3,2,L)=-X(L)/R2 114 : GM(1,3,L)=0.D0 115 : GM(2,3,L)=-(Z(L)-1.D0)/R2 116 : GM(3,3,L)=-Y(L)/R2 117 : GM(1,4,L)=-Z(L)/R2 118 : GM(2,4,L)=-Z(L)/R2 119 : GM(3,4,L)=-(X(L)+Y(L)-R2)/R2 120 : GM(1,5,L)=Z(L)/R2 121 : GM(2,5,L)=0.D0 122 : GM(3,5,L)=X(L)/R2 123 : GM(1,6,L)=0.D0 124 : GM(2,6,L)=Z(L)/R2 125 : GM(3,6,L)=Y(L)/R2 126 : C 127 : ELSE 128 : FM(1,L)=1.D0 129 : GM(1,1,L)=0.D0 130 : GM(2,1,L)=0.D0 131 : GM(3,1,L)=0.D0 132 : ENDIF 133 : 134 : 1 CONTINUE 135 : C WRITE(6,101) 136 : 137 : C WRITE(6,1002)FM 138 : C WRITE(6,1002)GM 139 : C WRITE(6,1002)FN 140 : C WRITE(6,1002)GR 141 : C WRITE(6,101) 142 : 143 : RETURN 144 : 1002 FORMAT(10(1X,1PD11.4)) 145 : 1001 FORMAT(20(1X,I5)) 146 : 101 FORMAT(1X,'... SUBPB603 ... FM,GM,FN,GR ',9(10H..........)/) 147 : C 148 : END 149 : 150 : 151 : 152 : 153 : 154 :
© Cast3M 2003 - All rights reserved.
Disclaimer