1 : C FPA SOURCE CHAT 06/06/01 21:16:36 5450 2 : SUBROUTINE FPA 3 : C********************************************************************** 4 : C 5 : C OBJET : CALCUL DES FONCTIONS DE PAROIS AEROSOLS 6 : C 7 : C SYNTAXE : 'ZONE' $DOM 'OPER' FPA NU YP UET NORM AK ROG RAP 8 : C 9 : C 10 : C NU : FLOTTANT (VISCOSITE) 11 : C YP : FLOTTANT (EPAISSEUR DE LA COUCHE LIMITE) 12 : C UET : CHPOINT SCAL CENTRE (VITESSE DE FROTTEMENT) 13 : C NORM : CHPOINT VECT FACE (NORMALES A LA PAROI) 14 : C AK : CHPOINT SCAL CENTRE (VITESSE DE DEPOT) 15 : C ROG : POINT (MASSE VOLUMIQUE * G) 16 : C RAP : FLOTTANT (RAYON DES PARTICULES) 17 : C 18 : C*********************************************************************** 19 : IMPLICIT INTEGER(I-N) 20 : IMPLICIT REAL*8 (A-H,O-Z) 21 : C 22 : -INC CCOPTIO 23 : -INC CCVQUA4 24 : -INC SMCOORD 25 : -INC SMELEME 26 : POINTEUR MELEMC.MELEME 27 : -INC SMCHPOI 28 : POINTEUR MUET.MCHPOI, MAK.MCHPOI, MNORM.MCHPOI 29 : POINTEUR NNU.MPOVAL,NYP.MPOVAL,NUET.MPOVAL,NNORM.MPOVAL,NAK.MPOVAL 30 : POINTEUR NROG.MPOVAL,NRAP.MPOVAL 31 : 32 : -INC SMLMOTS 33 : CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,CHAI,TYPC 34 : LOGICAL LOGI 35 : PARAMETER (NTB=1) 36 : CHARACTER*8 LTAB(NTB) 37 : DIMENSION KTAB(NTB),IXV(3) 38 : * SAVE IPAS 39 : * DATA LTAB/'KIZX '/,IPAS/0/ 40 : DATA LTAB/'KIZX '/ 41 : C***************************************************************************** 42 : CFPA 43 : C write(6,*)' DEBUT FPA ' 44 : 44 : CALL LITABS(LTAB,KTAB,NTB,1,IRET) 45 : IF(IRET.EQ.0)THEN 46 : WRITE(6,*)' Opérateur FPA :' 47 : WRITE(6,*)' On attend un ensemble de table soustypes' 48 : RETURN 49 : ENDIF 50 : MTABX=KTAB(1) 51 : 51 : CALL LEKTAB(MTABX,'EQEX',MTAB1) 52 : IF(MTAB1.EQ.0)THEN 53 : WRITE(6,*)' Opérateur FPA :' 54 : WRITE(6,*)' On ne trouve pas l''indice EQEX ? ' 55 : RETURN 56 : ENDIF 57 : 57 : CALL LEKTAB(MTAB1,'INCO',KINC) 58 : IF(KINC.EQ.0)THEN 59 : WRITE(6,*)' Opérateur FPA :' 60 : WRITE(6,*)' Il n''y a pas de table INCO ? ?.' 61 : RETURN 62 : ENDIF 63 : 64 : C*********************************************************************** 65 : C OPTIONS 66 : C 67 : IKOMP=0 68 : KFORM=0 69 : KIMPL=0 70 : IAXI=0 71 : IF(IFOMOD.EQ.0)IAXI=2 72 : KOPTI=0 73 : TYPE=' ' 73 : CALL ACMO(MTABX,'KOPT',TYPE,IENT) 74 : IF(TYPE.EQ.'TABLE')KOPTI=IENT 75 : IF(KOPTI.NE.0)THEN 76 : TYPE=' ' 76 : CALL ACMO(KOPTI,'KFORM',TYPE,IENT) 76 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'KFORM',KFORM) 77 : IF(KFORM.EQ.2)THEN 78 : WRITE(6,*)' Opérateur FPA ' 79 : WRITE(6,*)' Option VF non prevue ' 80 : RETURN 81 : ENDIF 82 : TYPE=' ' 82 : CALL ACMO(KOPTI,'KIMPL',TYPE,IENT) 82 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'KIMPL',KIMPL) 83 : TYPE=' ' 83 : CALL ACMO(KOPTI,'IDCEN',TYPE,IENT) 83 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'IDCEN',IDCEN) 84 : TYPE=' ' 84 : CALL ACMO(KOPTI,'IKOMP',TYPE,IENT) 84 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'IKOMP',IKOMP) 85 : IF(KIMPL.NE.0)THEN 86 : WRITE(6,*)' Opérateur FPA ' 87 : WRITE(6,*)' Seule l''option explicite est prévue' 88 : RETURN 89 : ENDIF 90 : 91 : ENDIF 92 : 93 : C***************************************************************************** 94 : C 94 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 94 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 95 : IF(MTABZ.EQ.0)THEN 96 : WRITE(6,*)' Opérateur FPA ' 97 : WRITE(6,*)' On ne trouve pas l''indice DOMZ ? ' 98 : RETURN 99 : ENDIF 100 : 100 : CALL LEKTAB(MTABZ,'CENTRE',MELEMC) 101 : IF(MELEMC.EQ.0)GO TO 90 102 : C 103 : 104 : 105 : 106 : C*********************************************************************** 107 : C Lecture des arguments 108 : 108 : CALL ACME(MTABX,'IARG',IARG) 109 : IF (IARG.NE.7)THEN 110 : WRITE(6,*)'Opérateur FPA : nombre d''argument incorrect' 111 : RETURN 112 : ENDIF 113 : 114 : C *** Lecture de NU **** 115 : IXV(1)=0 116 : IXV(2)=1 117 : IXV(3)=0 117 : CALL LEKCOF('Opérateur FPA :', 118 : & MTABX,KINC,1,IXV,MNU,NNU,NPT1,NC1,IKNU,IRET) 119 : IF(IRET.EQ.0)RETURN 120 : IF(NNU.VPOCHA(1,1).LT.0.D0)THEN 121 : WRITE(6,*)'Opérateur FPA : ' 122 : WRITE(6,*)' Le 1er argument n''est pas convenable' 123 : WRITE(6,*)' Il s''agit de la viscosite. On attend un flottant > 0' 124 : RETURN 125 : ENDIF 126 : XNU=NNU.VPOCHA(1,1) 127 : 128 : C *** Lecture de YP **** 129 : IXV(1)=0 130 : IXV(2)=1 131 : IXV(3)=0 131 : CALL LEKCOF('Opérateur FPA :', 132 : & MTABX,KINC,2,IXV,MYP,NYP,NPT2,NC2,IKYP,IRET) 133 : IF(IRET.EQ.0)RETURN 134 : IF(NYP.VPOCHA(1,1).LT.0.D0)THEN 135 : WRITE(6,*)'Opérateur FPA : ' 136 : WRITE(6,*)' Le 2eme argument n''est pas convenable' 137 : WRITE(6,*)' On attend un flottant > 0' 138 : RETURN 139 : ENDIF 140 : XYP=NYP.VPOCHA(1,1) 141 : 142 : C *** Lecture de uet **** 143 : IXV(1)=MELEMC 144 : IXV(2)=0 145 : IXV(3)=0 145 : CALL LEKCOF('Opérateur FPA :', 146 : & MTABX,KINC,3,IXV,MUET,NUET,NPT3,NC3,IKUET,IRET) 147 : IF(IRET.EQ.0)RETURN 148 : 149 : C *** Lecture de NORM *** 150 : IXV(1)=-MELEMC 151 : IXV(2)=0 152 : IXV(3)=0 152 : CALL LEKCOF('Opérateur FPA :', 153 : & MTABX,KINC,4,IXV,MNORM,NNORM,NPT4,NC4,IKNORM,IRET) 154 : IF(IRET.EQ.0)RETURN 155 : 156 : C *** Lecture de AK *** 157 : IXV(1)=MELEMC 158 : IXV(2)=0 159 : IXV(3)=0 159 : CALL LEKCOF('Opérateur FPA :', 160 : & MTABX,KINC,5,IXV,MAK,NAK,NPT5,NC5,IKAK,IRET) 161 : IF(IRET.EQ.0)RETURN 162 : 163 : C 164 : C *** Lecture de ROG *** 165 : IXV(1)=0 166 : IXV(2)=0 167 : IXV(3)=1 167 : CALL LEKCOF('Opérateur FPA :', 168 : & MTABX,KINC,6,IXV,MROG,NROG,NPT6,NC6,IKROG,IRET) 169 : IF(IRET.EQ.0)RETURN 170 : 171 : C 172 : C *** Lecture de RAP **** 173 : IXV(1)=0 174 : IXV(2)=1 175 : IXV(3)=0 175 : CALL LEKCOF('Opérateur FPA :', 176 : & MTABX,KINC,7,IXV,MRAP,NRAP,NPT7,NC7,IKRAP,IRET) 177 : IF(IRET.EQ.0)RETURN 178 : IF(NRAP.VPOCHA(1,1).LT.0.D0)THEN 179 : WRITE(6,*)'Opérateur FPA : ' 180 : WRITE(6,*)' Le 7eme argument n''est pas convenable' 181 : WRITE(6,*) 182 : &' Il s''agit du rayon des particules, on attend un flottant > 0' 183 : RETURN 184 : ENDIF 185 : 186 : C 187 : C 188 : C************************************************************************** 189 : C*****CALCUL DE AK(NU,YP,UET,NORM,ROG,RAP) 190 : C************************************************************************** 191 : 192 : C 193 : N = NAK.VPOCHA(/1) 193 : CALL XFPA(NNU.VPOCHA,NYP.VPOCHA,NROG.VPOCHA,NRAP.VPOCHA,N, 194 : 1 NUET.VPOCHA,NNORM.VPOCHA,NAK.VPOCHA) 195 : C 196 : 197 : 198 : 198 : C CALL KFPA 198 : C CALL LIROBJ('CHPOINT',MCHPO1,1,IRET) 198 : C CALL LICHT(MCHPO1,MPOVA1,TYPE,IGEOM) 199 : C DO 20 I=1,N 200 : C NAK.VPOCHA(I,1)=MPOVA1.VPOCHA(I,1) 201 : C20 CONTINUE 202 : C************************************************************************** 202 : C CALL ECROBJ('CHPOINT',MAK) 202 : C CALL ECROBJ('CHPOINT',MTTA) 202 : CALL ECROBJ('TABLE',MTABX) 203 : 203 : CALL ECME(MTABX,'IARG',2) 203 : CALL ECMO(MTABX,'ARG1','CHPOINT',MAK) 204 : XVAL=0.D0 204 : CALL ECMF(MTABX,'ARG2',XVAL) 205 : 205 : CALL ECHIMP 206 : 206 : CALL ECME(MTABX,'IARG',7) 206 : CALL ECMF(MTABX,'ARG1',XNU) 206 : CALL ECMF(MTABX,'ARG2',XYP) 207 : 208 : C*************************************************************************** 209 : C SEGDES MUET,MAK,NAK,MNORM 210 : C SEGDES MELEMC 211 : C SEGSUP MPOVA1,MCHPO1 212 : 90 CONTINUE 213 : RETURN 214 : END 215 : 216 : 217 : 218 :
© Cast3M 2003 - All rights reserved.
Disclaimer