1 : C FFQ SOURCE CHAT 05/01/12 23:59:09 5004 2 : SUBROUTINE FFQ(NOMS,XA,COOR,XG,IDIM,NP) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C************************************************************************ 6 : C 7 : C 8 : C 9 : C************************************************************************ 10 : DIMENSION FN(20),XA(3,27),COOR(3,NP),XG(3,NP) 11 : PARAMETER (NBE=18) 12 : CHARACTER*8 NOMS,LISTE(NBE) 13 : DATA LISTE/'SEG3 ','TRI6 ','QUA8 ','TRI7 ','QUA9 ', 14 : &'CU27 ','PR21 ','TE15 ','PY19 ', 15 : &'PR18 ','PY14 ', 16 : &'SEG4 ','TR12 ','QU16 ','CU64 ','PR48 ','TE32 ', 17 : &'PY57 '/ 18 : C 19 : R2=SQRT(2.D0) 20 : 20 : CALL OPTLI(IP,LISTE,NOMS,NBE) 21 : C write(6,*)' FFQ : IP=',ip,' NOMS=',noms,np 22 : IF(IP.EQ.0)RETURN 23 : GO TO (301,602,802,602,802,2703,2103,1503),IP 24 : 25 : 301 CONTINUE 26 : 27 : C SEG3 28 : DO 311 L=1,NP 29 : X=COOR(1,L) 30 : Y=COOR(2,L) 31 : 32 : C 33 : FN(1)=(X-0.5D0)*(X-1.D0) 34 : FN(2)=-2.D0*X*(X+Y-R2) 35 : FN(3)= X*(X-R2/2.D0) 36 : C 37 : DO 321 N=1,IDIM 38 : XG(N,L)=0.D0 39 : DO 331 I=1,3 40 : XG(N,L)=XG(N,L)+FN(I)*XA(N,I) 41 : 331 CONTINUE 42 : 321 CONTINUE 43 : 311 CONTINUE 44 : 45 : RETURN 46 : 47 : 48 : 49 : 602 CONTINUE 50 : C TRI6 51 : DO 612 L=1,NP 52 : X=COOR(1,L) 53 : Y=COOR(2,L) 54 : 55 : C 56 : FN(1)=(X+Y-R2/2.D0)*(X+Y-R2) 57 : FN(2)=-2.D0*X*(X+Y-R2) 58 : FN(3)= X*(X-R2/2.D0) 59 : FN(4)=2.D0*X*Y 60 : FN(5)= Y*(Y-R2/2.D0) 61 : FN(6)=-2.D0*Y*(X+Y-R2) 62 : C 63 : DO 622 N=1,IDIM 64 : XG(N,L)=0.D0 65 : DO 632 I=1,6 66 : XG(N,L)=XG(N,L)+FN(I)*XA(N,I) 67 : 632 CONTINUE 68 : 622 CONTINUE 69 : 612 CONTINUE 70 : 71 : RETURN 72 : 73 : 74 : 75 : 802 CONTINUE 76 : C QUA8 77 : DO 812 L=1,NP 78 : X=COOR(1,L) 79 : Y=COOR(2,L) 80 : C 81 : FN(1)=-2.D0*(1.D0-X)*(1.D0-Y)*(X+Y-0.5D0) 82 : FN(2)= 4.D0*X*(1.D0-X)*(1.D0-Y) 83 : FN(3)=-2.D0*X*(1.D0-Y)*(Y-X+0.5D0) 84 : FN(4)= 4.D0*X*Y*(1.D0-Y) 85 : FN(5)= 2.D0*X*Y*(X+Y-1.5D0) 86 : FN(6)= 4.D0*X*Y*(1.D0-X) 87 : FN(7)= 2.D0*Y*(1.D0-X)*(Y-X-0.5D0) 88 : FN(8)= 4.D0*Y*(1.D0-X)*(1.D0-Y) 89 : C 90 : DO 822 N=1,IDIM 91 : XG(N,L)=0.D0 92 : DO 832 I=1,8 93 : XG(N,L)=XG(N,L)+FN(I)*XA(N,I) 94 : 832 CONTINUE 95 : 822 CONTINUE 96 : 812 CONTINUE 97 : RETURN 98 : 99 : 2703 CONTINUE 100 : C CU27 -> On ne prend que les 20 premiers points correspondant au CU20 101 : DO 2712 L=1,NP 102 : X=COOR(1,L) 103 : Y=COOR(2,L) 104 : Z=COOR(3,L) 105 : C 106 : FN(1)=-2.D0*(1.D0-X)*(1.D0-Y)*(1.D0-Z)*(X+Y+Z-0.5D0) 107 : FN(2)= 4.D0*X*(1.D0-X)*(1.D0-Y)*(1.D0-Z) 108 : FN(3)=-2.D0*X*(1.D0-Y)*(1.D0-Z)*(Y-X+Z+0.5D0) 109 : FN(4)= 4.D0*X*Y*(1.D0-Y)*(1.D0-Z) 110 : FN(5)=-2.D0*X*Y*(1.D0-Z)*(1.5D0-X-Y+Z) 111 : FN(6)= 4.D0*X*Y*(1.D0-X)*(1.D0-Z) 112 : FN(7)=-2.D0*Y*(1.D0-X)*(1.D0-Z)*(0.5D0+X-Y+Z) 113 : FN(8)= 4.D0*Y*(1.D0-X)*(1.D0-Y)*(1.D0-Z) 114 : FN(9)= 4.D0*Z*(1.D0-Z)*(1.D0-X)*(1.D0-Y) 115 : FN(10)= 4.D0*X*Z*(1.D0-Z)*(1.D0-Y) 116 : FN(11)= 4.D0*X*Y*Z*(1.D0-Z) 117 : FN(12)= 4.D0*Y*Z*(1.D0-X)*(1.D0-Z) 118 : FN(13)=-2.D0*Z*(1.D0-X)*(1.D0-Y)*(X+Y-Z+0.5D0) 119 : FN(14)= 4.D0*X*Z*(1.D0-X)*(1.D0-Y) 120 : FN(15)=-2.D0*X*Z*(1.D0-Y)*(-X+Y-Z+1.5D0) 121 : FN(16)= 4.D0*X*Y*Z*(1.D0-Y) 122 : FN(17)=-2.D0*X*Y*Z*(-X-Y-Z+2.5D0) 123 : FN(18)= 4.D0*X*Y*Z*(1.D0-X) 124 : FN(19)=-2.D0*Y*Z*(1.D0-X)*(X-Y-Z+1.5D0) 125 : FN(20)= 4.D0*Y*Z*(1.D0-X)*(1.D0-Y) 126 : C 127 : DO 2722 N=1,IDIM 128 : XG(N,L)=0.D0 129 : DO 2732 I=1,20 130 : XG(N,L)=XG(N,L)+FN(I)*XA(N,I) 131 : 2732 CONTINUE 132 : 2722 CONTINUE 133 : 2712 CONTINUE 134 : RETURN 135 : 136 : 2103 CONTINUE 137 : C PR21 -> On ne prend que les 15 premiers points correspondant au PR15 138 : DO 2112 L=1,NP 139 : X=COOR(1,L) 140 : Y=COOR(2,L) 141 : Z=COOR(3,L) 142 : C 143 : FN(1)= (X+Y-R2)*(1.D0-Z)*(X+Y+R2*Z-R2/2.D0) 144 : FN(2)=-2.D0*X*(X+Y-R2)*(1.D0-Z) 145 : FN(3)=-X*(1.D0-Z)*(-X+R2*Z+R2/2.D0) 146 : FN(4)= 2.D0*X*Y*(1.D0-Z) 147 : FN(5)=-Y*(1.D0-Z)*(-Y+R2*Z+R2/2.D0) 148 : FN(6)=-2.D0*Y*(1.D0-Z)*(X+Y-R2) 149 : FN(7)=-4.D0*Z*(1.D0-Z)*(X+Y-R2)/R2 150 : FN(8)= 4.D0*X*Z*(1.D0-Z)/R2 151 : FN(9)= 4.D0*Y*Z*(1.D0-Z)/R2 152 : FN(10)= (X+Y-R2)*Z*(X+Y+R2*(1.D0-Z)-R2/2.D0) 153 : FN(11)=-2.D0*X*Z*(X+Y-R2) 154 : FN(12)=-X*Z*(-X+R2*(1.D0-Z)+R2/2.D0) 155 : FN(13)= 2.D0*X*Y*Z 156 : FN(14)=-Y*Z*(-Y+R2*(1.D0-Z)+R2/2.D0) 157 : FN(15)=-2.D0*Y*Z*(X+Y-R2) 158 : C 159 : DO 2122 N=1,IDIM 160 : XG(N,L)=0.D0 161 : DO 2132 I=1,15 162 : XG(N,L)=XG(N,L)+FN(I)*XA(N,I) 163 : 2132 CONTINUE 164 : 2122 CONTINUE 165 : 2112 CONTINUE 166 : RETURN 167 : 168 : 1503 CONTINUE 169 : C TE15 -> On ne prend que les 10 premiers points correspondant au TE10 170 : A=SQRT(6.D0) 171 : A2=A*A 172 : DO 1512 L=1,NP 173 : X=COOR(1,L) 174 : Y=COOR(2,L) 175 : Z=COOR(3,L) 176 : C 177 : FN(1)= 2.D0*(X+Y+A*Z-A/2.D0)*(X+Y+A*Z-A)/A2 178 : FN(2)=-4.D0*(X+Y+A*Z-A)*X/A2 179 : FN(3)= 2.D0*(X-A/2.D0)*X/A2 180 : FN(4)= 4.D0*X*Y/A2 181 : FN(5)= 2.D0*(Y-A/2.D0)*Y/A2 182 : FN(6)=-4.D0*(X+Y+A*Z-A)*Y/A2 183 : FN(7)=-4.D0*(X+Y+A*Z-A)*Z/A 184 : FN(8)= 4.D0*X*Z/A 185 : FN(9)= 4.D0*Y*Z/A 186 : FN(10)= 2.D0*Z*(Z-0.5D0) 187 : C 188 : DO 1522 N=1,IDIM 189 : XG(N,L)=0.D0 190 : DO 1532 I=1,10 191 : XG(N,L)=XG(N,L)+FN(I)*XA(N,I) 192 : 1532 CONTINUE 193 : 1522 CONTINUE 194 : 1512 CONTINUE 195 : RETURN 196 : 197 : 1002 format(10(1x,1pe11.4)) 198 : END 199 : 200 : 201 : 202 : 203 :
© Cast3M 2003 - All rights reserved.
Disclaimer