1 : C YFROT SOURCE PV 09/03/12 21:37:49 6325 2 : SUBROUTINE YFROT 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C 7 : C CE SP DISCRETISE LE TERME DE PERTE DE CHARGE DANS LES EQUATIONS DE 8 : C NAVIER STOKES 9 : C EN 2D SUR LES ELEMENTS QUA4 ET TRI3 PLAN OU AXI 10 : C EN 3D SUR LES ELEMENTS CUB8 ET PRI6 11 : C L OPERATEUR EST DIAGONAL 12 : C 13 : C SYNTAXE : 14 : C 15 : C FROT K BINCO UN : 16 : C 17 : C COMMENTAIRES : 18 : C -------------- 19 : C 20 : C UN CHAMPS DE VITESSE TRANSPORTANT 21 : C VO CHAMPS DE VITESSE DE REFFERENCE 22 : C K (VECT ) Coefficient 23 : C (VECT CENTRE) 24 : C B (VECT ) exposant 25 : C (VECT CENTRE) 26 : C 27 : C*********************************************************************** 28 : 29 : -INC CCOPTIO 30 : -INC SMCHAML 31 : -INC SMLENTI 32 : POINTEUR IZIPAD.MLENTI 33 : -INC SMELEME 34 : POINTEUR MELEM1.MELEME 35 : -INC SMCHPOI 36 : POINTEUR MCHPIN.MCHPOI 37 : POINTEUR IZG1.MCHPOI 38 : POINTEUR IZGG.MPOVAL,IZGG1.MPOVAL,IZTU1.MPOVAL 39 : POINTEUR MZK.MPOVAL,MZBETA.MPOVAL,MZV0.MPOVAL 40 : -INC SMLMOTS 41 : POINTEUR LINCO.MLMOTS 42 : CHARACTER*8 NOMZ,NOMI,TYPE,MARG,TYPC 43 : DIMENSION IXV(3) 44 : LOGICAL LOGI 45 : PARAMETER (NTB=1) 46 : CHARACTER*8 LTAB(NTB) 47 : DIMENSION KTAB(NTB) 48 : SAVE IPAS 49 : DATA LTAB/'KIZX '/,IPAS/0/ 50 : C***************************************************************************** 51 : CFROT 52 : C write(6,*)' DEBUT FROT' 53 : 53 : CALL LITABS(LTAB,KTAB,NTB,1,IRET) 54 : IF(IRET.EQ.0)THEN 55 : WRITE(6,*)' Operateur FROT ' 56 : WRITE(6,*)' On attend un ensemble de table soustypes' 57 : RETURN 58 : ENDIF 59 : MTABX=KTAB(1) 60 : 60 : CALL LEKTAB(MTABX,'EQEX',MTAB1) 61 : IF(MTAB1.EQ.0)THEN 62 : WRITE(6,*)' Operateur FROT ' 63 : WRITE(6,*)' On ne trouve pas l''indice EQEX ? ' 64 : RETURN 65 : ENDIF 66 : 66 : CALL LEKTAB(MTAB1,'INCO',KINC) 67 : IF(KINC.EQ.0)THEN 68 : WRITE(6,*)' Operateur FROT ' 69 : WRITE(6,*)' Il n''y a pas de table INCO ? ?.' 70 : RETURN 71 : ENDIF 72 : 73 : C***************************************************************************** 74 : C OPTIONS 75 : 76 : KIMPL=0 77 : KFORM=0 78 : IAXI=0 79 : IF(IFOMOD.EQ.0)IAXI=2 80 : KOPTI=0 81 : TYPE=' ' 81 : CALL ACMO(MTABX,'KOPT',TYPE,IENT) 82 : IF(TYPE.EQ.'TABLE')KOPTI=IENT 83 : IF(KOPTI.NE.0)THEN 84 : TYPE=' ' 84 : CALL ACMO(KOPTI,'KIMPL',TYPE,IENT) 84 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'KIMPL',KIMPL) 85 : TYPE=' ' 85 : CALL ACMO(KOPTI,'KFORM',TYPE,IENT) 85 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'KFORM',KFORM) 86 : IF(KFORM.NE.0.AND.KIMPL.EQ.0)THEN 87 : WRITE(6,*)' Operateur FROT ' 88 : WRITE(6,*)' Seule la formulation EFM1 est autorisée' 89 : RETURN 90 : ENDIF 91 : 92 : ENDIF 93 : C***************************************************************************** 94 : 94 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 94 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 95 : IF(MTABZ.EQ.0)THEN 96 : WRITE(6,*)' Operateur FROT ' 97 : WRITE(6,*)' On ne trouve pas l''indice DOMZ ? ' 98 : GO TO 90 99 : ENDIF 100 : 100 : CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) 101 : IF(MELEME.EQ.0)GO TO 90 102 : 102 : CALL LEKTAB(MTABZ,'XXPSOML',MCHELM) 103 : IF(MCHELM.EQ.0)GO TO 90 104 : SEGACT MCHELM 105 : 106 : C*** 107 : 108 : TYPE='LISTMOTS' 108 : CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) 109 : SEGACT LINCO 110 : 111 : C************************************************************************* 111 : C! CALL LEKTAB(MTAB1,'DOMAINE',MTABD) 112 : C! IF(MTABD.EQ.0)THEN 113 : C! WRITE(6,*)' Operateur FROT ' 114 : C! WRITE(6,*)' On ne trouve pas l''indice DOMAINE ?' 115 : C! GO TO 90 116 : C! ENDIF 117 : 117 : C! CALL LEKTAB(MTABD,'SOMMET',MELEM1) 118 : C! IF(MELEM1.EQ.0)THEN 119 : C! WRITE(6,*)' Operateur FROT ' 120 : C! WRITE(6,*)' On ne trouve pas l''indice SOMMET ?' 121 : C! GO TO 90 122 : C! ENDIF 123 : 123 : CALL LEKTAB(MTAB1,'INCO',INCO) 124 : IF(INCO.EQ.0)THEN 125 : WRITE(6,*)' Operateur FROT ' 126 : WRITE(6,*)'Il n''y a pas de table INCO ' 127 : RETURN 128 : ENDIF 129 : 129 : CALL LEKTAB(MTAB1,'KIZG',KIZG) 130 : IF(KIZG.EQ.0)THEN 130 : CALL CRTABL(KIZG) 130 : CALL ECMM(KIZG,'SOUSTYPE','KIZG') 130 : CALL ECMO(MTAB1,'KIZG','TABLE ',KIZG) 131 : ENDIF 132 : IF(KIMPL.EQ.1)THEN 132 : CALL LEKTAB(MTAB1,'KIZG1',KIZG1) 133 : IF(KIZG1.EQ.0)THEN 133 : CALL CRTABL(KIZG1) 133 : CALL ECMM(KIZG1,'SOUSTYPE','KIZG1') 133 : CALL ECMO(MTAB1,'KIZG1','TABLE ',KIZG1) 134 : ENDIF 135 : ENDIF 136 : 137 : C VERIFICATIONS SUR LES INCONNUES 138 : NBINC=LINCO.MOTS(/2) 139 : IF(NBINC.NE.1)THEN 140 : WRITE(6,*)' Operateur FROT ' 141 : WRITE(6,*)'Nombre d''inconnues incorrecte : ',NBINC,' On attend 1' 142 : RETURN 143 : ENDIF 144 : 145 : NOMI=LINCO.MOTS(1) 146 : 147 : TYPE=' ' 147 : CALL ACMO(INCO,NOMI,TYPE,MCHPOI) 148 : IF(TYPE.NE.'CHPOINT ')THEN 149 : WRITE(6,*)' Operateur FROT ' 150 : WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table' 151 : RETURN 152 : ELSE 152 : CALL LICHT(MCHPOI,IZTU1,TYPC,MELEM1) 153 : MCHPIN=MCHPOI 154 : NINKO = IZTU1.VPOCHA(/2) 155 : NPTI = IZTU1.VPOCHA(/1) 156 : IF (NINKO.NE.IDIM) THEN 157 : C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes 158 : MOTERR( 1: 8) = 'INC '//NOMI 159 : MOTERR( 9:16) = 'CHPOINT ' 159 : CALL ERREUR(784) 160 : RETURN 161 : ENDIF 162 : ENDIF 163 : 164 : C************************************************************************* 165 : C Le domaine de definition est donne par le SPG de la premiere inconnue 166 : C Les inconnues suivantes devront posseder ce meme pointeur 167 : C On verifie que les points de la zone sont tous inclus dans ce SPG 168 : 168 : CALL KRIPAD(MELEM1,IZIPAD) 169 : 170 : IF(IPAS.EQ.0)THEN 170 : CALL VERPAD(IZIPAD,MELEME,IRET) 171 : IF(IRET.NE.0)THEN 172 : WRITE(6,*)' Opérateur FROT ' 173 : WRITE(6,*)' La zone ',NOMZ,' n''est pas incluse dans le domaine' 174 : GO TO 90 175 : ENDIF 176 : ENDIF 177 : 178 : C***************************************************************************** 179 : C************************************************************************* 180 : IF(KFORM.EQ.1)THEN 181 : IHV=1 181 : CALL YFRT('FROT ',MTABX,IHV,MCHPIN,NOMI,MATRIK,MCHPO1) 181 : CALL ECROBJ('MATRIK',MATRIK) 181 : CALL ECROBJ('CHPOINT',MCHPO1) 182 : RETURN 183 : ENDIF 184 : 185 : C************************************************************************* 186 : C Lecture du coefficient 187 : C Type du coefficient : 188 : C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur 189 : 190 : C write(6,*)' Operateur FROT lecture des coefficients' 190 : CALL ACME(MTABX,'IARG',IARG) 191 : 192 : IF(IARG.NE.2.AND.IARG.NE.3)THEN 193 : WRITE(6,*)' Operateur FROT ' 194 : WRITE(6,*)' Nombre d''arguments incorrect : ',IARG 195 : WRITE(6,*)' On attend 2 ou 3 ' 196 : RETURN 197 : ENDIF 198 : TYPE=' ' 198 : CALL ACMO(MTABZ,'CENTRE',TYPE,MELEMC) 198 : CALL ACMO(MTABZ,'SOMMET',TYPE,MELEMS) 199 : 200 : IXV(1)=-MELEMC 201 : IXV(2)=0 202 : IXV(3)=1 202 : CALL LEKCOF('Opérateur FROT :', 203 : & MTABX,KINC,1,IXV,MK,MZK,NPK,NC1,IKK,IRET) 204 : IF(IRET.EQ.0)RETURN 205 : IF(IKK.EQ.2)IKK=1 206 : 207 : IXV(1)=-MELEMC 208 : IXV(2)=0 209 : IXV(3)=1 209 : CALL LEKCOF('Opérateur FROT :', 210 : & MTABX,KINC,2,IXV,MBETA,MZBETA,NBETA,NC2,IKB,IRET) 211 : IF(IRET.EQ.0)RETURN 212 : IF(IKB.EQ.2)IKB=1 213 : 214 : 215 : IF(IARG.EQ.3)THEN 216 : IXV(1)=-MELEMS 217 : IXV(2)=0 218 : IXV(3)=1 218 : CALL LEKCOF('Opérateur FROT :', 219 : & MTABX,KINC,3,IXV,IZTG3,MZV0,NV0,NC3,IKV,IRET) 220 : IF(IRET.EQ.0)RETURN 221 : IF(IKV.EQ.2)IKV=1 222 : ELSE 223 : Nu=3 224 : WRITE(MARG,FMT='(A4,I1)')'ARGS',Nu 224 : CALL LEKTAB(MTABX,MARG,MCHPOI) 224 : CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM0) 225 : VPOCHA(1,1)=0.D0 226 : VPOCHA(1,2)=0.D0 227 : IF(IDIM.EQ.3)VPOCHA(1,3)=0.D0 228 : MZV0=MPOVAL 229 : NV0=1 230 : IKV=1 231 : ENDIF 232 : 233 : C Fin lecture Arguments ************************************************ 234 : 235 : TYPE=' ' 235 : CALL ACMO(KIZG,NOMI,TYPE,IZG) 236 : IF(TYPE.NE.'CHPOINT ')THEN 237 : NC=IZTU1.VPOCHA(/2) 238 : TYPE='SOMMET' 238 : CALL CRCHPT(TYPE,MELEM1,NC,IZG) 238 : CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG) 239 : ENDIF 239 : CALL LICHT(IZG,IZGG,TYPC,IGEOM) 240 : IF(IGEOM.NE.MELEM1)THEN 241 : WRITE(6,*)' Opérateur FROT' 242 : WRITE(6,*)' Incompatibilité de SPG entre 1ères inconnues' 243 : RETURN 244 : ENDIF 245 : 246 : IF(KIMPL.EQ.1)THEN 247 : TYPE=' ' 247 : CALL ACMO(KIZG1,NOMI,TYPE,IZG1) 248 : IF(TYPE.NE.'CHPOINT ')THEN 249 : NC=IZTU1.VPOCHA(/2) 250 : TYPE='SOMMET' 250 : CALL CRCHPT(TYPE,MELEM1,NC,IZG1) 250 : CALL ECMO(KIZG1,NOMI,'CHPOINT ',IZG1) 251 : ENDIF 251 : CALL LICHT(IZG1,IZGG1,TYPC,IGEOM) 252 : IF(IGEOM.NE.MELEM1)THEN 253 : WRITE(6,*)' Opérateur FROT' 254 : WRITE(6,*)' Incompatibilité de SPG entre 1ères inconnues' 255 : RETURN 256 : ENDIF 257 : 258 : ELSE 259 : IZGG1=IZGG 260 : ENDIF 261 : 262 : NPT=IZGG1.VPOCHA(/1) 263 : 264 : SEGACT MELEME 265 : NBSOUS=LISOUS(/1) 266 : IF(NBSOUS.EQ.0)NBSOUS=1 267 : NUTOEL=0 268 : DT=1.E30 269 : 270 : DO 1 L=1,NBSOUS 271 : IPT1=MELEME 272 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 273 : SEGACT IPT1 274 : 275 : MCHAML=ICHAML(L) 276 : SEGACT MCHAML 277 : MELVAL=IELVAL(1) 278 : SEGACT MELVAL 279 : 280 : IF(IMACHE(L).NE.IPT1)THEN 281 : write(*,*)'IPT1,IMACHE ',IPT1,IMACHE(L) 282 : goto 90 283 : ENDIF 284 : 285 : NP =IPT1.NUM(/1) 286 : NBEL=IPT1.NUM(/2) 287 : IES=IDIM 288 : 288 : CALL YFRTI(VELCHE,IPT1.NUM,NBEL,NUTOEL,NPT,IES,NP,IAXI, 289 : & IZIPAD.LECT,KIMPL, 290 : & MZK.VPOCHA,NPK,IKK, 291 : & MZBETA.VPOCHA,NBETA,IKB, 292 : & MZV0.VPOCHA,NV0,IKV, 293 : & IZTU1.VPOCHA,IZGG.VPOCHA,IZGG1.VPOCHA) 294 : 295 : SEGDES IPT1 296 : NUTOEL=NUTOEL+NBEL 297 : 298 : 1 CONTINUE 299 : 300 : SEGDES IZTU1 301 : SEGDES LINCO 302 : SEGSUP IZIPAD 303 : IPAS=1 304 : RETURN 305 : 90 CONTINUE 306 : WRITE(6,*)' Interuption anormale de FROT' 307 : RETURN 308 : 1002 FORMAT(10(1X,1PE11.4)) 309 : END 310 : 311 : 312 : 313 : 314 : 315 : 316 :
© Cast3M 2003 - All rights reserved.
Disclaimer