1 : C ZFPU SOURCE CHAT 05/01/13 04:22:55 5004 2 : SUBROUTINE ZFPU(MTABX,MTAB1) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C 7 : C SYNTAXE : 8 : C 9 : C FPU NU UET YP <,VPAROI> 10 : C 11 : C 1------2 12 : C (R1,AL1) LEF FLUIDE NOEUDS 1 2 13 : C 14 : C 15 : C ANU VISCOSITE CINEMATIQUE 16 : C UET U* 17 : C YP DISTANCE A LA PAROI 18 : C VPAROI VITESSE DE LA PAROI (PAR DEFAUT 0.) 19 : C 20 : C CAS TRIDIMENSIONNEL 21 : C 4 ________ 3 22 : C / FLUIDE / 23 : C 1 /________/2 24 : C 25 : C 26 : C*********************************************************************** 27 : 28 : -INC CCVQUA4 29 : -INC CCOPTIO 30 : -INC SMCOORD 31 : -INC SMLENTI 32 : -INC SMELEME 33 : POINTEUR MELEM1.MELEME 34 : -INC SMCHPOI 35 : POINTEUR IZG1.MCHPOI, IZGG1.MPOVAL 36 : POINTEUR IZD2.MCHPOI, IZDD2.MPOVAL 37 : POINTEUR IZD3.MCHPOI, IZDD3.MPOVAL 38 : POINTEUR IZTU1.MPOVAL,IZTU2.MPOVAL,IZTU3.MPOVAL 39 : POINTEUR MZNU.MPOVAL,MZUE.MPOVAL,MZYP.MPOVAL 40 : POINTEUR IZVOL.MPOVAL 41 : 42 : -INC SMTABLE 43 : POINTEUR KIZG.TABLE,MTABX.MTABLE,OPTI.MTABLE 44 : POINTEUR INCO.TABLE,KOPT.MTABLE,KIZD.MTABLE 45 : POINTEUR MTABZ.MTABLE,MTABD.MTABLE 46 : -INC SMLMOTS 47 : POINTEUR LINCO.MLMOTS 48 : CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,CHAI,TYPC 49 : LOGICAL LOGI 50 : PARAMETER (NTB=1) 51 : CHARACTER*8 LTAB(NTB) 52 : DIMENSION KTAB(NTB),IXV(3) 53 : DATA LTAB/'KIZX '/ 54 : C***************************************************************************** 55 : CFPU 56 : C write(6,*)' debut FPU ' 56 : CALL LEKTAB(MTAB1,'INCO',KINC) 57 : IF(KINC.EQ.0)THEN 58 : WRITE(6,*)' Opérateur NSKE :' 59 : WRITE(6,*)' Il n''y a pas de table INCO ? ?.' 60 : RETURN 61 : ENDIF 62 : 63 : C***************************************************************************** 64 : C OPTIONS 65 : C CES PARAMETRES SONT INITIALISES POUR ETRE EN DECENTRE 66 : IKOMP=0 67 : IAXI=0 68 : IF(IFOMOD.EQ.0)IAXI=2 68 : C CALL LEKTAB(MTABX,'KOPT',OPTI) 69 : KOPTI=0 70 : TYPE=' ' 70 : CALL ACMO(MTABX,'KOPT',TYPE,IENT) 71 : IF(TYPE.EQ.'TABLE')KOPTI=IENT 72 : IF(KOPTI.NE.0)THEN 73 : TYPE=' ' 73 : CALL ACMO(KOPTI,'PRECAU',TYPE,IENT) 73 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'PRECAU',IPRE) 74 : TYPE=' ' 74 : CALL ACMO(KOPTI,'IKOMP',TYPE,IENT) 74 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'IKOMP',IKOMP) 75 : 76 : ENDIF 77 : C***************************************************************************** 78 : 78 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 78 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 79 : IF(MTABZ.EQ.0)THEN 80 : WRITE(6,*)' On ne trouve pas l''indice DOMZ ? ' 81 : GO TO 90 82 : ENDIF 83 : SEGACT MTABZ 84 : 84 : CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) 85 : IF(MELEME.EQ.0)GO TO 90 86 : SEGACT MELEME 87 : 87 : CALL LEKTAB(MTABZ,'CENTRE',MELEMC) 88 : IF(MELEMC.EQ.0)GO TO 90 89 : 89 : CALL LEKTAB(MTABZ,'XXVOLUM',MCHPOI) 90 : IF(MCHPOI.EQ.0)GO TO 90 90 : CALL LICHT(MCHPOI,IZVOL,TYPC,IGEOM) 91 : C*** 92 : 93 : TYPE='LISTMOTS' 93 : CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) 94 : SEGACT LINCO 95 : 95 : CALL ACME(MTABX,'IARG',IARG) 96 : IKOMP=0 97 : 98 : C--Cas incompréssible 99 : IF(IKOMP.EQ.0)THEN 100 : C 1er coefficient : nu 101 : IXV(1)=MELEMC 102 : IXV(2)=1 103 : IXV(3)=0 103 : CALL LEKCOF('Opérateur FPU :', 104 : & MTABX,KINC,1,IXV,MNU,MZNU,NPT1,NC1,IK1,IRET) 105 : IF(IRET.EQ.0)RETURN 106 : 107 : C 2ème coefficient : uet 108 : IXV(1)=MELEMC 109 : IXV(2)=0 110 : IXV(3)=0 110 : CALL LEKCOF('Opérateur FPU :', 111 : & MTABX,KINC,2,IXV,MUE,MZUE,NPT2,NC2,IK2,IRET) 112 : IF(IRET.EQ.0)RETURN 113 : 114 : C 3ème coefficient : yp 115 : IXV(1)=0 116 : IXV(2)=1 117 : IXV(3)=0 117 : CALL LEKCOF('Opérateur FPU :', 118 : & MTABX,KINC,3,IXV,MYP,MZYP,NPT3,NC3,IK3,IRET) 119 : IF(IRET.EQ.0)RETURN 120 : 121 : 122 : 123 : 124 : 125 : 126 : 127 : 128 : C--Cas compréssible 129 : ELSEIF(IKOMP.EQ.1)THEN 130 : C 1er coefficient : mu 131 : IXV(1)=MELEMC 132 : IXV(2)=1 133 : IXV(3)=0 133 : CALL LEKCOF('Opérateur FPU :', 134 : & MTABX,KINC,1,IXV,MNU,MZNU,NPT1,NC1,IK1,IRET) 135 : IF(IRET.EQ.0)RETURN 136 : 137 : C 2ème coefficient : uet 138 : IXV(1)=MELEMC 139 : IXV(2)=0 140 : IXV(3)=0 140 : CALL LEKCOF('Opérateur FPU :', 141 : & MTABX,KINC,2,IXV,MUE,MZUE,NPT2,NC2,IK2,IRET) 142 : IF(IRET.EQ.0)RETURN 143 : 144 : ENDIF 145 : 145 : CALL LEKTAB(MTABX,'EQEX',MTAB1) 146 : IF(MTAB1.EQ.0)THEN 147 : WRITE(6,*)' On ne trouve pas l''indice EQEX ? ' 148 : GO TO 90 149 : ENDIF 150 : SEGACT MTAB1 150 : CALL LEKTAB(MTAB1,'DOMAINE',MTABD) 151 : IF(MTABD.EQ.0)THEN 152 : WRITE(6,*)' On ne trouve pas l''indice DOMAINE ?' 153 : GO TO 90 154 : ENDIF 155 : SEGACT MTABD 155 : CALL LEKTAB(MTABD,'SOMMET',MELEM1) 156 : IF(MELEM1.EQ.0)THEN 157 : WRITE(6,*)' On ne trouve pas l''indice SOMMET ?' 158 : GO TO 90 159 : ENDIF 160 : 160 : CALL LEKTAB(MTAB1,'INCO',INCO) 161 : IF(INCO.EQ.0)THEN 162 : WRITE(6,*)'Il n''y a pas de table INCO ' 163 : RETURN 164 : ENDIF 165 : SEGACT INCO 166 : 166 : CALL LEKTAB(MTAB1,'KIZD',KIZD) 167 : IF(KIZD.EQ.0)THEN 168 : WRITE(6,*)'Il n''y a pas de table KIZD ' 169 : RETURN 170 : ENDIF 171 : SEGACT KIZD 172 : 172 : CALL KRIPAD(MELEM1,MLENTI) 173 : 174 : C***************************************************************************** 175 : 175 : CALL LEKTAB(MTAB1,'KIZG',KIZG) 176 : IF(KIZG.EQ.0)THEN 176 : CALL CRTABL(KIZG) 176 : CALL ECMM(KIZG,'SOUSTYPE','KIZG') 176 : CALL ECMO(MTAB1,'KIZG','TABLE ',KIZG) 177 : ELSE 178 : SEGACT KIZG 179 : ENDIF 180 : 181 : C VERIFICATIONS SUR LES INCONNUES 182 : NBINC=LINCO.MOTS(/2) 183 : IF(NBINC.NE.3)THEN 184 : WRITE(6,*)'Nombre d''inconnues incorrecte : ',NBINC,' On attend 3' 185 : RETURN 186 : ENDIF 187 : 188 : C --> 1 ere Inconnue 189 : 190 : NOMI=LINCO.MOTS(1) 191 : 192 : TYPE=' ' 192 : CALL ACMO(INCO,NOMI,TYPE,MCHPOI) 193 : IF(TYPE.NE.'CHPOINT ')THEN 194 : WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table' 195 : RETURN 196 : ELSE 196 : CALL LICHT(MCHPOI,IZTU1,TYPC,IGEOM0) 197 : ENDIF 198 : 199 : TYPE=' ' 199 : CALL ACMO(KIZG,NOMI,TYPE,IZG1) 200 : IF(TYPE.NE.'CHPOINT ')THEN 201 : NC=IZTU1.VPOCHA(/2) 202 : TYPE='SOMMET' 202 : CALL CRCHPT(TYPE,IGEOM0,NC,IZG1) 202 : CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG1) 203 : ENDIF 204 : 204 : CALL LICHT(IZG1,IZGG1,TYPC,IGEOM) 205 : 206 : C --> 2 eme Inconnue 207 : 208 : NOMI=LINCO.MOTS(2) 209 : 210 : TYPE=' ' 210 : CALL ACMO(INCO,NOMI,TYPE,MCHPOI) 211 : IF(TYPE.NE.'CHPOINT ')THEN 212 : WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table' 213 : RETURN 214 : ELSE 214 : CALL LICHT(MCHPOI,IZTU2,TYPC,IGEOM0) 215 : ENDIF 216 : 217 : TYPE=' ' 217 : CALL ACMO(KIZD,NOMI,TYPE,IZD2) 218 : IF(TYPE.NE.'CHPOINT ')THEN 219 : WRITE(6,*)' Il n''y a pas de diagonale associee a ',NOMI 220 : RETURN 221 : ENDIF 222 : 222 : CALL LICHT(IZD2,IZDD2,TYPC,IGEOM) 223 : 224 : C --> 3 eme Inconnue 225 : 226 : NOMI=LINCO.MOTS(3) 227 : 228 : TYPE=' ' 228 : CALL ACMO(INCO,NOMI,TYPE,MCHPOI) 229 : IF(TYPE.NE.'CHPOINT ')THEN 230 : WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table' 231 : RETURN 232 : ELSE 232 : CALL LICHT(MCHPOI,IZTU3,TYPC,IGEOM0) 233 : ENDIF 234 : 235 : TYPE=' ' 235 : CALL ACMO(KIZD,NOMI,TYPE,IZD3) 236 : IF(TYPE.NE.'CHPOINT ')THEN 237 : WRITE(6,*)' Il n''y a pas de diagonale associee a ',NOMI 238 : RETURN 239 : ENDIF 240 : 240 : CALL LICHT(IZD3,IZDD3,TYPC,IGEOM) 241 : 242 : 243 : SEGACT MELEME 244 : NBSOUS=LISOUS(/1) 245 : IF(NBSOUS.EQ.0)NBSOUS=1 246 : NUTOEL=0 247 : 248 : NPTD=IZTU1.VPOCHA(/1) 249 : IES=IDIM 250 : 251 : DO 1 L=1,NBSOUS 252 : IPT1=MELEME 253 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 254 : SEGACT IPT1 255 : 256 : NP =IPT1.NUM(/1) 257 : NBEL=IPT1.NUM(/2) 258 : 259 : C SUBROUTINE XCVFPU(NEL,K0,NP,IES,IAXI,IPADL, 260 : C & LEF,XYZ, ----> IPT1,COOR 261 : C & VOLF, ----> IZVOL.T, 262 : C & UN,TK,TE, ----> IZTU1.T,IZTU2.T,IZTU3.T, 263 : C & F, ----> IZG1, 264 : C & DK,DE, ----> IZD2,IZD3 265 : C & ANU,IKC,UET,YP, ----> IZTG1.T,IK1,IZTG2.T,IZTG3.T, 266 : C & VPAROI,IKV, IZTG4.T,IK4, 267 : C & PORO,NPR,IPOR) ----> IZPORO,NPOR,IOP7 268 : 269 : C write(6,*)' Appel YCVFPU ' 269 : CALL ZCVFPU(NBEL,NUTOEL,NP,IES,NPTD,IAXI,LECT, 270 : & IPT1.NUM,XCOOR, 271 : & IZVOL.VPOCHA, 272 : & IZTU1.VPOCHA,IZTU2.VPOCHA,IZTU3.VPOCHA, 273 : & IZGG1.VPOCHA, 274 : & IZDD2.VPOCHA,IZDD3.VPOCHA, 275 : & MZNU.VPOCHA,IK1,MZUE.VPOCHA,MZYP.VPOCHA) 276 : 277 : SEGDES IPT1 278 : NUTOEL=NUTOEL+NBEL 279 : 280 : 1 CONTINUE 281 : 282 : 283 : SEGDES IZTU1,IZTU2,IZTU3 284 : SEGDES IZG1,IZGG1 285 : SEGDES IZD2,IZDD2 286 : SEGDES IZD3,IZDD3 287 : SEGDES IZVOL 288 : SEGDES LINCO 289 : SEGDES MTABX,MTAB1,INCO,KIZG,KIZD 290 : SEGSUP MLENTI 291 : 292 : RETURN 293 : 90 CONTINUE 294 : WRITE(6,*)' Interuption anormale de FPU ' 295 : RETURN 296 : 1002 FORMAT(10(1X,1PE11.4)) 297 : END 298 : 299 : 300 : 301 :
© Cast3M 2003 - All rights reserved.
Disclaimer