1 : C KNOL SOURCE CHAT 11/03/16 21:26:14 6902 2 : SUBROUTINE KNOL 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C************************************************************************* 6 : C Operateur KNOL 7 : C 8 : C Objet Transforme un CHAMPOINT SOMMET en un CHAMPOINT CENTRE 9 : C 10 : C SYNTAXE : CHPC = KNOL TABDOM CHPS ; 11 : C 12 : C TABDOM : Table DOMAINE contenant les supports geometriques de CHPS 13 : C CHPS : CHAMPOINT SOMMET 14 : C CHPC : CHAMPOINT CENTRE 15 : C 16 : C 17 : C************************************************************************* 18 : -INC CCOPTIO 19 : -INC CCREEL 20 : -INC CCGEOME 21 : -INC SMCOORD 22 : -INC SMELEME 23 : POINTEUR MELEMS.MELEME,MELEMD.MELEME,SPGD.MELEME 24 : -INC SMMODEL 25 : -INC SMCHPOI 26 : POINTEUR IZB.MCHPOI,IZBB.MPOVAL 27 : -INC SMLENTI 28 : -INC SIZFFB 29 : POINTEUR IZF1.IZFFM,IZH2.IZHR,IZW.IZFFM,IZWH.IZHR 30 : SEGMENT SAJT 31 : REAL*8 AJT(IDIM,IDIM,NPG),RF1(NP,MP,IDIM),SM1(NP,IDIM) 32 : c REAL*8 TN1(NP,IDIM),TN2(NP,IDIM) 33 : ENDSEGMENT 34 : 35 : PARAMETER (NTO=4,NBMO=4) 36 : DIMENSION ITABO(NTO) 37 : CHARACTER*4 NOMD4 38 : CHARACTER*8 TYPE,TYPC,LISMO(NBMO),TYPSPG,MTERR,NOM0 39 : DATA LISMO/'CENTRE ',' ', 'CENTREP1','MSOMMET'/ 40 : C*** 41 : 42 : TYPSPG='CENTRE ' 42 : CALL INITI(ITABO,NTO,0) 43 : 4 CONTINUE 44 : 44 : CALL QUETYP(TYPE,0,IRET) 45 : c write(6,*)' Iret de Quetyp= ',iret,' TYPSPG=',typspg 46 : 47 : IF(IRET.EQ.0)THEN 48 : IF(TYPSPG.EQ.'MSOMMET '.OR.TYPSPG.EQ.'CENTRE '.OR. 49 : & TYPSPG.EQ.'CENTREP1'.OR.TYPSPG.EQ.' ')THEN 50 : IF(ITABO(1).EQ.1.AND.ITABO(2).EQ.1)GO TO 52 51 : 52 : IF(ITABO(1).NE.1)THEN 53 : C% Il faut spécifier un objet de type %m1:8 et de sous type %m9:16 54 : MOTERR(1: 8) = 'CHPOINT ' 55 : MOTERR(9:16) = 'DIFFUS ' 55 : CALL ERREUR(79) 56 : ENDIF 57 : 58 : IF(ITABO(2).NE.1)THEN 59 : C% Il faut spécifier un objet de type %m1:8 et de sous type %m9:16 60 : MOTERR(1: 8) = 'MMODEL ' 61 : MOTERR(9:16) = ' ' 61 : CALL ERREUR(79) 62 : ENDIF 63 : 64 : ENDIF 65 : RETURN 66 : ENDIF 67 : * 68 : * Lecture du CHPOIN 69 : * 70 : IF(TYPE.EQ.'CHPOINT')THEN 71 : IF(ITABO(1).NE.0)THEN 72 : C% On a déja lu un objet de type %m1:8 73 : MOTERR(1: 8) = 'CHPOINT ' 73 : CALL ERREUR(966) 74 : RETURN 75 : ENDIF 76 : ITABO(1)=1 77 : 77 : CALL LIROBJ('CHPOINT',IZB,1,IRETOU) 78 : SEGACT IZB 79 : IF(IZB.IPCHP(/1).NE.1)THEN 80 : C% Erreur dans le partitionnement 80 : CALL ERREUR(920) 81 : SEGDES IZB 82 : RETURN 83 : ENDIF 84 : GO TO 4 85 : ENDIF 86 : * 87 : * Lecture de l'objet modele 'Navier-Stokes' 88 : * 89 : C*** 90 : IF(TYPE.EQ.'MMODEL ')THEN 91 : IF(ITABO(2).NE.0)THEN 92 : C% On a déja lu un objet de type %m1:8 93 : MOTERR(1: 8) = 'MMODEL ' 94 : MOTERR(9:16) = ' ' 94 : CALL ERREUR(966) 95 : RETURN 96 : ENDIF 97 : ITABO(2)=1 98 : 98 : CALL LIROBJ('MMODEL ',MMODEL,1,IRET) 99 : SEGACT MMODEL 100 : N1=KMODEL(/1) 101 : DO 41 L=1,N1 102 : IMODEL=KMODEL(L) 103 : SEGACT IMODEL 104 : IF(FORMOD(1).NE.'NAVIER_STOKES')THEN 105 : IF(FORMOD(1).NE.'DARCY')THEN 106 : C% On veut un modèle de type %m1:16 . 107 : MOTERR( 1:16) = 'NAVIER_STOKES ' 107 : CALL ERREUR(719) 108 : RETURN 109 : ENDIF 110 : ENDIF 111 : SEGDES IMODEL 112 : 41 CONTINUE 113 : 113 : CALL LEKMOD(MMODEL,MTABD,INEFMD) 114 : C /S INEFMD : Type formulation INEFMD=1 LINE,=2 MACRO,=3 QUADRATIQUE 115 : C INEFMD=4 LINB 116 : C KPOIN = 0->SOMMET 1-> FACE 2-> CENTRE 3-> CENTREP0 4-> CENTREP1 5-> MSOMMET 117 : GO TO 4 118 : ENDIF 119 : * 120 : * Lecture de l'objet table DOMAINE 121 : * 122 : C*** 123 : IF(TYPE.EQ.'TABLE ')THEN 124 : IF(ITABO(4).NE.0)THEN 125 : C% On a déja lu un objet de type %m1:8 126 : MOTERR(1: 8) = 'TABLE ' 127 : MOTERR(9:16) = ' ' 127 : CALL ERREUR(966) 128 : RETURN 129 : ENDIF 130 : ITABO(2)=1 131 : 131 : CALL LIROBJ('TABLE ',MTABD,1,IRET) 132 : GO TO 4 133 : ENDIF 134 : * 135 : * Lecture d'un mot 136 : * 137 : IF(TYPE.EQ.'MOT ')THEN 137 : CALL LIRMOT(LISMO,NBMO,IP,1) 138 : TYPSPG=LISMO(IP) 139 : GO TO 4 140 : ENDIF 141 : 142 : 143 : 144 : 52 CONTINUE 145 : C 146 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 147 : C------------------ Traitement du cas MSOMMET --------------------------- 148 : 149 : IF(TYPSPG.EQ.'MSOMMET')THEN 149 : CALL LICHT(IZB,IZBB,TYPC,IGEOMB) 150 : NC=IZBB.VPOCHA(/2) 151 : TYPE=' ' 151 : CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS) 152 : IF(TYPE.NE.'MAILLAGE')GO TO 90 153 : 154 : C 155 : C On verifie Le support du CHP1 (SOMMET) 156 : C 156 : CALL KRIPAD(IGEOMB,MLENTI) 156 : CALL VERPAD(MLENTI,MELEMS,IRET) 157 : 158 : IF(IRET.NE.0)THEN 159 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 160 : MOTERR(1: 8) = 'SOMMET' 161 : MOTERR(9:16) = 'CHPOINT ' 162 : SEGSUP MLENTI 163 : RETURN 164 : ENDIF 165 : SEGSUP MLENTI 166 : SEGDES MELEMS 167 : 168 : TYPE=' ' 168 : CALL ACMO(MTABD,'MSOMMET',TYPE,MELEME) 169 : IF(TYPE.NE.'MAILLAGE')GO TO 90 170 : 170 : CALL ECROBJ('MAILLAGE',MELEME) 170 : CALL ECROBJ('CHPOINT',IZB) 170 : CALL REDU 171 : 172 : RETURN 173 : ENDIF 174 : C-------------- FIN Traitement du cas MSOMMET --------------------------- 175 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 176 : 177 : C 178 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 179 : C------------------ Traitement du cas CENTRE ---------------------------- 180 : 181 : IF(TYPSPG.EQ.'CENTRE')THEN 181 : CALL LICHT(IZB,IZBB,TYPC,IGEOMB) 182 : NC=IZBB.VPOCHA(/2) 183 : TYPE=' ' 183 : CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS) 184 : IF(TYPE.NE.'MAILLAGE')GO TO 90 185 : 186 : 187 : 187 : CALL KRIPAD(IGEOMB,MLENTI) 187 : CALL VERPAD(MLENTI,MELEMS,IRET) 188 : 189 : IF(IRET.NE.0)THEN 190 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 191 : MOTERR(1: 8) = 'SOMMET' 192 : MOTERR(9:16) = 'CHPOINT ' 193 : SEGSUP MLENTI 194 : RETURN 195 : ENDIF 196 : 197 : TYPE=' ' 197 : CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC) 198 : IF(TYPE.NE.'MAILLAGE')GO TO 90 199 : 200 : TYPE=' ' 200 : CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME) 201 : IF(TYPE.NE.'MAILLAGE')GO TO 90 202 : 203 : 204 : TYPE='CENTRE' 205 : c write(6,*)' Apparemment on traite le cas centre !!!' 205 : CALL CRCHPT(TYPE,MELEMC,NC,MCHPOI) 205 : CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM) 206 : 207 : SEGACT MELEME 208 : 209 : NBSOUS=LISOUS(/1) 210 : IF(NBSOUS.EQ.0)NBSOUS=1 211 : 212 : KK=0 213 : DO 1 L=1,NBSOUS 214 : IPT1=MELEME 215 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 216 : SEGACT IPT1 217 : NP=IPT1.NUM(/1) 218 : NEL=IPT1.NUM(/2) 219 : DO 10 K=1,NEL 220 : KK=KK+1 221 : DO 13 N=1,NC 222 : UU=0.D0 223 : DO 12 I=1,NP 224 : IU=LECT(IPT1.NUM(I,K)) 225 : UU=UU+IZBB.VPOCHA(IU,N) 226 : 12 CONTINUE 227 : VPOCHA(KK,N)=UU/FLOAT(NP) 228 : 13 CONTINUE 229 : 230 : 10 CONTINUE 231 : SEGDES IPT1 232 : 1 CONTINUE 233 : SEGDES IZB,IZBB 234 : SEGDES MELEME,MPOVAL,MCHPOI 235 : C 236 : SEGSUP MLENTI 236 : CALL ECROBJ('CHPOINT ',MCHPOI) 237 : 238 : RETURN 239 : ENDIF 240 : C-------------- FIN Traitement du cas CENTRE ---------------------------- 241 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 242 : 243 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 244 : C------------------ Traitement du cas CENTREP1 -------------------------- 245 : 246 : IF(TYPSPG.EQ.'CENTREP1')THEN 247 : 248 : MTERR='EF CTRP1' 249 : IF(INEFMD.EQ.2)NOMD4='MCP1' 250 : IF(INEFMD.EQ.3)NOMD4='PRP1' 251 : IF(INEFMD.NE.2.AND.INEFMD.NE.3)THEN 252 : C Option %m1:8 incompatible avec les données 253 : MOTERR( 1: 8) = MTERR 253 : CALL ERREUR(803) 254 : RETURN 255 : ENDIF 256 : 256 : CALL LEKTAB(MTABD,'CENTREP1',SPGD) 256 : CALL LEKTAB(MTABD,'ELTP1NC ',MELEMD) 257 : 258 : 258 : CALL LICHT(IZB,IZBB,TYPC,IGEOMB) 259 : NC=IZBB.VPOCHA(/2) 260 : TYPE=' ' 260 : CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS) 261 : IF(TYPE.NE.'MAILLAGE')GO TO 90 262 : 263 : 263 : CALL KRIPAD(IGEOMB,MLENT1) 263 : CALL VERPAD(MLENT1,MELEMS,IRET) 264 : 265 : IF(IRET.NE.0)THEN 266 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 267 : MOTERR(1: 8) = 'SOMMET' 268 : MOTERR(9:16) = 'CHPOINT ' 269 : SEGSUP MLENTI 270 : RETURN 271 : ENDIF 272 : 273 : TYPE=' ' 273 : CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME) 274 : IF(TYPE.NE.'MAILLAGE')GO TO 90 275 : 275 : IF(INEFMD.EQ.2)CALL LEKTAB(MTABD,'MACRO1',MELEME) 276 : IF (IERR.NE.0) RETURN 277 : 278 : TYPE='CENTREP1' 279 : c write(6,*)' Apparemment on traite le cas centrep1 !!!' 279 : CALL CRCHPT(TYPE,SPGD,NC,MCHPOI) 279 : CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM) 280 : c.......................................................................... 281 : 282 : 283 : c IK3=0 284 : IAXI=0 285 : IF(IFOMOD.EQ.0)IAXI=2 286 : DEUPI=1.D0 287 : IF(IAXI.NE.0)DEUPI=2.D0*XPI 288 : 289 : NC=MPOVAL.VPOCHA(/2) 289 : CALL KRIPAD(SPGD,MLENTI) 290 : 291 : SEGACT MELEME 292 : 293 : NKD=0 294 : DO 101 L=1,MAX(1,LISOUS(/1)) 295 : SEGACT MELEMD 296 : IPT1=MELEME 297 : IPT2=MELEMD 298 : IF(LISOUS(/1).NE.0)IPT1=LISOUS(L) 299 : SEGACT IPT1 300 : IF(MELEMD.LISOUS(/1).NE.0)THEN 301 : IPT2=MELEMD.LISOUS(L) 302 : NKD=0 303 : ENDIF 304 : SEGACT IPT2 305 : MP=IPT2.NUM(/1) 306 : 307 : NOM0 = NOMS(IPT1.ITYPEL)//NOMD4 308 : c write(6,*)' KNOL 1er KALPBG NOM0=',NOM0,IPT1 308 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 309 : IF(IZFFM.EQ.0)RETURN 310 : SEGACT IZFFM*MOD 311 : IZHR=KZHR(1) 312 : SEGACT IZHR*MOD 313 : IZF1 = KTP(1) 314 : IZH2 = KZHR(2) 315 : IZW = IZF1 316 : SEGACT IZW*MOD 317 : IF(MP.NE.IZW.FN(/1))THEN 318 : write(6,*)' Gross problem ds KNOL ' 319 : write(6,*)' NOM0=',NOM0 ,' NOMD4=',NOMD4 320 : write(6,*)' MP=',MP,' IZW.FN(/1)=' 321 : & ,IZW.FN(/1) 322 : return 323 : ENDIF 324 : 325 : NES=GR(/1) 326 : NPG=GR(/3) 327 : NP = IPT1.NUM(/1) 328 : NBEL=IPT1.NUM(/2) 329 : SEGINI SAJT 330 : c write(6,*)' AVANT 108 NC=',NC,' NBEL=',NBEL,MP,NP,NC 331 : c write(6,*)' AVANT 108 IK4=',IK4 332 : DO 108 KE=1,NBEL 333 : 334 : NKD=NKD+1 335 : 336 : DO 109 I=1,NP 337 : J=IPT1.NUM(I,KE) 338 : DO 109 N=1,IDIM 339 : XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N) 340 : 109 CONTINUE 341 : 341 : CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES, 342 : * IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) 343 : 343 : CALL INITD(SM1,(MP*IDIM),0.D0) 344 : 345 : C======================================================================= 346 : 347 : C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 348 : C...... Source 349 : DO 710 I=1,MP 350 : U2=0.D0 351 : U4=0.D0 352 : DO 717 N=1,NC 353 : DO 715 LG=1,NPG 354 : WT=IZW.FN(I,LG) 355 : U4=U4+WT*PGSQ(LG)*DEUPI*RPG(LG) 356 : UJ=0.D0 357 : DO 714 J=1,NP 358 : JU=MLENT1.LECT(IPT1.NUM(J,KE)) 359 : UJ=UJ+FN(J,LG)*IZBB.VPOCHA(JU,N) 360 : 714 CONTINUE 361 : U2=U2+UJ*WT*PGSQ(LG)*DEUPI*RPG(LG) 362 : 715 CONTINUE 363 : 364 : SM1(I,N)=SM1(I,N)+(U2/U4) 365 : 717 CONTINUE 366 : 710 CONTINUE 367 : c write(6,*)' SM1 *****' 368 : c do 711 n=1,nc 369 : c write(6,1002)(sm1(i,n),i=1,mp) 370 : c711 continue 371 : C...... Source Fin 372 : C======================================================================= 373 : 374 : 375 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 376 : C ...... Chargement Second membre 377 : DO 910 I=1,MP 378 : I1=LECT(IPT2.NUM(I,NKD)) 379 : DO 910 N=1,NC 380 : VPOCHA(I1,N)=VPOCHA(I1,N)+SM1(I,N) 381 : 910 CONTINUE 382 : C<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 383 : 384 : 108 CONTINUE 385 : 386 : 387 : SEGDES IPT1,IPT2 388 : 389 : SEGSUP IZFFM,IZHR,IZF1,IZH2 390 : SEGSUP SAJT 391 : 392 : 101 CONTINUE 393 : SEGSUP MLENTI 394 : 395 : c.......................................................................... 396 : SEGSUP MLENTI,MLENT1 396 : CALL ECROBJ('CHPOINT ',MCHPOI) 397 : 398 : RETURN 399 : ENDIF 400 : C-------------- FIN Traitement du cas CENTREP1 -------------------------- 401 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 402 : 403 : 404 : 90 CONTINUE 405 : WRITE(6,*)'Interruption anormale de KLNO ' 406 : RETURN 407 : 408 : 1001 FORMAT(20(1X,I5)) 409 : 1002 FORMAT(10(1X,1PE11.4)) 410 : 1008 FORMAT(10(1X,A8)) 411 : END 412 : 413 : 414 : 415 : 416 : 417 : 418 : 419 : 420 : 421 : 422 : 423 : 424 : 425 : 426 :
© Cast3M 2003 - All rights reserved.
Disclaimer