1 : C PB2103 SOURCE MAGN 10/05/31 21:15:13 6679 2 : SUBROUTINE PB2103 3 : &(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NG,NGT,NPG,NOM2) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : C************************************************************************ 7 : C 8 : C CALCULE LES FONCTIONS DE FORME D'UN : PR21 9 : C 10 : C ^ eta 11 : C | 12 : C a |n3 13 : C /|\ 14 : C / | \ a=sqrt(2) 15 : C / | \ 16 : C |\ | \ 17 : C | \ |____\ _____>ksi 18 : C | \q a 19 : C | / \ 20 : C |/_ _\ 21 : C 22 : C zeta 23 : C************************************************************************ 24 : 25 : REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG) 26 : PARAMETER (NPG1=5,NPG2=7) 27 : REAL*8 X1(NPG1),PG1(NPG1) 28 : REAL*8 X2(NPG2),Y2(NPG2),PG2(NPG2) 29 : CHARACTER*4 NOM2 30 : DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG) 31 : DIMENSION F2N(7,NPG2),G2R(2,7,NPG2) 32 : DIMENSION FM(MP,NPG),GM(ND,MP,NPG) 33 : DIMENSION U(5),H(5),XA(3),XB(3),XC(3),XD(3),XX(3) 34 : DIMENSION I12(21) 35 : * SAVE XA,XB,XC,XD,I12 36 : DATA XA/3*0.25D0/,XB/0.75D0,0.25D0,0.75D0/ 37 : DATA XC/2*0.75D0,0.25D0/,XD/0.25D0,2*0.75D0/ 38 : DATA I12/1,2,3,4,5,6,19,7,16,8,17,9,18,21,10,11,12,13,14,15,20/ 39 : C*** 40 : R2=SQRT(2.D0) 41 : 42 : XREF(1,1)=0.D0 43 : XREF(2,1)=0.D0 44 : XREF(3,1)=0.D0 45 : 46 : XREF(1,2)=R2/2.D0 47 : XREF(2,2)=0.D0 48 : XREF(3,2)=0.D0 49 : 50 : XREF(1,3)=R2 51 : XREF(2,3)=0.D0 52 : XREF(3,3)=0.D0 53 : 54 : XREF(1,4)=R2/2.D0 55 : XREF(2,4)=R2/2.D0 56 : XREF(3,4)=0.D0 57 : 58 : XREF(1,5)=0.D0 59 : XREF(2,5)=R2 60 : XREF(3,5)=0.D0 61 : 62 : XREF(1,6)=0.D0 63 : XREF(2,6)=R2/2.D0 64 : XREF(3,6)=0.D0 65 : 66 : XREF(1,7)=0.D0 67 : XREF(2,7)=0.D0 68 : XREF(3,7)=0.5D0 69 : 70 : XREF(1,8)=R2 71 : XREF(2,8)=0.D0 72 : XREF(3,8)=0.5D0 73 : 74 : XREF(1,9)=0.D0 75 : XREF(2,9)=R2 76 : XREF(3,9)=0.5D0 77 : 78 : XREF(1,10)=0.D0 79 : XREF(2,10)=0.D0 80 : XREF(3,10)=1.D0 81 : 82 : XREF(1,11)=R2/2.D0 83 : XREF(2,11)=0.D0 84 : XREF(3,11)=1.D0 85 : 86 : XREF(1,12)=R2 87 : XREF(2,12)=0.D0 88 : XREF(3,12)=1.D0 89 : 90 : XREF(1,13)=R2/2.D0 91 : XREF(2,13)=R2/2.D0 92 : XREF(3,13)=1.D0 93 : 94 : XREF(1,14)=0.D0 95 : XREF(2,14)=R2 96 : XREF(3,14)=1.D0 97 : 98 : XREF(1,15)=0.D0 99 : XREF(2,15)=R2/2.D0 100 : XREF(3,15)=1.D0 101 : 102 : 103 : XREF(1,16)=R2/2.D0 104 : XREF(2,16)=0.D0 105 : XREF(3,16)=0.5D0 106 : 107 : XREF(1,17)=R2/2.D0 108 : XREF(2,17)=R2/2.D0 109 : XREF(3,17)=0.5D0 110 : 111 : XREF(1,18)=0.D0 112 : XREF(2,18)=R2/2.D0 113 : XREF(3,18)=0.5D0 114 : 115 : XREF(1,19)=R2/3.D0 116 : XREF(2,19)=R2/3.D0 117 : XREF(3,19)=0.D0 118 : 119 : XREF(1,20)=R2/3.D0 120 : XREF(2,20)=R2/3.D0 121 : XREF(3,20)=1.D0 122 : 123 : XREF(1,21)=R2/3.D0 124 : XREF(2,21)=R2/3.D0 125 : XREF(3,21)=0.5D0 126 : 126 : IF(NG.GT.5.OR.NGT.GT.7)CALL ARRET(0) 127 : 127 : CALL CALUHG(U,H,NG) 127 : CALL CALUHH(X2,Y2,PG2,NGT) 128 : A=0.D0 129 : B=1.D0 129 : CALL CALG1(A,B,NG,H,U,X1,PG1) 130 : 131 : LL=0 132 : DO 1 L=1,NGT 133 : DO 2 L1=1,NG 134 : LL=LL+1 135 : X(L)=X2(L) 136 : Y(L)=Y2(L) 137 : Z(L)=X1(L1) 138 : 139 : PG(LL)=PG1(L1)*PG2(L) 140 : C write(6,*)' LL x,y,z,pg1,pg2=', 141 : C 142 : XX(1)=X(L) 143 : XX(2)=Y(L) 144 : XX(3)=Z(L) 145 : 146 : IF(NOM2.EQ.'PRP0')THEN 147 : FM(1,LL)=1.D0 147 : CALL INITD(GM,(3*NPG),0.D0) 148 : ELSEIF(NOM2.EQ.'PRP1')THEN 149 : FM(1,LL)=EQPL3P(XX,XB,XC,XD)/ 150 : & EQPL3P(XA,XB,XC,XD) 151 : FM(2,LL)=EQPL3P(XX,XA,XC,XD)/ 152 : & EQPL3P(XB,XA,XC,XD) 153 : FM(3,LL)=EQPL3P(XX,XA,XB,XD)/ 154 : & EQPL3P(XC,XA,XB,XD) 155 : FM(4,LL)=EQPL3P(XX,XA,XB,XC)/ 156 : & EQPL3P(XD,XA,XB,XC) 156 : CALL INITD(GM,(12*NPG),0.D0) 157 : ELSEIF(NOM2.EQ.'PFP1')THEN 158 : FM(1,LL)=(X(L)+Y(L)-R2)*(Z(L)-1.D0)/R2 159 : FM(2,LL)=-X(L)*(Z(L)-1.D0)/R2 160 : FM(3,LL)=-Y(L)*(Z(L)-1.D0)/R2 161 : FM(4,LL)=-(X(L)+Y(L)-R2)*Z(L)/R2 162 : FM(5,LL)=X(L)*Z(L)/R2 163 : FM(6,LL)=Y(L)*Z(L)/R2 164 : C 165 : GM(1,1,LL)=(Z(L)-1.D0)/R2 166 : GM(2,1,LL)=(Z(L)-1.D0)/R2 167 : GM(3,1,LL)=(X(L)+Y(L)-R2)/R2 168 : GM(1,2,LL)=-(Z(L)-1.D0)/R2 169 : GM(2,2,LL)=0.D0 170 : GM(3,2,LL)=-X(L)/R2 171 : GM(1,3,LL)=0.D0 172 : GM(2,3,LL)=-(Z(L)-1.D0)/R2 173 : GM(3,3,LL)=-Y(L)/R2 174 : GM(1,4,LL)=-Z(L)/R2 175 : GM(2,4,LL)=-Z(L)/R2 176 : GM(3,4,LL)=-(X(L)+Y(L)-R2)/R2 177 : GM(1,5,LL)=Z(L)/R2 178 : GM(2,5,LL)=0.D0 179 : GM(3,5,LL)=X(L)/R2 180 : GM(1,6,LL)=0.D0 181 : GM(2,6,LL)=Z(L)/R2 182 : GM(3,6,LL)=Y(L)/R2 183 : C 184 : ENDIF 185 : 186 : C 187 : F2N(1,L)=(1.D0-X(L)/R2-Y(L)/R2)*(1.D0-2.D0*X(L)/R2-2.D0*Y(L)/R2+ 188 : * 3.D0/2.D0*X(L)*Y(L)) 189 : F2N(2,L)=(1.D0-X(L)/R2-Y(L)/R2)*(4.D0/R2-6.D0*Y(L))*X(L) 190 : F2N(3,L)=X(L)/R2*(2.D0*X(L)/R2-1.D0+3.D0*(1.D0-X(L)/R2-Y(L)/R2) 191 : & *Y(L)/R2) 192 : F2N(4,L)=2.D0*X(L)*Y(L)*(1.D0-3.D0*(1.D0-X(L)/R2-Y(L)/R2)) 193 : F2N(5,L)=Y(L)*Y(L)-Y(L)*R2/2.D0+3.D0/2.D0*X(L)*Y(L)- 194 : * 3.D0*R2/4.D0*X(L)*X(L)*Y(L)-3.D0*R2/4.D0*X(L)*Y(L)*Y(L) 195 : F2N(6,L)=2.D0*R2*(-R2/2.D0*Y(L)*Y(L)+3.D0/2.D0*(Y(L)*Y(L)*X(L)+ 196 : * X(L)*X(L)*Y(L))-2.D0*R2*X(L)*Y(L)+Y(L)) 197 : F2N(7,L)=27.D0/2.D0*(X(L)*Y(L)-R2/2.D0*X(L)*X(L)*Y(L)- 198 : *R2/2.D0*X(L)*Y(L)*Y(L)) 199 : C 200 : G2R(1,1,L)=-3.D0*R2/4.D0*Y(L)*Y(L)+2.D0*X(L)+7./2.D0*Y(L)- 201 : * 3.D0*R2/2.D0*X(L)*Y(L)-3.D0*R2/2.D0 202 : G2R(2,1,L)=-3.D0*R2/4.D0*X(L)*X(L)+2.D0*Y(L)+7./2.D0*X(L)- 203 : * 3.D0*R2/2.D0*X(L)*Y(L)-3.D0*R2/2.D0 204 : G2R(1,2,L)=3.D0*R2*Y(L)*Y(L)+6.D0*R2*X(L)*Y(L)-4.D0*X(L) 205 : & -8.D0*Y(L)+2.D0*R2 206 : G2R(2,2,L)=3.D0*R2*X(L)*X(L)+6.D0*R2*X(L)*Y(L)-8.D0*X(L) 207 : G2R(1,3,L)=-3.D0*R2/4.D0*Y(L)*Y(L)-3.D0*R2/2.D0*X(L)*Y(L)+ 208 : * 2.D0*X(L)+3.D0/2.D0*Y(L)-R2/2.D0 209 : G2R(2,3,L)=R2/2.D0*(-3.D0/2.D0*X(L)*X(L)-3.D0*X(L)*Y(L)+ 210 : * 3.D0*R2/2.D0*X(L)) 211 : G2R(1,4,L)=3.D0*R2*Y(L)*Y(L)+6.D0*R2*X(L)*Y(L)-4.D0*Y(L) 212 : G2R(2,4,L)=3.D0*R2*X(L)*X(L)+6.D0*R2*X(L)*Y(L)-4.D0*X(L) 213 : G2R(1,5,L)=-3.D0*R2/4.D0*Y(L)*Y(L)-3.D0*R2/2.D0*X(L)*Y(L) 214 : & +3.D0/2.D0*Y(L) 215 : G2R(2,5,L)=-3.D0*R2/4.D0*X(L)*X(L)-3.D0*R2/2.D0*X(L)*Y(L) 216 : & +2.D0*Y(L)+ 217 : * 3.D0/2.D0*X(L)-R2/2.D0 218 : G2R(1,6,L)=3.D0*R2*Y(L)*Y(L)+6.D0*R2*X(L)*Y(L)-8.D0*Y(L) 219 : G2R(2,6,L)=3.D0*R2*X(L)*X(L)+6.D0*R2*X(L)*Y(L)-8.D0*X(L) 220 : & -4.D0*Y(L)+2.D0*R2 221 : G2R(1,7,L)=27.D0/2.D0*(-R2/2*Y(L)*Y(L)-R2*X(L)*Y(L)+Y(L)) 222 : G2R(2,7,L)=27.D0/2.D0*(-R2/2*X(L)*X(L)-R2*X(L)*Y(L)+X(L)) 223 : C 224 : DO 111 I=1,7 225 : I1=I12(I) 226 : I7=I12(I+7) 227 : I14=I12(I+14) 228 : FN(I1,LL)=F2N(I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0) 229 : FN(I7,LL)=F2N(I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0) 230 : FN(I14,LL)=F2N(I,L)*Z(L)*(2.D0*Z(L)-1.D0) 231 : 232 : GR(1,I1,LL)=G2R(1,I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0) 233 : GR(2,I1,LL)=G2R(2,I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0) 234 : GR(3,I1,LL)=F2N(I,L)*(4.D0*Z(L)-3.D0) 235 : 236 : GR(1,I7,LL)=G2R(1,I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0) 237 : GR(2,I7,LL)=G2R(2,I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0) 238 : GR(3,I7,LL)=F2N(I,L)*(-8.D0*Z(L)+4.D0) 239 : 240 : GR(1,I14,LL)=G2R(1,I,L)*Z(L)*(2.D0*Z(L)-1.D0) 241 : GR(2,I14,LL)=G2R(2,I,L)*Z(L)*(2.D0*Z(L)-1.D0) 242 : GR(3,I14,LL)=F2N(I,L)*(4.D0*Z(L)-1.D0) 243 : 244 : 111 CONTINUE 245 : 246 : 2 CONTINUE 247 : 1 CONTINUE 248 : C 249 : C 250 : C WRITE(6,101) 251 : C WRITE(6,1002)FM 252 : C WRITE(6,1002)GM 253 : C write(6,*)' FN' 254 : C WRITE(6,1002)FN 255 : C write(6,*)' GR' 256 : C WRITE(6,1002)GR 257 : C WRITE(6,101) 258 : 259 : RETURN 260 : 1002 FORMAT(10(1X,1PD11.4)) 261 : 1001 FORMAT(20(1X,I5)) 262 : 101 FORMAT(1X,'... SUBPB2103 ... FM,GM,FN,GR ',9(10H..........)/) 263 : C 264 : END 265 : 266 : 267 : 268 : 269 : 270 : 271 : 272 :
© Cast3M 2003 - All rights reserved.
Disclaimer