1 : C PB803 SOURCE MAGN 10/05/19 21:15:13 6676 2 : SUBROUTINE PB803(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,NOM2) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C************************************************************************ 6 : C 7 : C CALCULE LES FONCTIONS DE FORME D'UN : CUB8 8 : C 9 : C ^ zeta 10 : C | n8______n7 11 : C | / /| 12 : C 1 |/_______/ | 13 : C |n5| |n6| 14 : C | |eta_|__| 15 : C | /n4 | /n3 16 : C |/______|/____>ksi 17 : C 0 1 18 : C n1 n2 19 : C 20 : C************************************************************************ 21 : 22 : REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG) 23 : CHARACTER*4 NOM2 24 : DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG) 25 : DIMENSION FM(MP,NPG),GM(ND,MP,NPG) 26 : DIMENSION U(5),H(5) 27 : C*** 28 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 29 : NGG=NG*NG*NG 30 : IF(NP.NE.8.OR.ND.NE.3.OR.NGG.NE.NPG) 31 : *WRITE(6,1001)NP,ND,NG,NPG,NGG 31 : IF(NP.NE.8.OR.ND.NE.3.OR.NGG.NE.NPG)CALL ARRET(0) 32 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 33 : 34 : XREF(1,1)=0.D0 35 : XREF(2,1)=0.D0 36 : XREF(3,1)=0.D0 37 : 38 : XREF(1,2)=1.D0 39 : XREF(2,2)=0.D0 40 : XREF(3,2)=0.D0 41 : 42 : XREF(1,3)=1.D0 43 : XREF(2,3)=1.D0 44 : XREF(3,3)=0.D0 45 : 46 : XREF(1,4)=0.D0 47 : XREF(2,4)=1.D0 48 : XREF(3,4)=0.D0 49 : 50 : XREF(1,5)=0.D0 51 : XREF(2,5)=0.D0 52 : XREF(3,5)=1.D0 53 : 54 : XREF(1,6)=1.D0 55 : XREF(2,6)=0.D0 56 : XREF(3,6)=1.D0 57 : 58 : XREF(1,7)=1.D0 59 : XREF(2,7)=1.D0 60 : XREF(3,7)=1.D0 61 : 62 : XREF(1,8)=0.D0 63 : XREF(2,8)=1.D0 64 : XREF(3,8)=1.D0 65 : 65 : CALL CALUHG(U,H,NG) 66 : A=0.D0 67 : B=1.D0 68 : C=0.D0 69 : D=1.D0 70 : E=0.D0 71 : F=1.D0 71 : CALL CALG3(A,B,C,D,E,F,NG,H,U,X,Y,Z,PG) 72 : DO 1 L=1,NPG 73 : C 74 : FN(1,L)=-(X(L)-1.D0)*(Y(L)-1.D0)*(Z(L)-1.D0) 75 : FN(2,L)=X(L)*(Y(L)-1.D0)*(Z(L)-1.D0) 76 : FN(3,L)=-X(L)*Y(L)*(Z(L)-1.D0) 77 : FN(4,L)=(X(L)-1.D0)*Y(L)*(Z(L)-1.D0) 78 : FN(5,L)=(X(L)-1.D0)*(Y(L)-1.D0)*Z(L) 79 : FN(6,L)=-X(L)*(Y(L)-1.D0)*Z(L) 80 : FN(7,L)=X(L)*Y(L)*Z(L) 81 : FN(8,L)=-(X(L)-1.D0)*Y(L)*Z(L) 82 : C 83 : GR(1,1,L)=-(Y(L)-1.D0)*(Z(L)-1.D0) 84 : GR(2,1,L)=-(X(L)-1.D0)*(Z(L)-1.D0) 85 : GR(3,1,L)=-(X(L)-1.D0)*(Y(L)-1.D0) 86 : C 87 : GR(1,2,L)=(Y(L)-1.D0)*(Z(L)-1.D0) 88 : GR(2,2,L)=X(L)*(Z(L)-1.D0) 89 : GR(3,2,L)=X(L)*(Y(L)-1.D0) 90 : C 91 : GR(1,3,L)=-Y(L)*(Z(L)-1.D0) 92 : GR(2,3,L)=-X(L)*(Z(L)-1.D0) 93 : GR(3,3,L)=-X(L)*Y(L) 94 : C 95 : GR(1,4,L)=Y(L)*(Z(L)-1.D0) 96 : GR(2,4,L)=(X(L)-1.D0)*(Z(L)-1.D0) 97 : GR(3,4,L)=(X(L)-1.D0)*Y(L) 98 : C 99 : GR(1,5,L)=(Y(L)-1.D0)*Z(L) 100 : GR(2,5,L)=(X(L)-1.D0)*Z(L) 101 : GR(3,5,L)=(X(L)-1.D0)*(Y(L)-1.D0) 102 : C 103 : GR(1,6,L)=-(Y(L)-1.D0)*Z(L) 104 : GR(2,6,L)=-X(L)*Z(L) 105 : GR(3,6,L)=-X(L)*(Y(L)-1.D0) 106 : C 107 : GR(1,7,L)=Y(L)*Z(L) 108 : GR(2,7,L)=X(L)*Z(L) 109 : GR(3,7,L)=X(L)*Y(L) 110 : C 111 : GR(1,8,L)=-Y(L)*Z(L) 112 : GR(2,8,L)=-(X(L)-1.D0)*Z(L) 113 : GR(3,8,L)=-(X(L)-1.D0)*Y(L) 114 : C 115 : C 116 : 117 : IF(NOM2.EQ.'P1P1')THEN 118 : FM(1,L)=FN(1,L) 119 : FM(2,L)=FN(2,L) 120 : FM(3,L)=FN(3,L) 121 : FM(4,L)=FN(4,L) 122 : FM(5,L)=FN(5,L) 123 : FM(6,L)=FN(6,L) 124 : FM(7,L)=FN(7,L) 125 : FM(8,L)=FN(8,L) 126 : C 127 : GM(1,1,L)=-(Y(L)-1.D0)*(Z(L)-1.D0) 128 : GM(2,1,L)=-(X(L)-1.D0)*(Z(L)-1.D0) 129 : GM(3,1,L)=-(X(L)-1.D0)*(Y(L)-1.D0) 130 : C 131 : GM(1,2,L)=(Y(L)-1.D0)*(Z(L)-1.D0) 132 : GM(2,2,L)=X(L)*(Z(L)-1.D0) 133 : GM(3,2,L)=X(L)*(Y(L)-1.D0) 134 : C 135 : GM(1,3,L)=-Y(L)*(Z(L)-1.D0) 136 : GM(2,3,L)=-X(L)*(Z(L)-1.D0) 137 : GM(3,3,L)=-X(L)*Y(L) 138 : C 139 : GM(1,4,L)=Y(L)*(Z(L)-1.D0) 140 : GM(2,4,L)=(X(L)-1.D0)*(Z(L)-1.D0) 141 : GM(3,4,L)=(X(L)-1.D0)*Y(L) 142 : C 143 : GM(1,5,L)=(Y(L)-1.D0)*Z(L) 144 : GM(2,5,L)=(X(L)-1.D0)*Z(L) 145 : GM(3,5,L)=(X(L)-1.D0)*(Y(L)-1.D0) 146 : C 147 : GM(1,6,L)=-(Y(L)-1.D0)*Z(L) 148 : GM(2,6,L)=-X(L)*Z(L) 149 : GM(3,6,L)=-X(L)*(Y(L)-1.D0) 150 : C 151 : GM(1,7,L)=Y(L)*Z(L) 152 : GM(2,7,L)=X(L)*Z(L) 153 : GM(3,7,L)=X(L)*Y(L) 154 : C 155 : GM(1,8,L)=-Y(L)*Z(L) 156 : GM(2,8,L)=-(X(L)-1.D0)*Z(L) 157 : GM(3,8,L)=-(X(L)-1.D0)*Y(L) 158 : C 159 : ELSE 160 : FM(1,L)=1.D0 161 : GM(1,1,L)=0.D0 162 : GM(2,1,L)=0.D0 163 : GM(3,1,L)=0.D0 164 : ENDIF 165 : 166 : 1 CONTINUE 167 : 168 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 169 : C WRITE(6,100) 170 : C WRITE(6,101) 171 : C WRITE(6,1002)FN 172 : C WRITE(6,1002)GR 173 : C WRITE(6,101) 174 : RETURN 175 : 1002 FORMAT(10(1X,1PD11.4)) 176 : 1001 FORMAT(20(1X,I5)) 177 : 100 FORMAT(1H1) 178 : 101 FORMAT(1X,'... SUB PB803 ... FN,GR,FOM,GM ',9(10H..........)/) 179 : END 180 : 181 : 182 : 183 : 184 : 185 :
© Cast3M 2003 - All rights reserved.
Disclaimer