1 : C PB442 SOURCE CHAT 05/01/13 02:10:35 5004 2 : SUBROUTINE PB442(X,Y,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 : Iso-Q2 (P1/P0) 8 : C 9 : C ^ eta 10 : C | 11 : C 1 n7_____n6_______ n5 12 : C | | | 13 : C | x x | x x | 14 : C | x 4 x | x 3 x | 15 : C 1/2|_______|_______|n4 16 : C |n8 |n9 | 17 : C | x x | x x | 18 : C | x 1 x | x 2 x | 19 : C |_______|_______|______>ksi 20 : C 0 1/2 1 21 : C n1 n2 n3 22 : C************************************************************************ 23 : 24 : REAL*8 X(NPG),Y(NPG) 25 : REAL*8 FN(NP,NPG),GR(ND,NP,NPG),PG(NPG) 26 : REAL*8 FM(MP,NPG),GM(ND,MP,NPG) 27 : REAL*8 A,B,C,D,U(6),H(6) 28 : CHARACTER*4 NOM2 29 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 30 : C NPG=16 !!! NG=2 !!! 31 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 32 : 32 : CALL CALUHG(U,H,NG) 33 : 34 : C OMEGA 1 35 : 36 : A=0.D0 37 : B=0.5D0 38 : C=0.D0 39 : D=0.5D0 39 : CALL CALG2(A,B,C,D,NG,H,U,X,Y,PG) 40 : 41 : DO 1 L=1,4 42 : C 43 : FN(1,L)=(1.D0-2.D0*X(L))*(1.D0-2.D0*Y(L)) 44 : GR(1,1,L)=-2.D0*(1.D0-2.D0*Y(L)) 45 : GR(2,1,L)=-2.D0*(1.D0-2.D0*X(L)) 46 : 47 : FN(2,L)=2.D0*X(L)*(1.D0-2.D0*Y(L)) 48 : GR(1,2,L)=2.D0*(1.D0-2.D0*Y(L)) 49 : GR(2,2,L)=-4.D0*X(L) 50 : 51 : FN(3,L)=0.D0 52 : GR(1,3,L)=0.D0 53 : GR(2,3,L)=0.D0 54 : 55 : FN(4,L)=0.D0 56 : GR(1,4,L)=0.D0 57 : GR(2,4,L)=0.D0 58 : 59 : FN(5,L)=0.D0 60 : GR(1,5,L)=0.D0 61 : GR(2,5,L)=0.D0 62 : 63 : FN(6,L)=0.D0 64 : GR(1,6,L)=0.D0 65 : GR(2,6,L)=0.D0 66 : 67 : FN(7,L)=0.D0 68 : GR(1,7,L)=0.D0 69 : GR(2,7,L)=0.D0 70 : 71 : FN(8,L)=2.D0*Y(L)*(1.D0-2.D0*X(L)) 72 : GR(1,8,L)=-4.D0*Y(L) 73 : GR(2,8,L)=2.D0*(1.D0-2.D0*X(L)) 74 : 75 : FN(9,L)=4.D0*X(L)*Y(L) 76 : GR(1,9,L)=4.D0*Y(L) 77 : GR(2,9,L)=4.D0*X(L) 78 : 79 : C 80 : IF(NOM2.EQ.'MCP0')THEN 81 : FM(1,L)=1.D0 82 : GM(1,1,L)=0.D0 83 : GM(2,1,L)=0.D0 84 : ELSEIF(NOM2.EQ.'MCP1')THEN 85 : FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0) 86 : FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0) 87 : FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0) 88 : ELSEIF(NOM2.EQ.'MCF1')THEN 89 : FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0) 90 : FM(2,L)=-X(L)*(Y(L)-1.D0) 91 : FM(3,L)= X(L)*Y(L) 92 : FM(4,L)=-Y(L)*(X(L)-1.D0) 93 : 94 : GM(1,1,L)=Y(L)-1.D0 95 : GM(2,1,L)=X(L)-1.D0 96 : GM(1,2,L)=-(Y(L)-1.D0) 97 : GM(2,2,L)=-X(L) 98 : GM(1,3,L)=Y(L) 99 : GM(2,3,L)=X(L) 100 : GM(1,4,L)=-Y(L) 101 : GM(2,4,L)=-(X(L)-1.D0) 102 : ENDIF 103 : 104 : 1 CONTINUE 105 : 106 : C OMEGA 2 107 : 108 : A=0.5D0 109 : B=1.D0 110 : C=0.D0 111 : D=0.5D0 111 : CALL CALG2(A,B,C,D,NG,H,U,X(5),Y(5),PG(5)) 112 : 113 : DO 2 L=5,8 114 : C 115 : FN(1,L)=0.D0 116 : GR(1,1,L)=0.D0 117 : GR(2,1,L)=0.D0 118 : 119 : FN(2,L)=2.D0*(1.D0-X(L))*(1.D0-2.D0*Y(L)) 120 : GR(1,2,L)=-2.D0*(1.D0-2.D0*Y(L)) 121 : GR(2,2,L)=-4.D0*(1.D0-X(L)) 122 : 123 : FN(3,L)=-(1.D0-2.D0*X(L))*(1.D0-2.D0*Y(L)) 124 : GR(1,3,L)=2.D0*(1.D0-2.D0*Y(L)) 125 : GR(2,3,L)=2.D0*(1.D0-2.D0*X(L)) 126 : 127 : FN(4,L)=-2.D0*Y(L)*(1.D0-2.D0*X(L)) 128 : GR(1,4,L)=4.D0*Y(L) 129 : GR(2,4,L)=-2.D0*(1.D0-2.D0*X(L)) 130 : 131 : FN(5,L)=0.D0 132 : GR(1,5,L)=0.D0 133 : GR(2,5,L)=0.D0 134 : 135 : FN(6,L)=0.D0 136 : GR(1,6,L)=0.D0 137 : GR(2,6,L)=0.D0 138 : 139 : FN(7,L)=0.D0 140 : GR(1,7,L)=0.D0 141 : GR(2,7,L)=0.D0 142 : 143 : FN(8,L)=0.D0 144 : GR(1,8,L)=0.D0 145 : GR(2,8,L)=0.D0 146 : 147 : FN(9,L)=4.D0*(1.D0-X(L))*Y(L) 148 : GR(1,9,L)=-4.D0*Y(L) 149 : GR(2,9,L)=4.D0*(1.D0-X(L)) 150 : 151 : C 152 : IF(NOM2.EQ.'MCP0')THEN 153 : FM(1,L)=1.D0 154 : GM(1,1,L)=0.D0 155 : GM(2,1,L)=0.D0 156 : ELSEIF(NOM2.EQ.'MCP1')THEN 157 : FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0) 158 : FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0) 159 : FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0) 160 : ELSEIF(NOM2.EQ.'MCF1')THEN 161 : FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0) 162 : FM(2,L)=-X(L)*(Y(L)-1.D0) 163 : FM(3,L)= X(L)*Y(L) 164 : FM(4,L)=-Y(L)*(X(L)-1.D0) 165 : 166 : GM(1,1,L)=Y(L)-1.D0 167 : GM(2,1,L)=X(L)-1.D0 168 : GM(1,2,L)=-(Y(L)-1.D0) 169 : GM(2,2,L)=-X(L) 170 : GM(1,3,L)=Y(L) 171 : GM(2,3,L)=X(L) 172 : GM(1,4,L)=-Y(L) 173 : GM(2,4,L)=-(X(L)-1.D0) 174 : ENDIF 175 : 176 : 2 CONTINUE 177 : 178 : C OMEGA 3 179 : 180 : A=0.5D0 181 : B=1.D0 182 : C=0.5D0 183 : D=1.D0 183 : CALL CALG2(A,B,C,D,NG,H,U,X(9),Y(9),PG(9)) 184 : 185 : DO 3 L=9,12 186 : C 187 : FN(1,L)=0.D0 188 : GR(1,1,L)=0.D0 189 : GR(2,1,L)=0.D0 190 : 191 : FN(2,L)=0.D0 192 : GR(1,2,L)=0.D0 193 : GR(2,2,L)=0.D0 194 : 195 : FN(3,L)=0.D0 196 : GR(1,3,L)=0.D0 197 : GR(2,3,L)=0.D0 198 : 199 : FN(4,L)=-2.D0*(1.D0-2.D0*X(L))*(1.D0-Y(L)) 200 : GR(1,4,L)=4.D0*(1.D0-Y(L)) 201 : GR(2,4,L)=2.D0*(1.D0-2.D0*X(L)) 202 : 203 : FN(5,L)=(1.D0-2.D0*X(L))*(1.D0-2.D0*Y(L)) 204 : GR(1,5,L)=-2.D0*(1.D0-2.D0*Y(L)) 205 : GR(2,5,L)=-2.D0*(1.D0-2.D0*X(L)) 206 : 207 : FN(6,L)=-2.D0*(1.D0-2.D0*Y(L))*(1.D0-X(L)) 208 : GR(1,6,L)=2.D0*(1.D0-2.D0*Y(L)) 209 : GR(2,6,L)=4.D0*(1.D0-X(L)) 210 : 211 : FN(7,L)=0.D0 212 : GR(1,7,L)=0.D0 213 : GR(2,7,L)=0.D0 214 : 215 : FN(8,L)=0.D0 216 : GR(1,8,L)=0.D0 217 : GR(2,8,L)=0.D0 218 : 219 : FN(9,L)=4.D0*(1.D0-X(L))*(1.D0-Y(L)) 220 : GR(1,9,L)=-4.D0*(1.D0-Y(L)) 221 : GR(2,9,L)=-4.D0*(1.D0-X(L)) 222 : 223 : C 224 : IF(NOM2.EQ.'MCP0')THEN 225 : FM(1,L)=1.D0 226 : GM(1,1,L)=0.D0 227 : GM(2,1,L)=0.D0 228 : ELSEIF(NOM2.EQ.'MCP1')THEN 229 : FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0) 230 : FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0) 231 : FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0) 232 : ELSEIF(NOM2.EQ.'MCF1')THEN 233 : FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0) 234 : FM(2,L)=-X(L)*(Y(L)-1.D0) 235 : FM(3,L)= X(L)*Y(L) 236 : FM(4,L)=-Y(L)*(X(L)-1.D0) 237 : 238 : GM(1,1,L)=Y(L)-1.D0 239 : GM(2,1,L)=X(L)-1.D0 240 : GM(1,2,L)=-(Y(L)-1.D0) 241 : GM(2,2,L)=-X(L) 242 : GM(1,3,L)=Y(L) 243 : GM(2,3,L)=X(L) 244 : GM(1,4,L)=-Y(L) 245 : GM(2,4,L)=-(X(L)-1.D0) 246 : ENDIF 247 : 248 : 3 CONTINUE 249 : 250 : C OMEGA 4 251 : 252 : A=0.D0 253 : B=0.5D0 254 : C=0.5D0 255 : D=1.D0 255 : CALL CALG2(A,B,C,D,NG,H,U,X(13),Y(13),PG(13)) 256 : 257 : DO 4 L=13,16 258 : C 259 : FN(1,L)=0.D0 260 : GR(1,1,L)=0.D0 261 : GR(2,1,L)=0.D0 262 : 263 : FN(2,L)=0.D0 264 : GR(1,2,L)=0.D0 265 : GR(2,2,L)=0.D0 266 : 267 : FN(3,L)=0.D0 268 : GR(1,3,L)=0.D0 269 : GR(2,3,L)=0.D0 270 : 271 : FN(4,L)=0.D0 272 : GR(1,4,L)=0.D0 273 : GR(2,4,L)=0.D0 274 : 275 : FN(5,L)=0.D0 276 : GR(1,5,L)=0.D0 277 : GR(2,5,L)=0.D0 278 : 279 : FN(6,L)=-2.D0*X(L)*(1.D0-2.D0*Y(L)) 280 : GR(1,6,L)=-2.D0*(1.D0-2.D0*Y(L)) 281 : GR(2,6,L)=4.D0*X(L) 282 : 283 : FN(7,L)=-(1.D0-2.D0*Y(L))*(1.D0-2.D0*X(L)) 284 : GR(1,7,L)=2.D0*(1.D0-2.D0*Y(L)) 285 : GR(2,7,L)=2.D0*(1.D0-2.D0*X(L)) 286 : 287 : FN(8,L)=2.D0*(1.D0-2.D0*X(L))*(1.D0-Y(L)) 288 : GR(1,8,L)=-4.D0*(1.D0-Y(L)) 289 : GR(2,8,L)=-2.D0*(1.D0-2.D0*X(L)) 290 : 291 : FN(9,L)=4.D0*X(L)*(1.D0-Y(L)) 292 : GR(1,9,L)=4.D0*(1.D0-Y(L)) 293 : GR(2,9,L)=-4.D0*X(L) 294 : 295 : C 296 : IF(NOM2.EQ.'MCP0')THEN 297 : FM(1,L)=1.D0 298 : GM(1,1,L)=0.D0 299 : GM(2,1,L)=0.D0 300 : ELSEIF(NOM2.EQ.'MCP1')THEN 301 : FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0) 302 : FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0) 303 : FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0) 304 : ELSEIF(NOM2.EQ.'MCF1')THEN 305 : FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0) 306 : FM(2,L)=-X(L)*(Y(L)-1.D0) 307 : FM(3,L)= X(L)*Y(L) 308 : FM(4,L)=-Y(L)*(X(L)-1.D0) 309 : 310 : GM(1,1,L)=Y(L)-1.D0 311 : GM(2,1,L)=X(L)-1.D0 312 : GM(1,2,L)=-(Y(L)-1.D0) 313 : GM(2,2,L)=-X(L) 314 : GM(1,3,L)=Y(L) 315 : GM(2,3,L)=X(L) 316 : GM(1,4,L)=-Y(L) 317 : GM(2,4,L)=-(X(L)-1.D0) 318 : ENDIF 319 : 320 : 4 CONTINUE 321 : 322 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 323 : C WRITE(6,*)'X' 324 : C WRITE(6,1002)X 325 : C WRITE(6,*)'Y' 326 : C WRITE(6,1002)Y 327 : C WRITE(6,*)'FN' 328 : C do 1782 l=1,4 329 : C WRITE(6,1002)FN(1,L),FN(2,L+4),FN(9,L+8),FN(8,L+12) 330 : C WRITE(6,1002)FN(2,L),FN(3,L+4),FN(4,L+8),FN(9,L+12) 331 : C WRITE(6,1002)FN(9,L),FN(4,L+4),FN(5,L+8),FN(6,L+12) 332 : C WRITE(6,1002)FN(8,L),FN(9,L+4),FN(6,L+8),FN(7,L+12) 333 : C1782 continue 334 : C WRITE(6,*)'GM' 335 : C WRITE(6,1002)GM 336 : C WRITE(6,*)'FM' 337 : C WRITE(6,1002)FM 338 : 339 : RETURN 340 : 1002 FORMAT(10(1X,1PE11.4)) 341 : 1001 FORMAT(20(1X,I5)) 342 : C 343 : END 344 : 345 : 346 : 347 : 348 : 349 :
© Cast3M 2003 - All rights reserved.
Disclaimer