1 : C PB2703 SOURCE MAGN 10/05/31 21:15:15 6679 2 : SUBROUTINE PB2703(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 : CU27 8 : C % eta 9 : C / 10 : C ^ zeta 11 : C | 19_______18______17 12 : C | / . / | 13 : C | / . / | 14 : C | 20.......26..... 16 | 15 : C | / .. / | 16 : C | / . . / | 17 : C 1. 13______14______15 | 18 : C | | . | | 19 : C | .12.....23.|......11 20 : C | . | D . . | .| 21 : C | . | .. B | . | 22 : C | 24 ......27...|..22 | 23 : C | . | .. | . | 24 : C |. | . . |. | 25 : C 9........21......10 C | 26 : C | 7______6__|______5 27 : C | / .. | / 28 : C | / . | / 29 : C | 8......25....|...4 30 : C | / . | / 31 : C | / A . | / 32 : C |/_______________|/____>ksi 33 : C 1 2 3 34 : C 0. 1. 35 : C 36 : C 37 : C 38 : C************************************************************************ 39 : REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG) 40 : PARAMETER (NPG1=5,NPG2=NPG1*NPG1) 41 : REAL*8 X1(NPG1),PG1(NPG1) 42 : REAL*8 X2(NPG2),Y2(NPG2),PG2(NPG2) 43 : CHARACTER NOM2*4 44 : DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG) 45 : DIMENSION F2N(9,NPG2),G2R(2,9,NPG2) 46 : DIMENSION FM(MP,NPG),GM(ND,MP,NPG) 47 : DIMENSION U(5),H(5),XA(3),XB(3),XC(3),XD(3),XX(3) 48 : DIMENSION I12(27) 49 : * SAVE XA,XB,XC,XD,I12 50 : DATA XA/3*0.25D0/,XB/0.75D0,0.25D0,0.75D0/ 51 : DATA XC/2*0.75D0,0.25D0/,XD/0.25D0,2*0.75D0/ 52 : DATA I12/1,2,3,4,5,6,7,8,25,9,21,10,22,11,23,12,24,27,13,14,15,16, 53 : & 17,18,19,20,26/ 54 : C*** 55 : XREF(1,1)=0.D0 56 : XREF(2,1)=0.D0 57 : XREF(3,1)=0.D0 58 : 59 : XREF(1,2)=0.5D0 60 : XREF(2,2)=0.D0 61 : XREF(3,2)=0.D0 62 : 63 : XREF(1,3)=1.D0 64 : XREF(2,3)=0.D0 65 : XREF(3,3)=0.D0 66 : 67 : XREF(1,4)=1.D0 68 : XREF(2,4)=0.5D0 69 : XREF(3,4)=0.D0 70 : 71 : XREF(1,5)=1.D0 72 : XREF(2,5)=1.D0 73 : XREF(3,5)=0.D0 74 : 75 : XREF(1,6)=0.5D0 76 : XREF(2,6)=1.D0 77 : XREF(3,6)=0.D0 78 : 79 : XREF(1,7)=0.D0 80 : XREF(2,7)=1.D0 81 : XREF(3,7)=0.D0 82 : 83 : XREF(1,8)=0.D0 84 : XREF(2,8)=0.5D0 85 : XREF(3,8)=0.D0 86 : 87 : XREF(1,13)=0.D0 88 : XREF(2,13)=0.D0 89 : XREF(3,13)=1.D0 90 : 91 : XREF(1,14)=0.5D0 92 : XREF(2,14)=0.D0 93 : XREF(3,14)=1.D0 94 : 95 : XREF(1,15)=1.D0 96 : XREF(2,15)=0.D0 97 : XREF(3,15)=1.D0 98 : 99 : XREF(1,16)=1.D0 100 : XREF(2,16)=0.5D0 101 : XREF(3,16)=1.D0 102 : 103 : XREF(1,17)=1.D0 104 : XREF(2,17)=1.D0 105 : XREF(3,17)=1.D0 106 : 107 : XREF(1,18)=0.5D0 108 : XREF(2,18)=1.D0 109 : XREF(3,18)=1.D0 110 : 111 : XREF(1,19)=0.D0 112 : XREF(2,19)=1.D0 113 : XREF(3,19)=1.D0 114 : 115 : XREF(1,20)=0.D0 116 : XREF(2,20)=0.5D0 117 : XREF(3,20)=1.D0 118 : 119 : XREF(1,9)=0.D0 120 : XREF(2,9)=0.D0 121 : XREF(3,9)=0.5D0 122 : 123 : XREF(1,10)=1.D0 124 : XREF(2,10)=0.D0 125 : XREF(3,10)=0.5D0 126 : 127 : XREF(1,11)=1.D0 128 : XREF(2,11)=1.D0 129 : XREF(3,11)=0.5D0 130 : 131 : XREF(1,12)=0.D0 132 : XREF(2,12)=1.D0 133 : XREF(3,12)=0.5D0 134 : 135 : XREF(1,21)=0.5D0 136 : XREF(2,21)=0.D0 137 : XREF(3,21)=0.5D0 138 : 139 : XREF(1,22)=1.D0 140 : XREF(2,22)=0.5D0 141 : XREF(3,22)=0.5D0 142 : 143 : XREF(1,23)=0.5D0 144 : XREF(2,23)=1.D0 145 : XREF(3,23)=0.5D0 146 : 147 : XREF(1,24)=0.D0 148 : XREF(2,24)=0.5D0 149 : XREF(3,24)=0.5D0 150 : 151 : XREF(1,25)=0.5D0 152 : XREF(2,25)=0.5D0 153 : XREF(3,25)=0.D0 154 : 155 : XREF(1,26)=0.5D0 156 : XREF(2,26)=0.5D0 157 : XREF(3,26)=1.D0 158 : 159 : XREF(1,27)=0.5D0 160 : XREF(2,27)=0.5D0 161 : XREF(3,27)=0.5D0 162 : 163 : 163 : CALL CALUHG(U,H,NG) 164 : C 165 : NG2=NG*NG 166 : IF(NG2.GT.25)RETURN 167 : 168 : A=0.D0 169 : B=1.D0 170 : C=0.D0 171 : D=1.D0 172 : E=0.D0 173 : F=1.D0 173 : CALL CALG2(A,B,C,D,NG,H,U,X2,Y2,PG2) 173 : CALL CALG1(E,F,NG,H,U,X1,PG1) 174 : 175 : LL=0 176 : DO 1 L=1,NG2 177 : DO 2 L1=1,NG 178 : LL=LL+1 179 : X(L)=X2(L) 180 : Y(L)=Y2(L) 181 : Z(L)=X1(L1) 182 : PG(LL)=PG1(L1)*PG2(L) 183 : C? write(6,*)'LL=',LL,X(L),Y(L),Z(L) 184 : C 185 : XX(1)=X(L) 186 : XX(2)=Y(L) 187 : XX(3)=Z(L) 188 : 189 : IF(NOM2.EQ.'PRP0')THEN 190 : FM(1,LL)=1.D0 190 : CALL INITD(GM,(3*NPG),0.D0) 191 : ELSEIF(NOM2.EQ.'PRP1')THEN 192 : FM(1,LL)=EQPL3P(XX,XB,XC,XD)/ 193 : & EQPL3P(XA,XB,XC,XD) 194 : FM(2,LL)=EQPL3P(XX,XA,XC,XD)/ 195 : & EQPL3P(XB,XA,XC,XD) 196 : FM(3,LL)=EQPL3P(XX,XA,XB,XD)/ 197 : & EQPL3P(XC,XA,XB,XD) 198 : FM(4,LL)=EQPL3P(XX,XA,XB,XC)/ 199 : & EQPL3P(XD,XA,XB,XC) 199 : CALL INITD(GM,(12*NPG),0.D0) 200 : ELSEIF(NOM2.EQ.'PFP1')THEN 201 : FM(1,LL)=-(X(L)-1.D0)*(Y(L)-1.D0)*(Z(L)-1.D0) 202 : FM(2,LL)=X(L)*(Y(L)-1.D0)*(Z(L)-1.D0) 203 : FM(3,LL)=-X(L)*Y(L)*(Z(L)-1.D0) 204 : FM(4,LL)=(X(L)-1.D0)*Y(L)*(Z(L)-1.D0) 205 : FM(5,LL)=(X(L)-1.D0)*(Y(L)-1.D0)*Z(L) 206 : FM(6,LL)=-X(L)*(Y(L)-1.D0)*Z(L) 207 : FM(7,LL)=X(L)*Y(L)*Z(L) 208 : FM(8,LL)=-(X(L)-1.D0)*Y(L)*Z(L) 209 : 210 : GM(1,1,LL)=-(Y(L)-1.D0)*(Z(L)-1.D0) 211 : GM(2,1,LL)=-(X(L)-1.D0)*(Z(L)-1.D0) 212 : GM(3,1,LL)=-(X(L)-1.D0)*(Y(L)-1.D0) 213 : C 214 : GM(1,2,LL)=(Y(L)-1.D0)*(Z(L)-1.D0) 215 : GM(2,2,LL)=X(L)*(Z(L)-1.D0) 216 : GM(3,2,LL)=X(L)*(Y(L)-1.D0) 217 : C 218 : GM(1,3,LL)=-Y(L)*(Z(L)-1.D0) 219 : GM(2,3,LL)=-X(L)*(Z(L)-1.D0) 220 : GM(3,3,LL)=-X(L)*Y(L) 221 : C 222 : GM(1,4,LL)=Y(L)*(Z(L)-1.D0) 223 : GM(2,4,LL)=(X(L)-1.D0)*(Z(L)-1.D0) 224 : GM(3,4,LL)=(X(L)-1.D0)*Y(L) 225 : C 226 : GM(1,5,LL)=(Y(L)-1.D0)*Z(L) 227 : GM(2,5,LL)=(X(L)-1.D0)*Z(L) 228 : GM(3,5,LL)=(X(L)-1.D0)*(Y(L)-1.D0) 229 : C 230 : GM(1,6,LL)=-(Y(L)-1.D0)*Z(L) 231 : GM(2,6,LL)=-X(L)*Z(L) 232 : GM(3,6,LL)=-X(L)*(Y(L)-1.D0) 233 : C 234 : GM(1,7,LL)=Y(L)*Z(L) 235 : GM(2,7,LL)=X(L)*Z(L) 236 : GM(3,7,LL)=X(L)*Y(L) 237 : C 238 : GM(1,8,LL)=-Y(L)*Z(L) 239 : GM(2,8,LL)=-(X(L)-1.D0)*Z(L) 240 : GM(3,8,LL)=-(X(L)-1.D0)*Y(L) 241 : C 242 : ENDIF 243 : 244 : C 245 : F2N(1,L)=(X(L)-1.D0)*(Y(L)-1.D0)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0) 246 : F2N(2,L)=-4.D0*X(L)*(X(L)-1.D0)*(2.D0*Y(L)-1.D0)*(Y(L)-1.D0) 247 : F2N(3,L)=X(L)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)*(Y(L)-1.D0) 248 : F2N(4,L)=-4.D0*X(L)*Y(L)*(2.D0*X(L)-1.D0)*(Y(L)-1.D0) 249 : F2N(5,L)=X(L)*Y(L)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0) 250 : F2N(6,L)=-4.D0*X(L)*Y(L)*(X(L)-1.D0)*(2.D0*Y(L)-1.D0) 251 : F2N(7,L)=Y(L)*(2.D0*Y(L)-1.D0)*(2.D0*X(L)-1.D0)*(X(L)-1.D0) 252 : F2N(8,L)=-4.D0*Y(L)*(Y(L)-1.D0)*(X(L)-1.D0)*(2.D0*X(L)-1.D0) 253 : F2N(9,L)=16.D0*X(L)*Y(L)*(X(L)-1.D0)*(Y(L)-1.D0) 254 : C 255 : G2R(1,1,L)=(Y(L)-1.D0)*(2.D0*Y(L)-1.D0)*(4.D0*X(L)-3.D0) 256 : G2R(2,1,L)=(X(L)-1.D0)*(2.D0*X(L)-1.D0)*(4.D0*Y(L)-3.D0) 257 : G2R(1,2,L)=-4.D0*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)*(Y(L)-1.D0) 258 : G2R(2,2,L)=-4.D0*X(L)*(X(L)-1.D0)*(4.D0*Y(L)-3.D0) 259 : G2R(1,3,L)=(2.D0*Y(L)-1.D0)*(Y(L)-1.D0)*(4.D0*X(L)-1.D0) 260 : G2R(2,3,L)=X(L)*(2.D0*X(L)-1.D0)*(4.D0*Y(L)-3.D0) 261 : G2R(1,4,L)=-4.D0*Y(L)*(Y(L)-1.D0)*(4.D0*X(L)-1.D0) 262 : G2R(2,4,L)=-4.D0*X(L)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0) 263 : G2R(1,5,L)=Y(L)*(2.D0*Y(L)-1.D0)*(4.D0*X(L)-1.D0) 264 : G2R(2,5,L)=X(L)*(2.D0*X(L)-1.D0)*(4.D0*Y(L)-1.D0) 265 : G2R(1,6,L)=-4.D0*Y(L)*(2.D0*Y(L)-1.D0)*(2.D0*X(L)-1.D0) 266 : G2R(2,6,L)=-4.D0*X(L)*(X(L)-1.D0)*(4.D0*Y(L)-1.D0) 267 : G2R(1,7,L)=Y(L)*(2.D0*Y(L)-1.D0)*(4.D0*X(L)-3.D0) 268 : G2R(2,7,L)=(2.D0*X(L)-1.D0)*(X(L)-1.D0)*(4.D0*Y(L)-1.D0) 269 : G2R(1,8,L)=-4.D0*Y(L)*(Y(L)-1.D0)*(4.D0*X(L)-3.D0) 270 : G2R(2,8,L)=-4.D0*(X(L)-1.D0)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0) 271 : G2R(1,9,L)=16.D0*Y(L)*(Y(L)-1.D0)*(2.D0*X(L)-1.D0) 272 : G2R(2,9,L)=16.D0*X(L)*(X(L)-1.D0)*(2.D0*Y(L)-1.D0) 273 : 274 : DO 111 I=1,9 275 : I1=I12(I) 276 : I9=I12(I+9) 277 : I18=I12(I+18) 278 : FN(I1,LL)=F2N(I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0) 279 : FN(I9,LL)=F2N(I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0) 280 : FN(I18,LL)=F2N(I,L)*Z(L)*(2.D0*Z(L)-1.D0) 281 : 282 : GR(1,I1,LL)=G2R(1,I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0) 283 : GR(2,I1,LL)=G2R(2,I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0) 284 : GR(3,I1,LL)=F2N(I,L)*(4.D0*Z(L)-3.D0) 285 : 286 : GR(1,I9,LL)=G2R(1,I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0) 287 : GR(2,I9,LL)=G2R(2,I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0) 288 : GR(3,I9,LL)=F2N(I,L)*(-8.D0*Z(L)+4.D0) 289 : 290 : GR(1,I18,LL)=G2R(1,I,L)*Z(L)*(2.D0*Z(L)-1.D0) 291 : GR(2,I18,LL)=G2R(2,I,L)*Z(L)*(2.D0*Z(L)-1.D0) 292 : GR(3,I18,LL)=F2N(I,L)*(4.D0*Z(L)-1.D0) 293 : 294 : 111 CONTINUE 295 : C 296 : 2 CONTINUE 297 : 1 CONTINUE 298 : 299 : C 300 : C WRITE(6,101) 301 : C WRITE(6,*)' FM ' 302 : C WRITE(6,1002)FM 303 : C WRITE(6,*)' X ' 304 : C WRITE(6,1008)X 305 : C WRITE(6,*)' Y ' 306 : C WRITE(6,1008)Y 307 : C WRITE(6,*)' Z ' 308 : C WRITE(6,1008)Z 309 : C WRITE(6,*)' GM ' 310 : C WRITE(6,1002)GM 311 : C WRITE(6,*)' F2N' 312 : C WRITE(6,1002)F2N 313 : 314 : C WRITE(6,*)' GR' 315 : C do 8705 l=1,npg 316 : C write(6,*)' l=',l 317 : C WRITE(6,1002)((GR(i,j,l),i=1,nd),j=1,np) 318 : C8705 continue 319 : C WRITE(6,101) 320 : 321 : C write(6,*)' RET PB2703 ' 322 : RETURN 323 : 1002 FORMAT(10(1X,1PD11.4)) 324 : 1008 FORMAT( 8(1X,1PD11.4)) 325 : 1001 FORMAT(20(1X,I5)) 326 : 101 FORMAT(1X,'... SUBPB2703 ... FM,GM,F2N,GR ',9(10H..........)/) 327 : C 328 : END 329 : 330 : 331 : 332 : 333 : 334 : 335 : 336 :
© Cast3M 2003 - All rights reserved.
Disclaimer