1 : C KPRUSS SOURCE MAGN 10/05/18 21:16:02 6675 2 : SUBROUTINE KPRUSS(MELEME,MELEM2, 3 : &IPM1,IPM2,IPM3,IAXI,IKAS,INEFMD,KPRE,IZTGG1,IK1,K0,IKOMP) 4 : 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C***************************************************************************** 8 : C 9 : C Ce SP calcule les matrices elementaires de divergence alias C 10 : C 11 : C IKAS=1 KMCT calcul de Ct (Div U) 12 : C IKAS=2 KMAC calcul de C uniquement (Grad p) 13 : C IKAS=3 KCCT calcul de C assemblage pour C et Ct 14 : C 15 : C***************************************************************************** 16 : CHARACTER*8 NOM0 17 : 18 : -INC CCOPTIO 19 : -INC CCGEOME 20 : -INC SMCOORD 21 : -INC SIZFFB 22 : POINTEUR IZF1.IZFFM,IZH2.IZHR 23 : -INC SMMATRIK 24 : -INC SMELEME 25 : POINTEUR MELEM2.MELEME 26 : -INC SMCHPOI 27 : POINTEUR IZTGG1.MPOVAL 28 : -INC CCREEL 29 : DIMENSION KIPM(3),XYZ1(24) 30 : 31 : 32 : C OPERATEUR PRESSION 33 : C 34 : DEUPI=1.D0 35 : IF(IAXI.NE.0)DEUPI=2.D0*XPI 36 : IF(IKAS.EQ.3)DEUPI=-DEUPI 37 : 38 : C write(6,*)' DEUPI=',deupi 39 : IF(IDIM.EQ.2)IPM3=IPM1 40 : KIPM(1)=IPM1 41 : KIPM(2)=IPM2 42 : KIPM(3)=IPM3 43 : SEGACT MELEME,IPM1*MOD,IPM2*MOD,IPM3*MOD 44 : 45 : NP=NUM(/1) 46 : NEL=NUM(/2) 47 : 48 : IF(KPRE.NE.2)THEN 49 : IF(INEFMD.EQ.3)THEN 50 : IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'PRP0' 51 : IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'PRP1' 52 : IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'PFP1' 53 : ELSEIF(INEFMD.EQ.2)THEN 54 : IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'MCP0' 55 : IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'MCP1' 56 : IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'MCF1' 57 : ELSEIF(INEFMD.EQ.1)THEN 58 : IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'P1P1' 59 : ELSEIF(INEFMD.EQ.4)THEN 60 : NOM0=NOMS(ITYPEL)//' ' 61 : ENDIF 62 : 63 : C write(6,*)' Kpruss : NOM0=',nom0,' ikas=',ikas,' nel=',nel 63 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 64 : 65 : SEGACT IZFFM*MOD 66 : IZHR=KZHR(1) 67 : IZH2=KZHR(2) 68 : 69 : SEGACT IZHR*MOD,IZH2*MOD 70 : 71 : NES=GR(/1) 72 : NPG=GR(/3) 73 : IZF1=KTP(1) 74 : SEGACT IZF1*MOD 75 : MP1=IZF1.FN(/1) 76 : MP=MELEM2.NUM(/1) 77 : 78 : DO 30 KE=1,NEL 79 : NK=K0+KE 80 : 81 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% IKOMP = 1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 82 : IF(IKOMP.EQ.1)THEN 83 : DO 12 I=1,NP 84 : J=NUM(I,KE) 85 : DO 12 N=1,IDIM 86 : XYZ(N,I)=XCOOR((J-1)*(IDIM+1) +N) 87 : 12 CONTINUE 88 : 88 : CALL CALJBR 89 : &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) 90 : 91 : DO 324 K=1,IDIM 92 : IPM4=KIPM(K) 93 : 94 : DO 323 M=1,MP1 95 : 96 : DO 323 I=1,NP 97 : U=0.D0 98 : DO 333 L=1,NPG 99 : U=U+IZF1.FN(M,L)*HR(K,I,L)*PGSQ(L)*DEUPI*RPG(L) 100 : 333 CONTINUE 101 : 102 : IF(IAXI.NE.0.AND.K.EQ.1)THEN 103 : DO 334 L=1,NPG 104 : U=U+IZF1.FN(M,L)*FN(I,L)*PGSQ(L)*DEUPI 105 : 334 CONTINUE 106 : ENDIF 107 : 108 : K1=1+(1-IK1)*(NK-1) 109 : U=U*IZTGG1.VPOCHA(K1,1) 110 : 111 : if(ikas.ne.2)then 112 : IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U 113 : else 114 : IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U 115 : endif 116 : 117 : 323 CONTINUE 118 : 324 CONTINUE 119 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% IKOMP = 0 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 120 : ELSE 121 : 122 : DO 13 I=1,MP1 123 : J=MELEM2.NUM(I,KE) 124 : DO 13 N=1,IDIM 125 : IZH2.XYZ(N,I)=XCOOR((J-1)*(IDIM+1) +N) 126 : 13 CONTINUE 127 : 127 : CALL CALJBR(IZF1.FN,IZF1.GR,PG, 128 : & IZH2.XYZ,IZH2.HR,IZH2.PGSQ,IZH2.RPG,NES,IDIM,MP1,NPG,IAXI,AIRE, 129 : & IZH2.AJ,SGN) 130 : 131 : DO 524 K=1,IDIM 132 : IPM4=KIPM(K) 133 : 134 : DO 523 M=1,MP1 135 : 136 : DO 523 I=1,NP 137 : U=0.D0 138 : DO 533 L=1,NPG 139 : U=U+FN(I,L)*IZH2.HR(K,M,L)*IZH2.PGSQ(L)*DEUPI*IZH2.RPG(L) 140 : 533 CONTINUE 141 : 142 : K1=1+(1-IK1)*(NK-1) 143 : U=U*IZTGG1.VPOCHA(K1,1) 144 : 145 : if(ikas.ne.2)then 146 : IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U 147 : else 148 : IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U 149 : endif 150 : 151 : 523 CONTINUE 152 : 524 CONTINUE 153 : 154 : ENDIF 155 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 156 : 157 : 37 CONTINUE 158 : 30 CONTINUE 159 : 160 : SEGSUP IZHR,IZFFM,IZH2 161 : 162 : 163 : C CAS MACRO CENTRE 164 : 165 : ELSEIF(KPRE.EQ.2)THEN 166 : NOM0=NOMS(ITYPEL)//' ' 166 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 167 : 168 : SEGACT IZFFM*MOD 169 : IZHR=KZHR(1) 170 : IZH2=KZHR(2) 171 : SEGACT IZHR*MOD,IZH2*MOD 172 : NES=GR(/1) 173 : NPG=GR(/3) 174 : IZF1=KTP(1) 175 : SEGACT IZF1*MOD 176 : MPG=IZF1.FN(/2) 177 : NP=GR(/2) 178 : 179 : DO 40 KE=1,NEL 180 : 181 : NK=K0+KE 182 : 183 : IX=0 184 : DO 42 I=1,NP 185 : J=NUM(I,KE) 186 : DO 42 N=1,IDIM 187 : IX=IX+1 188 : XYZ1(IX)=XCOOR((J-1)*(IDIM+1) +N) 189 : 42 CONTINUE 190 : 190 : CALL CALJBR(FN,GR,PG,XYZ1,HR,PGSQ,RPG,NES, 191 : & IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) 192 : 193 : DO 424 K=1,IDIM 194 : IPM4=KIPM(K) 195 : 196 : DO 423 I=1,NP 197 : U=0.D0 198 : DO 433 L=1,NPG 199 : U=U+HR(K,I,L)*PGSQ(L)*DEUPI*RPG(L) 200 : 433 CONTINUE 201 : 202 : IF(IAXI.NE.0.AND.K.EQ.1)THEN 203 : DO 434 L=1,NPG 204 : U=U+FN(I,L)*PGSQ(L)*DEUPI 205 : 434 CONTINUE 206 : ENDIF 207 : 208 : K1=1+(1-IK1)*(NK-1) 209 : U=U*IZTGG1.VPOCHA(K1,1) 210 : 211 : if(ikas.ne.2)then 212 : IPM4.AM(KE,I,1)=IPM4.AM(KE,I,1)+U 213 : else 214 : IPM4.AM(KE,1,I)=IPM4.AM(KE,1,I)+U 215 : endif 216 : 217 : 423 CONTINUE 218 : 424 CONTINUE 219 : 220 : 40 CONTINUE 221 : 222 : SEGSUP IZHR,IZFFM,IZH2 223 : 224 : ENDIF 225 : 226 : C write(6,*)' Retour KPRUSS' 227 : RETURN 228 : 1002 FORMAT(10(1X,1PE11.4)) 229 : 1040 FORMAT(1X,'CALCUL MATRICE AM ',I4/10(1X,1PE11.4)) 230 : END 231 : 232 : 233 : 234 : 235 : 236 : 237 : 238 : 239 : 240 : 241 : 242 : 243 : 244 :
© Cast3M 2003 - All rights reserved.
Disclaimer