1 : C PB342 SOURCE CHAT 05/01/13 02:10:18 5004 2 : SUBROUTINE PB342(X,Y,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 CALCULE LES FONCTIONS DE FORME D'UN : iso-P2 P1/P0 8 : C 9 : C ^ eta 10 : C |n5 11 : C |\ 12 : C | \ 13 : C |3x\ 14 : C | \ 15 : C n6_____\n4 16 : C a |\ |\ 17 : C | \4 | \ a=sqrt(2) 18 : C |1x\ |2x\ 19 : C |___\|___\_______________>ksi 20 : C 0 a/2 a 21 : C n1 n2 n3 22 : C 23 : C 24 : C************************************************************************ 25 : 26 : REAL*8 X(NPG),Y(NPG) 27 : DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG) 28 : DIMENSION FM(MP,NPG),GM(ND,MP,NPG) 29 : REAL*8 A,B,C,D,U(5),H(5) 30 : CHARACTER*4 NOM2 31 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 32 : C write(6,*)' PB342 NOM2=',NOM2 33 : 34 : NP2=NP*ND 35 : A=SQRT(2.D0) 36 : R2=SQRT(2.D0) 37 : A1=6.D0/5.D0/A 38 : AI=1.D0/A 39 : 40 : IF(NPG.NE.7)THEN 41 : WRITE(6,*)' Sub PB342 NPG ne 7 ?! on ne sait pas faire ' 42 : STOP 43 : ENDIF 44 : 45 : C write(6,*)' MP,NPG=',mp,npg 46 : 46 : CALL CALUHH(X,Y,PG,NPG) 47 : DO 1 L=1,4 48 : C write(6,*)' X,Y,L=',X(L),Y(L),L 49 : C 50 : FN(1,L)=0.D0 51 : GR(1,1,L)=0.D0 52 : GR(2,1,L)=0.D0 53 : 54 : FN(2,L)=(A-2.D0*Y(L))/A 55 : GR(1,2,L)=0.D0 56 : GR(2,2,L)=-2.D0/A 57 : 58 : FN(3,L)=0.D0 59 : GR(1,3,L)=0.D0 60 : GR(2,3,L)=0.D0 61 : 62 : FN(4,L)=(2.D0*X(L)+2.D0*Y(L)-A)/A 63 : GR(1,4,L)=2.D0/A 64 : GR(2,4,L)=2.D0/A 65 : 66 : FN(5,L)=0.D0 67 : GR(1,5,L)=0.D0 68 : GR(2,5,L)=0.D0 69 : 70 : FN(6,L)=-(2.D0*X(L)-A)/A 71 : GR(1,6,L)=-2.D0/A 72 : GR(2,6,L)=0.D0 73 : 74 : IF(NOM2.EQ.'MCP0')THEN 75 : FM(1,L)=1.D0 76 : GM(1,1,L)=0.D0 77 : GM(2,1,L)=0.D0 78 : ELSEIF(NOM2.EQ.'MCP1')THEN 79 : FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L))) 80 : FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A)) 81 : FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A)) 82 : GM(1,1,L)=0.D0 83 : GM(2,1,L)=0.D0 84 : GM(1,2,L)=0.D0 85 : GM(2,2,L)=0.D0 86 : GM(1,3,L)=0.D0 87 : GM(2,3,L)=0.D0 88 : ELSEIF(NOM2.EQ.'MCF1')THEN 89 : FM(1,L)=-AI*(X(L)+Y(L)-A) 90 : FM(2,L)=AI*X(L) 91 : FM(3,L)=AI*Y(L) 92 : 93 : GM(1,1,L)=-R2/2.D0 94 : GM(2,1,L)=-R2/2.D0 95 : GM(1,2,L)=R2/2.D0 96 : GM(2,2,L)=0.D0 97 : GM(1,3,L)=0.D0 98 : GM(2,3,L)=R2/2.D0 99 : ENDIF 100 : 101 : C 102 : 1 CONTINUE 103 : 104 : C**** L=5 **** 105 : L=5 106 : C write(6,*)' X,Y,L=',X(L),Y(L),L 107 : 108 : FN(1,L)=-(2.D0*X(L)+2.D0*Y(L)-A)/A 109 : GR(1,1,L)=-2.D0/A 110 : GR(2,1,L)=-2.D0/A 111 : 112 : FN(2,L)=2.D0*X(L)/A 113 : GR(1,2,L)=2.D0/A 114 : GR(2,2,L)=0.D0 115 : 116 : FN(3,L)=0.D0 117 : GR(1,3,L)=0.D0 118 : GR(2,3,L)=0.D0 119 : 120 : FN(4,L)=0.D0 121 : GR(1,4,L)=0.D0 122 : GR(2,4,L)=0.D0 123 : 124 : FN(5,L)=0.D0 125 : GR(1,5,L)=0.D0 126 : GR(2,5,L)=0.D0 127 : 128 : FN(6,L)=2.D0*Y(L)/A 129 : GR(1,6,L)=0.D0 130 : GR(2,6,L)=2.D0/A 131 : 132 : IF(NOM2.EQ.'MCP0')THEN 133 : FM(1,L)=1.D0 134 : GM(1,1,L)=0.D0 135 : GM(2,1,L)=0.D0 136 : ELSEIF(NOM2.EQ.'MCP1')THEN 137 : FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L))) 138 : FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A)) 139 : FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A)) 140 : GM(1,1,L)=0.D0 141 : GM(2,1,L)=0.D0 142 : GM(1,2,L)=0.D0 143 : GM(2,2,L)=0.D0 144 : GM(1,3,L)=0.D0 145 : GM(2,3,L)=0.D0 146 : ELSEIF(NOM2.EQ.'MCF1')THEN 147 : FM(1,L)=-AI*(X(L)+Y(L)-A) 148 : FM(2,L)=AI*X(L) 149 : FM(3,L)=AI*Y(L) 150 : 151 : GM(1,1,L)=-R2/2.D0 152 : GM(2,1,L)=-R2/2.D0 153 : GM(1,2,L)=R2/2.D0 154 : GM(2,2,L)=0.D0 155 : GM(1,3,L)=0.D0 156 : GM(2,3,L)=R2/2.D0 157 : ENDIF 158 : 159 : 160 : C**** L=6 **** 161 : L=6 162 : C write(6,*)' X,Y,L=',X(L),Y(L),L 163 : 164 : FN(1,L)=0.D0 165 : GR(1,1,L)=0.D0 166 : GR(2,1,L)=0.D0 167 : 168 : FN(2,L)=-2.D0*(X(L)+Y(L)-A)/A 169 : GR(1,2,L)=-2.D0/A 170 : GR(2,2,L)=-2.D0/A 171 : 172 : FN(3,L)=(2.D0*X(L)-A)/A 173 : GR(1,3,L)=2.D0/A 174 : GR(2,3,L)=0.D0 175 : 176 : FN(4,L)=2.D0*Y(L)/A 177 : GR(1,4,L)=0.D0 178 : GR(2,4,L)=2.D0/A 179 : 180 : FN(5,L)=0.D0 181 : GR(1,5,L)=0.D0 182 : GR(2,5,L)=0.D0 183 : 184 : FN(6,L)=0.D0 185 : GR(1,6,L)=0.D0 186 : GR(2,6,L)=0.D0 187 : 188 : IF(NOM2.EQ.'MCP0')THEN 189 : FM(1,L)=1.D0 190 : GM(1,1,L)=0.D0 191 : GM(2,1,L)=0.D0 192 : ELSEIF(NOM2.EQ.'MCP1')THEN 193 : FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L))) 194 : FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A)) 195 : FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A)) 196 : GM(1,1,L)=0.D0 197 : GM(2,1,L)=0.D0 198 : GM(1,2,L)=0.D0 199 : GM(2,2,L)=0.D0 200 : GM(1,3,L)=0.D0 201 : GM(2,3,L)=0.D0 202 : ELSEIF(NOM2.EQ.'MCF1')THEN 203 : FM(1,L)=-AI*(X(L)+Y(L)-A) 204 : FM(2,L)=AI*X(L) 205 : FM(3,L)=AI*Y(L) 206 : 207 : GM(1,1,L)=-R2/2.D0 208 : GM(2,1,L)=-R2/2.D0 209 : GM(1,2,L)=R2/2.D0 210 : GM(2,2,L)=0.D0 211 : GM(1,3,L)=0.D0 212 : GM(2,3,L)=R2/2.D0 213 : ENDIF 214 : 215 : 216 : C**** L=7 **** 217 : L=7 218 : C write(6,*)' X,Y,L=',X(L),Y(L),L 219 : 220 : FN(1,L)=0.D0 221 : GR(1,1,L)=0.D0 222 : GR(2,1,L)=0.D0 223 : 224 : FN(2,L)=0.D0 225 : GR(1,2,L)=0.D0 226 : GR(2,2,L)=0.D0 227 : 228 : FN(3,L)=0.D0 229 : GR(1,3,L)=0.D0 230 : GR(2,3,L)=0.D0 231 : 232 : FN(4,L)=2.D0*X(L)/A 233 : GR(1,4,L)=2.D0/A 234 : GR(2,4,L)=0.D0 235 : 236 : FN(5,L)=(2.D0*Y(L)-A)/A 237 : GR(1,5,L)=0.D0 238 : GR(2,5,L)=2.D0/A 239 : 240 : FN(6,L)=-2.D0*(X(L)+Y(L)-A)/A 241 : GR(1,6,L)=-2.D0/A 242 : GR(2,6,L)=-2.D0/A 243 : 244 : IF(NOM2.EQ.'MCP0')THEN 245 : FM(1,L)=1.D0 246 : GM(1,1,L)=0.D0 247 : GM(2,1,L)=0.D0 248 : ELSEIF(NOM2.EQ.'MCP1')THEN 249 : FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L))) 250 : FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A)) 251 : FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A)) 252 : GM(1,1,L)=0.D0 253 : GM(2,1,L)=0.D0 254 : GM(1,2,L)=0.D0 255 : GM(2,2,L)=0.D0 256 : GM(1,3,L)=0.D0 257 : GM(2,3,L)=0.D0 258 : ELSEIF(NOM2.EQ.'MCF1')THEN 259 : FM(1,L)=-AI*(X(L)+Y(L)-A) 260 : FM(2,L)=AI*X(L) 261 : FM(3,L)=AI*Y(L) 262 : 263 : GM(1,1,L)=-R2/2.D0 264 : GM(2,1,L)=-R2/2.D0 265 : GM(1,2,L)=R2/2.D0 266 : GM(2,2,L)=0.D0 267 : GM(1,3,L)=0.D0 268 : GM(2,3,L)=R2/2.D0 269 : ENDIF 270 : 271 : 272 : C WRITE(6,101) 273 : C WRITE(6,1002)FM 274 : C WRITE(6,1002)GM 275 : C WRITE(6,1002)FN 276 : C WRITE(6,1002)GR 277 : C WRITE(6,101) 278 : RETURN 279 : 1002 FORMAT(10(1X,1PD11.4)) 280 : 1001 FORMAT(20(1X,I5)) 281 : 101 FORMAT(1X,'... SUBPB302 ... FM,GM,FN,GR ',9(10H..........)/) 282 : C 283 : END 284 : 285 : 286 : 287 : 288 : 289 :
© Cast3M 2003 - All rights reserved.
Disclaimer