1 : C FPT SOURCE CHAT 06/08/24 21:37:33 5529 2 : SUBROUTINE FPT 3 : C********************************************************************** 4 : C 5 : C 6 : C FPT 7 : C ------> KFPT : calcul de H 8 : C ------> ECHIMP : calcul des fonctions de paroi 9 : C sur la temperature 10 : C SYNTAXE : 11 : C 'ZONE' $DOM 'OPER' FPT RO MU CP LB UET YP H TETA 'INCO' TN 12 : C 13 : C 14 : C $DOM Modèle NAVIER_STOKES 15 : C 16 : C RO Densité FLOTTANT ou CHPOINT SCAL SPG 17 : C 18 : C MU Viscosité dynamique moléculaire FLOTTANT ou CHPOINT SCAL SPG 19 : C 20 : C CP Chaleur spécifique FLOTTANT ou CHPOINT SCAL SPG 21 : C 22 : C LB Conductivité thermique FLOTTANT ou CHPOINT SCAL SPG 23 : C 24 : C UET Vitesse de frottement CHPOINT SCAL SPG 25 : C 26 : C YP Distance la paroi FLOTTANT 27 : C 28 : C H Coefficient d'échange thermique CHPOINT SCAL SPG 29 : C 30 : C TETA Température à la paroi CHPOINT SCAL SPG 31 : C 32 : C TN Température CHPOINT SCAL SOMMET 33 : C 34 : C IMPORTANT: 35 : C 36 : C Suivant la formulation EF ou EFM1 SPG doit être SOMMET ou CENTRE 37 : C 38 : C 39 : C*********************************************************************** 40 : IMPLICIT INTEGER(I-N) 41 : IMPLICIT REAL*8 (A-H,O-Z) 42 : C 43 : -INC CCOPTIO 44 : -INC SMCOORD 45 : -INC SMELEME 46 : -INC SMCHPOI 47 : POINTEUR MZNU.MPOVAL,MZUE.MPOVAL,MZYP.MPOVAL 48 : POINTEUR MZMU.MPOVAL,MZRO.MPOVAL,MZCP.MPOVAL,MZLB.MPOVAL 49 : POINTEUR MZH.MPOVAL,MZT0.MPOVAL 50 : CHARACTER*8 NOMI,NOMA,TYPE,NOMZ,TYPC 51 : PARAMETER (NTB=1) 52 : CHARACTER*8 LTAB(NTB) 53 : DIMENSION KTAB(NTB),IXV(3) 54 : * SAVE IPAS 55 : * DATA LTAB/'KIZX '/,IPAS/0/ 56 : DATA LTAB/'KIZX '/ 57 : C***************************************************************************** 58 : CFPT 59 : C write(6,*)' debut FPT ' 59 : CALL LITABS(LTAB,KTAB,NTB,1,IRET) 60 : IF(IRET.EQ.0)THEN 61 : WRITE(6,*)' Opérateur FPT' 62 : WRITE(6,*)' On attend un ensemble de table soustypes' 63 : RETURN 64 : ENDIF 65 : MTABX=KTAB(1) 66 : 66 : CALL LEKTAB(MTABX,'EQEX',MTAB1) 67 : IF(MTAB1.EQ.0)THEN 68 : WRITE(6,*)' Opérateur FPT' 69 : WRITE(6,*)' On ne trouve pas l''indice EQEX ? ' 70 : RETURN 71 : ENDIF 72 : 72 : CALL LEKTAB(MTAB1,'INCO',KINC) 73 : IF(KINC.EQ.0)THEN 74 : WRITE(6,*)' Opérateur FPT' 75 : WRITE(6,*)' Il n''y a pas de table INCO ? ?.' 76 : RETURN 77 : ENDIF 78 : 79 : C***************************************************************************** 80 : 81 : C 82 : C- Récupération de la table des options KOPT (pointeur KOPTI) 83 : C 83 : CALL LEKTAB(MTABX,'KOPT',KOPTI) 84 : IF (KOPTI.EQ.0) THEN 85 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 86 : MOTERR( 1: 8) = ' KOPT ' 87 : MOTERR( 9:16) = ' KOPT ' 88 : MOTERR(17:24) = ' KIZX ' 88 : CALL ERREUR(786) 89 : RETURN 90 : ENDIF 91 : 91 : CALL ACME(KOPTI,'KIMPL',KIMPL) 91 : CALL ACME(KOPTI,'KFORM',KFORM) 92 : 93 : IF(KFORM.NE.0.AND.KFORM.NE.1)THEN 94 : C Option %m1:8 incompatible avec les données 95 : MOTERR( 1: 8) = 'EF/EFM1 ' 95 : CALL ERREUR(803) 96 : RETURN 97 : ENDIF 98 : 99 : C***************************************************************************** 100 : C 101 : C- Récupération de la table DOMAINE associée au domaine local 102 : C 103 : IF(KFORM.EQ.0)THEN 103 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 104 : IF(MTABZ.EQ.0)THEN 105 : WRITE(6,*)' Opérateur FPT' 106 : WRITE(6,*)' On ne trouve pas l''indice DOMZ ? ' 107 : RETURN 108 : ENDIF 109 : 110 : TYPE=' ' 110 : CALL ACMO(MTABZ,'CENTRE',TYPE,MELEMK) 111 : IF(TYPE.NE.'MAILLAGE')GO TO 90 112 : 113 : ENDIF 114 : IF(KFORM.EQ.1)THEN 114 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 115 : TYPE=' ' 115 : CALL ACMO(MTABX,'DOMZ',TYPE,MMDZ) 116 : IF(TYPE.NE.'MMODEL')THEN 117 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 118 : MOTERR( 1: 8) = ' DOMZ ' 119 : MOTERR( 9:16) = ' DOMZ ' 120 : MOTERR(17:24) = ' KIZX ' 120 : CALL ERREUR(786) 121 : RETURN 122 : ENDIF 123 : 124 : C E/ MMODEL : Pointeur de la table contenant l'information cherchée 125 : C /S IPOINT : Pointeur sur la table DOMAINE 126 : C /S INEFMD : Type formulation INEFMD=1 LINE,=2 MACRO,=3 QUADRATIQUE 127 : C INEFMD=4 LINB 128 : 128 : CALL LEKMOD(MMDZ,MTABZ,INEFMD) 129 : 129 : CALL LEKTAB(MTABZ,'SOMMET',MELEMK) 130 : ENDIF 131 : 132 : C *** 133 : 133 : CALL ACME(MTABX,'IARG',IARG) 134 : 135 : C *** LECTURE DES COEFFICIENTS *** 136 : C 1er coefficient : ro 137 : IXV(1)=MELEMK 138 : IXV(2)=1 139 : IXV(3)=0 139 : CALL LEKCOF('Opérateur FPT :', 140 : & MTABX,KINC,1,IXV,MRO,MZRO,NPT1,NC1,IK1,IRET) 141 : IF(IRET.EQ.0)RETURN 142 : XRO=MZRO.VPOCHA(1,1) 143 : 144 : C 2ème coefficient : mu 145 : IXV(1)=MELEMK 146 : IXV(2)=1 147 : IXV(3)=0 147 : CALL LEKCOF('Opérateur FPT :', 148 : & MTABX,KINC,2,IXV,MMU,MZMU,NPT2,NC2,IK2,IRET) 149 : IF(IRET.EQ.0)RETURN 150 : XMU=MZMU.VPOCHA(1,1) 151 : 152 : C 3ème coefficient : cp 153 : IXV(1)=MELEMK 154 : IXV(2)=1 155 : IXV(3)=0 155 : CALL LEKCOF('Opérateur FPT :', 156 : & MTABX,KINC,3,IXV,MCP,MZCP,NPT3,NC3,IK3,IRET) 157 : IF(IRET.EQ.0)RETURN 158 : XCP=MZCP.VPOCHA(1,1) 159 : 160 : C 4ème coefficient : lambda 161 : IXV(1)=MELEMK 162 : IXV(2)=1 163 : IXV(3)=0 163 : CALL LEKCOF('Opérateur FPT :', 164 : & MTABX,KINC,4,IXV,MLB,MZLB,NPT4,NC4,IK4,IRET) 165 : IF(IRET.EQ.0)RETURN 166 : XLB=MZLB.VPOCHA(1,1) 167 : 168 : C 5ème coefficient : uet 169 : IXV(1)=MELEMK 170 : IXV(2)=0 171 : IXV(3)=0 171 : CALL LEKCOF('Opérateur FPT :', 172 : & MTABX,KINC,5,IXV,MUE,MZUE,NPT5,NC5,IK5,IRET) 173 : IF(IRET.EQ.0)RETURN 174 : 175 : C 6ème coefficient : yp 176 : IXV(1)=0 177 : IXV(2)=1 178 : IXV(3)=0 178 : CALL LEKCOF('Opérateur FPT :', 179 : & MTABX,KINC,6,IXV,MYP,MZYP,NPT6,NC6,IK6,IRET) 180 : IF(IRET.EQ.0)RETURN 181 : 182 : C 7ème coefficient : h 183 : IXV(1)=MELEMK 184 : IXV(2)=0 185 : IXV(3)=0 185 : CALL LEKCOF('Opérateur FPT :', 186 : & MTABX,KINC,7,IXV,MH,MZH,NPT7,NC7,IK7,IRET) 187 : IF(IRET.EQ.0)RETURN 188 : 189 : C 8ème coefficient : Teta0 190 : IXV(1)=MELEMK 191 : IXV(2)=1 192 : IXV(3)=0 192 : CALL LEKCOF('Opérateur FPT :', 193 : & MTABX,KINC,8,IXV,MT0,MZT0,NPT8,NC8,IK8,IRET) 194 : IF(IRET.EQ.0)RETURN 195 : IF(IK8.EQ.1)T0=MZT0.VPOCHA(1,1) 196 : 197 : C************************************************************************** 198 : C*****CALCUL DE H(NU,UET,YP,ALFA) 199 : C************************************************************************** 200 : 201 : NEL = MZH.VPOCHA(/1) 201 : CALL YKFPT (MZRO.VPOCHA(1,1),IK1,MZMU.VPOCHA(1,1),IK2, 202 : &MZCP.VPOCHA(1,1),IK3,MZLB.VPOCHA(1,1),IK4, 203 : &MZUE.VPOCHA,MZYP.VPOCHA,MZH.VPOCHA,NEL) 204 : 205 : 205 : CALL ECROBJ('TABLE',MTABX) 206 : 206 : CALL ECME(MTABX,'IARG',2) 206 : CALL ECMO(MTABX,'ARG1','CHPOINT',MH) 207 : IF(IK8.EQ.0)THEN 207 : CALL ECMO(MTABX,'ARG2','CHPOINT',MT0) 208 : ELSE 208 : CALL ECMF(MTABX,'ARG2',T0) 209 : ENDIF 210 : 210 : CALL ECHIMP 211 : 211 : CALL ECME(MTABX,'IARG',8) 212 : IF(IK1.EQ.0)THEN 212 : CALL ECMO(MTABX,'ARG1','CHPOINT',MRO) 213 : ELSE 213 : CALL ECMF(MTABX,'ARG1',XRO) 214 : ENDIF 215 : 216 : IF(IK2.EQ.0)THEN 216 : CALL ECMO(MTABX,'ARG2','CHPOINT',MMU) 217 : ELSE 217 : CALL ECMF(MTABX,'ARG2',XMU) 218 : ENDIF 218 : CALL ECMO(MTABX,'ARG5','CHPOINT',MUE) 219 : 220 : C*************************************************************************** 221 : RETURN 222 : 223 : 90 CONTINUE 224 : WRITE(6,*)' Opérateur FPT' 225 : RETURN 226 : END 227 : 228 : 229 : 230 : 231 : 232 : 233 : 234 :
© Cast3M 2003 - All rights reserved.
Disclaimer