1 : C KLNO SOURCE CHAT 11/03/16 21:26:11 6902 2 : SUBROUTINE KLNO 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C************************************************************************* 6 : C Operateur KLNO 7 : C 8 : C Objet : transforme un CHAMPOINT CENTRE en un CHAMPOINT SOMMET 9 : C 10 : C SYNTAXE : CHPS = KLNO OBJM CHPC (MOTCLE (GRAD LIMI)); 11 : C 12 : C OBJM : Objet modèle 'Navier_Stokes' 13 : C : a la rigueur table DOMAINE 14 : C CHPC : CHAMPOINT CENTRE 15 : C CHPS : CHAMPOINT SOMMET 16 : C 17 : C************************************************************************* 18 : -INC SMELEME 19 : POINTEUR MELEMS.MELEME,MELEMC.MELEME,MELEP1.MELEME 20 : POINTEUR IGEOMB.MELEME 21 : -INC CCOPTIO 22 : -INC CCREEL 23 : -INC SMCOORD 24 : -INC CCGEOME 25 : -INC SMMODEL 26 : -INC SMCHPOI 27 : POINTEUR IZB.MCHPOI,IZBB.MPOVAL 28 : POINTEUR IZD.MCHPOI,IZDD.MPOVAL 29 : -INC SMLENTI 30 : POINTEUR IZIPAP.MLENTI,IZIPAD.MLENTI 31 : -INC SIZFFB 32 : POINTEUR IZF1.IZFFM 33 : DIMENSION ITABO(4) 34 : CHARACTER*8 TYPE,TYPC,NOM0,TYPSPG, CHAI 35 : CHARACTER*8 LISMO(5) 36 : DATA LISMO/'CENTRE ','CENTREP0','CENTREP1','MSOMMET','VOLUMF '/ 37 : C*********************************************************************** 38 : C**** Case VF ********************************************************** 39 : C*********************************************************************** 39 : CALL QUETYP(TYPE,1,IRET) 40 : IF(IERR.NE.0)GOTO 9999 41 : IF(TYPE .EQ. 'MOT ')THEN 41 : CALL LIRCHA(CHAI,1,IRET) 42 : IF(IERR.NE.0)GOTO 9999 43 : IF(CHAI.EQ. 'VF ')THEN 44 : C 45 : C CHPOINT to project 46 : C 46 : CALL LIROBJ('CHPOINT',IZB,1,IRET) 47 : IF(IERR.NE.0)GOTO 9999 48 : SEGACT IZB 49 : IF(IZB.IPCHP(/1).NE.1) THEN 49 : CALL ERREUR(920) 50 : C Erreur dans le partitionnement 51 : GOTO 9999 52 : ENDIF 53 : SEGDES IZB 54 : C 55 : C Domain table 56 : C 56 : CALL LIROBJ('TABLE ',MTABD,1,IRET) 57 : IF(IERR.NE.0)GOTO 9999 58 : C 59 : C Gradient 60 : C 60 : CALL LIROBJ('CHPOINT',MCHPO1,1,IRET) 61 : IF(IERR.NE.0)GOTO 9999 62 : C 63 : C Limiter 64 : C 64 : CALL LIROBJ('CHPOINT',MCHPO2,1,IRET) 65 : IF(IERR.NE.0)GOTO 9999 66 : C 67 : C Computation 68 : C 68 : CALL RLEX(MCHPOI,IZB,MCHPO1,MCHPO2,MTABD) 69 : IF(IERR.NE.0)GOTO 9999 70 : C 71 : C We write the result 72 : C 72 : CALL ECROBJ('CHPOINT ',MCHPOI) 73 : GOTO 9999 74 : ELSE 75 : C 76 : C******* I apologize myself and I give back the mot 77 : C 77 : CALL REFUS 78 : ENDIF 79 : ENDIF 80 : 81 : C*********************************************************************** 82 : C**** End of the case VF *********************************************** 83 : C*********************************************************************** 84 : C 85 : IAXI=0 86 : IF(IFOMOD.EQ.0)IAXI=2 87 : 87 : CALL LIRCHA(CHAI,0,IRET) 88 : 89 : IF(IRET.EQ.0)THEN 90 : TYPSPG='CENTRE' 91 : ELSE 91 : CALL REFUS 91 : CALL LIRMOT(LISMO,5,IP,1) 92 : IF(IP.EQ.0)RETURN 93 : TYPSPG=LISMO(IP) 94 : ENDIF 95 : 96 : IF(TYPSPG.EQ.'VOLUMF')GO TO 51 97 : 97 : CALL LIROBJ('CHPOINT',IZB,1,IRETOU) 98 : IF(IRETOU.EQ.0)RETURN 99 : * 100 : * Verification du CHPOINT 101 : * 102 : 103 : SEGACT IZB 104 : IF(IZB.IPCHP(/1).NE.1)THEN 105 : C% Erreur dans le partitionnement 105 : CALL ERREUR(920) 106 : SEGDES IZB 107 : RETURN 108 : ENDIF 109 : 110 : 110 : CALL LIROBJ('MMODEL ',MMODEL,0,IRET) 111 : IF(IRET.EQ.1)THEN 112 : * 113 : * Verification de l'objet modele 'Navier-Stokes' 114 : * 115 : C*** 116 : SEGACT MMODEL 117 : N1=KMODEL(/1) 118 : DO 41 L=1,N1 119 : IMODEL=KMODEL(L) 120 : SEGACT IMODEL 121 : IF(FORMOD(1).NE.'NAVIER_STOKES')THEN 122 : IF(FORMOD(1).NE.'DARCY')THEN 123 : C% On veut un modèle de type %m1:16 . 124 : MOTERR( 1:16) = 'NAVIER_STOKES ' 124 : CALL ERREUR(719) 125 : RETURN 126 : ENDIF 127 : ENDIF 128 : SEGDES IMODEL 129 : 41 CONTINUE 130 : 130 : CALL LEKMOD(MMODEL,MTABD,INEFMD) 131 : C INEFMD=1 LINE =2 MACRO =3 QUADRATIQUE =4 LINB 132 : ELSE 132 : CALL LIROBJ('TABLE ',MTABD,1,IRET) 133 : IF(IRET.EQ.0)RETURN 134 : ENDIF 135 : C------------------ Traitement du cas VOLUMF ---------------------------- 136 : 51 CONTINUE 137 : IF (IP .EQ. 5) THEN 137 : CALL LIROBJ('CHPOINT',MCHPO1,1,IRETOU) 138 : IF(IRETOU.EQ.0) THEN 139 : C% Information manquante (objet CHPOINT) : pas de définition de la densité 139 : CALL ERREUR(839) 140 : RETURN 141 : ENDIF 141 : CALL LIROBJ('CHPOINT',MCHPO2,1,IRETOU) 142 : IF(IRETOU.EQ.0) THEN 143 : C% Information manquante (objet CHPOINT) : pas de définition de la densité 143 : CALL ERREUR(839) 144 : RETURN 145 : ENDIF 145 : CALL RLEX(MCHPOI,IZB,MCHPO1,MCHPO2,MTABD) 146 : GOTO 360 147 : ENDIF 148 : 149 : C------------------ Traitement des cas CENTRE CENTREP0 CENTREP1 --------- 150 : 52 CONTINUE 151 : C 152 : 153 : DEUPI=1.D0 154 : IF(IAXI.NE.0)DEUPI=2.D0*XPI 155 : 155 : CALL LICHT(IZB,IZBB,TYPC,IGEOMB) 156 : NC=IZBB.VPOCHA(/2) 157 : N=IZBB.VPOCHA(/1) 158 : SEGINI MPOVA3 159 : SEGACT IGEOMB 160 : 160 : CALL LEKTAB(MTABD,TYPSPG,MELEMC) 161 : IF (IERR.NE.0) RETURN 161 : CALL KRIPAD(IGEOMB,IZIPAP) 161 : CALL VERPAD(IZIPAP,MELEMC,IRET) 162 : IF(IRET.NE.0)THEN 163 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 164 : MOTERR(1: 8) = TYPSPG 165 : MOTERR(9:16) = 'CHPOINT ' 165 : CALL ERREUR(788) 166 : RETURN 167 : ENDIF 168 : 168 : CALL LEKTAB(MTABD,'SOMMET',MELEMS) 168 : CALL KRIPAD(MELEMS,IZIPAD) 169 : TYPE='SOMMET' 169 : CALL CRCHPT(TYPE,MELEMS,NC,MCHPOI) 169 : CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM) 170 : 170 : CALL LEKTAB(MTABD,'MAILLAGE',MELEME) 171 : 172 : C------------ Cas MSOMMET ------------------------------------------------ 173 : C------------ Cas MSOMMET ------------------------------------------------ 174 : 175 : IF(TYPSPG.EQ.'MSOMMET')THEN 176 : 177 : IF(INEFMD.EQ.2)THEN 177 : CALL LEKTAB(MTABD,'MACRO1',MELEME) 178 : ENDIF 179 : 179 : CALL VERPAD(IZIPAD,MELEMC,IRET) 180 : IF(IRET.NE.0)THEN 181 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 182 : MOTERR(1: 8) = TYPSPG 183 : MOTERR(9:16) = 'CHPOINT ' 183 : CALL ERREUR(788) 184 : RETURN 185 : ENDIF 186 : 187 : C On place les valeurs aux sommets de l'élément 188 : DO 741 I=1,N 189 : DO 741 M=1,NC 190 : iu = IZIPAD.LECT(MELEMC.NUM(1,I)) 191 : VPOCHA(iu,M)=IZBB.VPOCHA(I,M) 192 : 741 CONTINUE 193 : 194 : IF(INEFMD.EQ.1)GO TO 790 195 : 196 : SEGACT MELEME 197 : NBSOUS=LISOUS(/1) 198 : 199 : DO 742 L=1,(MAX(1,NBSOUS)) 200 : IPT1=MELEME 201 : IF(NBSOUS.NE.0)IPT1=LISOUS(L) 202 : SEGACT IPT1 203 : 204 : NBELEM =IPT1.NUM(/2) 205 : NBNN =IPT1.NUM(/1) 206 : 207 : IF(IPT1.ITYPEL.EQ.6)THEN 208 : C write(6,*)' TRI6' 209 : 210 : DO 643 K=1,NBELEM 211 : iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) 212 : iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) 213 : iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) 214 : iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) 215 : iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) 216 : iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) 217 : DO 645 M=1,NC 218 : VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 219 : VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 220 : VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 221 : 645 CONTINUE 222 : 643 CONTINUE 223 : 224 : ELSEIF(IPT1.ITYPEL.EQ.7)THEN 225 : C write(6,*)' TRI7' 226 : 227 : DO 743 K=1,NBELEM 228 : iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) 229 : iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) 230 : iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) 231 : iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) 232 : iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) 233 : iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) 234 : iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) 235 : DO 745 M=1,NC 236 : VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 237 : VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 238 : VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 239 : VPOCHA(iu7,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0 240 : 745 CONTINUE 241 : 743 CONTINUE 242 : 243 : ELSEIF(IPT1.ITYPEL.EQ.11)THEN 244 : C write(6,*)' QUA9' 245 : 246 : DO 943 K=1,NBELEM 247 : iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) 248 : iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) 249 : iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) 250 : iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) 251 : iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) 252 : iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) 253 : iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) 254 : iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) 255 : iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) 256 : DO 945 M=1,NC 257 : VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 258 : VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 259 : VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5 260 : VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5 261 : VPOCHA(iu9,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ 262 : & VPOCHA(iu7,M))/4.D0 263 : 945 CONTINUE 264 : 943 CONTINUE 265 : 266 : ELSEIF(IPT1.ITYPEL.EQ.33)THEN 267 : C write(6,*)' CU27' 268 : 269 : DO 2743 K=1,NBELEM 270 : iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) 271 : iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) 272 : iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) 273 : iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) 274 : iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) 275 : iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) 276 : iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) 277 : iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) 278 : iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) 279 : iu10= IZIPAD.LECT(IPT1.NUM(10,K)) 280 : iu11= IZIPAD.LECT(IPT1.NUM(11,K)) 281 : iu12= IZIPAD.LECT(IPT1.NUM(12,K)) 282 : iu13= IZIPAD.LECT(IPT1.NUM(13,K)) 283 : iu14= IZIPAD.LECT(IPT1.NUM(14,K)) 284 : iu15= IZIPAD.LECT(IPT1.NUM(15,K)) 285 : iu16= IZIPAD.LECT(IPT1.NUM(16,K)) 286 : iu17= IZIPAD.LECT(IPT1.NUM(17,K)) 287 : iu18= IZIPAD.LECT(IPT1.NUM(18,K)) 288 : iu19= IZIPAD.LECT(IPT1.NUM(19,K)) 289 : iu20= IZIPAD.LECT(IPT1.NUM(20,K)) 290 : iu21= IZIPAD.LECT(IPT1.NUM(21,K)) 291 : iu22= IZIPAD.LECT(IPT1.NUM(22,K)) 292 : iu23= IZIPAD.LECT(IPT1.NUM(23,K)) 293 : iu24= IZIPAD.LECT(IPT1.NUM(24,K)) 294 : iu25= IZIPAD.LECT(IPT1.NUM(25,K)) 295 : iu26= IZIPAD.LECT(IPT1.NUM(26,K)) 296 : iu27= IZIPAD.LECT(IPT1.NUM(27,K)) 297 : DO 2745 M=1,NC 298 : VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 299 : VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 300 : VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5 301 : VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5 302 : VPOCHA(iu25,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ 303 : & VPOCHA(iu7,M))/4.D0 304 : 305 : VPOCHA(iu14,M)=(VPOCHA(iu13,M)+VPOCHA(iu15,M))*0.5 306 : VPOCHA(iu16,M)=(VPOCHA(iu15,M)+VPOCHA(iu17,M))*0.5 307 : VPOCHA(iu18,M)=(VPOCHA(iu17,M)+VPOCHA(iu19,M))*0.5 308 : VPOCHA(iu20,M)=(VPOCHA(iu19,M)+VPOCHA(iu13,M))*0.5 309 : VPOCHA(iu26,M)=(VPOCHA(iu13,M)+VPOCHA(iu15,M)+VPOCHA(iu17,M)+ 310 : & VPOCHA(iu19,M))/4.D0 311 : 312 : VPOCHA(iu9 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu13,M))*0.5 313 : VPOCHA(iu10,M)=(VPOCHA(iu3,M)+VPOCHA(iu15,M))*0.5 314 : VPOCHA(iu11,M)=(VPOCHA(iu5,M)+VPOCHA(iu17,M))*0.5 315 : VPOCHA(iu12,M)=(VPOCHA(iu7,M)+VPOCHA(iu19,M))*0.5 316 : 317 : VPOCHA(iu21,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu15,M)+ 318 : & VPOCHA(iu13,M))/4.D0 319 : VPOCHA(iu22,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu17,M)+ 320 : & VPOCHA(iu15,M))/4.D0 321 : VPOCHA(iu23,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M)+VPOCHA(iu17,M)+ 322 : & VPOCHA(iu19,M))/4.D0 323 : VPOCHA(iu24,M)=(VPOCHA(iu1 ,M)+VPOCHA(iu7,M)+VPOCHA(iu19,M)+ 324 : & VPOCHA(iu13,M))/4.D0 325 : VPOCHA(iu27,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ 326 : &VPOCHA(iu7,M)+VPOCHA(iu13,M)+VPOCHA(iu15,M)+VPOCHA(iu17,M)+ 327 : & VPOCHA(iu19,M))/8.D0 328 : 2745 CONTINUE 329 : 2743 CONTINUE 330 : 331 : ELSEIF(IPT1.ITYPEL.EQ.34)THEN 332 : C write(6,*)' PR21' 333 : 334 : DO 2143 K=1,NBELEM 335 : iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) 336 : iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) 337 : iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) 338 : iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) 339 : iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) 340 : iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) 341 : iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) 342 : iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) 343 : iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) 344 : iu10= IZIPAD.LECT(IPT1.NUM(10,K)) 345 : iu11= IZIPAD.LECT(IPT1.NUM(11,K)) 346 : iu12= IZIPAD.LECT(IPT1.NUM(12,K)) 347 : iu13= IZIPAD.LECT(IPT1.NUM(13,K)) 348 : iu14= IZIPAD.LECT(IPT1.NUM(14,K)) 349 : iu15= IZIPAD.LECT(IPT1.NUM(15,K)) 350 : iu16= IZIPAD.LECT(IPT1.NUM(16,K)) 351 : iu17= IZIPAD.LECT(IPT1.NUM(17,K)) 352 : iu18= IZIPAD.LECT(IPT1.NUM(18,K)) 353 : iu19= IZIPAD.LECT(IPT1.NUM(19,K)) 354 : iu20= IZIPAD.LECT(IPT1.NUM(20,K)) 355 : iu21= IZIPAD.LECT(IPT1.NUM(21,K)) 356 : DO 2145 M=1,NC 357 : VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 358 : VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 359 : VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 360 : VPOCHA(iu19,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0 361 : 362 : VPOCHA(iu11,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M))*0.5 363 : VPOCHA(iu13,M)=(VPOCHA(iu12,M)+VPOCHA(iu14,M))*0.5 364 : VPOCHA(iu15,M)=(VPOCHA(iu14,M)+VPOCHA(iu10,M))*0.5 365 : VPOCHA(iu20,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M)+VPOCHA(iu14,M))/3.D0 366 : 367 : VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5 368 : VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu12,M))*0.5 369 : VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu14,M))*0.5 370 : 371 : VPOCHA(iu16,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu12,M)+ 372 : & VPOCHA(iu10,M))/4.D0 373 : VPOCHA(iu17,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu12,M)+ 374 : & VPOCHA(iu14,M))/4.D0 375 : VPOCHA(iu18,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu14,M)+ 376 : & VPOCHA(iu10,M))/4.D0 377 : VPOCHA(iu21,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ 378 : & VPOCHA(iu10,M)+VPOCHA(iu12,M)+VPOCHA(iu14,M))/6.D0 379 : 2145 CONTINUE 380 : 2143 CONTINUE 381 : 382 : ELSEIF(IPT1.ITYPEL.EQ.40)THEN 383 : C write(6,*)' PR18' 384 : 385 : DO 1843 K=1,NBELEM 386 : iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) 387 : iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) 388 : iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) 389 : iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) 390 : iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) 391 : iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) 392 : iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) 393 : iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) 394 : iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) 395 : iu10= IZIPAD.LECT(IPT1.NUM(10,K)) 396 : iu11= IZIPAD.LECT(IPT1.NUM(11,K)) 397 : iu12= IZIPAD.LECT(IPT1.NUM(12,K)) 398 : iu13= IZIPAD.LECT(IPT1.NUM(13,K)) 399 : iu14= IZIPAD.LECT(IPT1.NUM(14,K)) 400 : iu15= IZIPAD.LECT(IPT1.NUM(15,K)) 401 : iu16= IZIPAD.LECT(IPT1.NUM(16,K)) 402 : iu17= IZIPAD.LECT(IPT1.NUM(17,K)) 403 : iu18= IZIPAD.LECT(IPT1.NUM(18,K)) 404 : DO 1845 M=1,NC 405 : VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 406 : VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 407 : VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 408 : 409 : VPOCHA(iu11,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M))*0.5 410 : VPOCHA(iu13,M)=(VPOCHA(iu12,M)+VPOCHA(iu14,M))*0.5 411 : VPOCHA(iu15,M)=(VPOCHA(iu14,M)+VPOCHA(iu10,M))*0.5 412 : 413 : VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5 414 : VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu12,M))*0.5 415 : VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu14,M))*0.5 416 : 417 : VPOCHA(iu16,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu12,M)+ 418 : & VPOCHA(iu10,M))/4.D0 419 : VPOCHA(iu17,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu12,M)+ 420 : & VPOCHA(iu14,M))/4.D0 421 : VPOCHA(iu18,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu14,M)+ 422 : & VPOCHA(iu10,M))/4.D0 423 : 1845 CONTINUE 424 : 1843 CONTINUE 425 : 426 : ELSEIF(IPT1.ITYPEL.EQ.35)THEN 427 : C write(6,*)' TE15' 428 : 429 : DO 1543 K=1,NBELEM 430 : iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) 431 : iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) 432 : iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) 433 : iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) 434 : iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) 435 : iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) 436 : iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) 437 : iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) 438 : iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) 439 : iu10= IZIPAD.LECT(IPT1.NUM(10,K)) 440 : iu11= IZIPAD.LECT(IPT1.NUM(11,K)) 441 : iu12= IZIPAD.LECT(IPT1.NUM(12,K)) 442 : iu13= IZIPAD.LECT(IPT1.NUM(13,K)) 443 : iu14= IZIPAD.LECT(IPT1.NUM(14,K)) 444 : iu15= IZIPAD.LECT(IPT1.NUM(15,K)) 445 : DO 1545 M=1,NC 446 : VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 447 : VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 448 : VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 449 : VPOCHA(iu11,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0 450 : 451 : VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5 452 : VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu10,M))*0.5 453 : VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu10,M))*0.5 454 : 455 : VPOCHA(iu12,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu10,M))/3.D0 456 : VPOCHA(iu13,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu10,M))/3.D0 457 : VPOCHA(iu14,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu10,M))/3.D0 458 : VPOCHA(iu15,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ 459 : & VPOCHA(iu10,M))/4.D0 460 : 1545 CONTINUE 461 : 1543 CONTINUE 462 : 463 : ELSEIF(IPT1.ITYPEL.EQ.24)THEN 464 : C write(6,*)' TE10' 465 : 466 : DO 1043 K=1,NBELEM 467 : iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) 468 : iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) 469 : iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) 470 : iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) 471 : iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) 472 : iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) 473 : iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) 474 : iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) 475 : iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) 476 : iu10= IZIPAD.LECT(IPT1.NUM(10,K)) 477 : DO 1045 M=1,NC 478 : VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 479 : VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 480 : VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 481 : 482 : VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5 483 : VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu10,M))*0.5 484 : VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu10,M))*0.5 485 : 1045 CONTINUE 486 : 1043 CONTINUE 487 : 488 : ELSEIF(IPT1.ITYPEL.EQ.36)THEN 489 : C write(6,*)' PY19' 490 : 491 : DO 1943 K=1,NBELEM 492 : iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) 493 : iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) 494 : iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) 495 : iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) 496 : iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) 497 : iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) 498 : iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) 499 : iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) 500 : iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) 501 : iu10= IZIPAD.LECT(IPT1.NUM(10,K)) 502 : iu11= IZIPAD.LECT(IPT1.NUM(11,K)) 503 : iu12= IZIPAD.LECT(IPT1.NUM(12,K)) 504 : iu13= IZIPAD.LECT(IPT1.NUM(13,K)) 505 : iu14= IZIPAD.LECT(IPT1.NUM(14,K)) 506 : iu15= IZIPAD.LECT(IPT1.NUM(15,K)) 507 : iu16= IZIPAD.LECT(IPT1.NUM(16,K)) 508 : iu17= IZIPAD.LECT(IPT1.NUM(17,K)) 509 : iu18= IZIPAD.LECT(IPT1.NUM(18,K)) 510 : iu19= IZIPAD.LECT(IPT1.NUM(19,K)) 511 : DO 1945 M=1,NC 512 : VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 513 : VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 514 : VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5 515 : VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5 516 : VPOCHA(iu14,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ 517 : & VPOCHA(iu7,M))/4.D0 518 : 519 : VPOCHA(iu9 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu13,M))*0.5 520 : VPOCHA(iu10,M)=(VPOCHA(iu3,M)+VPOCHA(iu13,M))*0.5 521 : VPOCHA(iu11,M)=(VPOCHA(iu5,M)+VPOCHA(iu13,M))*0.5 522 : VPOCHA(iu12,M)=(VPOCHA(iu7,M)+VPOCHA(iu13,M))*0.5 523 : 524 : VPOCHA(iu15,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu13,M))/3.D0 525 : VPOCHA(iu16,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu13,M))/3.D0 526 : VPOCHA(iu17,M)=(VPOCHA(iu7,M)+VPOCHA(iu5,M)+VPOCHA(iu13,M))/3.D0 527 : VPOCHA(iu18,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M)+VPOCHA(iu13,M))/3.D0 528 : VPOCHA(iu19,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ 529 : & VPOCHA(iu7,M)+VPOCHA(iu13,M))/5.D0 530 : 1945 CONTINUE 531 : 1943 CONTINUE 532 : 533 : ELSE 534 : write(6,*)' KLNO : Element ',IPT1.ITYPEL,' non implemente' 535 : C% Type d'élément incorrect 535 : CALL ERREUR(16) 536 : RETURN 537 : ENDIF 538 : segdes IPT1 539 : 742 CONTINUE 540 : 541 : 542 : 790 CONTINUE 543 : 544 : SEGDES MPOVAL,MCHPOI,IZBB 545 : SEGSUP IZIPAD,IZIPAP 545 : CALL ECROBJ('CHPOINT ',MCHPOI) 546 : 547 : RETURN 548 : 549 : 550 : ENDIF 551 : 552 : C------------ Cas MSOMMET Fin -------------------------------------------- 553 : C------------ Cas MSOMMET Fin -------------------------------------------- 554 : 555 : 555 : CALL LEKTAB(MTABD,'MACRO1',MACRO1) 555 : CALL LEKTAB(MTABD,'QUADRATI',MQUAD) 556 : IF(IERR.NE.0)RETURN 557 : 558 : 559 : KPRE=2 560 : 561 : MELEP1=MELEMC 562 : IF(TYPSPG.EQ.'CENTREP0')THEN 563 : IF(MACRO1.NE.0)MELEME=MACRO1 564 : KPRE=3 565 : ELSEIF(TYPSPG.EQ.'CENTREP1')THEN 566 : KPRE=4 567 : IF(MACRO1.NE.0)MELEME=MACRO1 567 : CALL LEKTAB(MTABD,'ELTP1NC ',MELEP1) 568 : ENDIF 569 : 570 : 570 : CALL CRCHPT(TYPE,MELEMS,NC,IZD) 570 : CALL LICHT(IZD,IZDD,TYPC,IGEOM) 571 : 572 : SEGACT MELEME,MELEP1,MELEMS 573 : 574 : IF(IAXI.NE.0)THEN 575 : 576 : NPTD=MELEMS.NUM(/2) 577 : RMINS=XGRAND 578 : DO 232 I=1,NPTD 579 : J=MELEMS.NUM(1,I) 580 : R=XCOOR((J-1)*(IDIM+1) +1) 581 : R=ABS(R) 582 : IF(R.LT.RMINS)RMINS=R 583 : 232 CONTINUE 584 : 585 : RMIN=XGRAND 586 : DO 314 I=1,N 587 : J=IGEOMB.NUM(1,I) 588 : R=XCOOR((J-1)*(IDIM+1) +1) 589 : R=ABS(R) 590 : IF(R.LT.RMIN)RMIN=R 591 : 314 CONTINUE 592 : DR=1.2D0*(RMIN-RMINS) 593 : DR=ABS(DR) 594 : 595 : DO 315 I=1,N 596 : J=IGEOMB.NUM(1,I) 597 : R=XCOOR((J-1)*(IDIM+1) +1) 598 : R=ABS(R) 599 : DO 315 L=1,NC 600 : MPOVA3.VPOCHA(I,L)=IZBB.VPOCHA(I,L)*(R + DR*EXP(-(R/DR))) 601 : 315 CONTINUE 602 : DR=RMIN-RMINS 603 : ELSE 604 : DO 316 I=1,N 605 : DO 316 L=1,NC 606 : MPOVA3.VPOCHA(I,L)=IZBB.VPOCHA(I,L) 607 : 316 CONTINUE 608 : ENDIF 609 : 610 : NBSOUS=LISOUS(/1) 611 : IF(NBSOUS.EQ.0)NBSOUS=1 612 : 613 : DO 350 N=1,NC 614 : NK=0 615 : DO 1 L=1,NBSOUS 616 : IPT1=MELEME 617 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 618 : SEGACT IPT1 619 : NP=IPT1.NUM(/1) 620 : NEL=IPT1.NUM(/2) 621 : 622 : NOM0=NOMS(IPT1.ITYPEL)//' ' 623 : 624 : IF(MQUAD.NE.0)THEN 625 : IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'PRP0' 626 : IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0' 627 : IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1' 628 : ELSEIF(MACRO1.NE.0)THEN 629 : IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' ' 630 : IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0' 631 : IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1' 632 : ELSE 633 : IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' ' 634 : ENDIF 635 : 635 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 636 : C write(6,*)' NOM0=',nom0,kpre,IZFFM 637 : 638 : IF(IZFFM.EQ.0)THEN 639 : C% Type d'élément incorrect 639 : CALL ERREUR(16) 640 : RETURN 641 : ENDIF 642 : 643 : SEGACT IZFFM*MOD 644 : IZHR=KZHR(1) 645 : SEGACT IZHR*MOD 646 : NPG=FN(/2) 647 : NES=GR(/1) 648 : IZF1=KTP(1) 649 : SEGACT IZF1*MOD 650 : MP1=IZF1.FN(/1) 651 : NPGP=IZF1.FN(/2) 652 : 653 : DO 10 K=1,NEL 654 : NK=NK+1 655 : DO 12 I=1,NP 656 : J=IPT1.NUM(I,K) 657 : DO 12 M=1,IDIM 658 : XYZ(M,I)=XCOOR((J-1)*(IDIM+1) +M) 659 : 12 CONTINUE 660 : 660 : CALL CALJBR 661 : &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) 662 : 663 : DO 35 I=1,NP 664 : IU=IZIPAD.LECT(IPT1.NUM(I,K)) 665 : UU=0.D0 666 : DD=0.D0 667 : DO 340 LL=1,NPG 668 : VL=0.D0 669 : DO 34 J=1,MP1 670 : KK=IZIPAP.LECT(MELEP1.NUM(J,NK)) 671 : VL=VL+IZF1.FN(J,LL)*MPOVA3.VPOCHA(KK,N) 672 : 34 CONTINUE 673 : DD=DD+FN(I,LL)*PGSQ(LL)*DEUPI 674 : UU=UU+VL*FN(I,LL)*PGSQ(LL)*DEUPI 675 : 340 CONTINUE 676 : VPOCHA(IU,N)=VPOCHA(IU,N)+UU 677 : IZDD.VPOCHA(IU,N)=IZDD.VPOCHA(IU,N)+DD 678 : 35 CONTINUE 679 : 680 : 10 CONTINUE 681 : SEGDES IPT1 682 : 1 CONTINUE 683 : 684 : NPTD=VPOCHA(/1) 685 : DO 13 I=1,NPTD 686 : VPOCHA(I,N)=VPOCHA(I,N)/IZDD.VPOCHA(I,1) 687 : 13 CONTINUE 688 : 689 : IF(IAXI.NE.0)THEN 690 : DO 132 I=1,NPTD 691 : J=MELEMS.NUM(1,I) 692 : R=XCOOR((J-1)*(IDIM+1) +1) 693 : VPOCHA(I,N)=VPOCHA(I,N)/(R + DR*EXP(-(R/DR))) 694 : 132 CONTINUE 695 : ENDIF 696 : 697 : 350 CONTINUE 698 : 699 : SEGSUP MPOVA3 700 : SEGDES IZBB 701 : SEGDES MELEME,MPOVAL 702 : C 703 : SEGSUP IZIPAD,IZIPAP,IZFFM,IZHR,IZF1,IZD,IZDD 704 : 705 : 360 CONTINUE 705 : CALL ECROBJ('CHPOINT ',MCHPOI) 706 : 707 : RETURN 708 : 709 : 1001 FORMAT(20(1X,I5)) 710 : 1002 FORMAT(10(1X,1PE11.4)) 711 : 1008 FORMAT(10(1X,A8)) 712 : 9999 CONTINUE 713 : END 714 : 715 : 716 : 717 : 718 : 719 : 720 : 721 : 722 : 723 : 724 : 725 : 726 : 727 : 728 : 729 : 730 : 731 : 732 : 733 : 734 : 735 : 736 : 737 : 738 : 739 : 740 :
© Cast3M 2003 - All rights reserved.
Disclaimer