C FPA SOURCE CB215821 20/11/25 13:29:16 10792 SUBROUTINE FPA C********************************************************************** C C OBJET : CALCUL DES FONCTIONS DE PAROIS AEROSOLS C C SYNTAXE : 'ZONE' $DOM 'OPER' FPA NU YP UET NORM AK ROG RAP C C C NU : FLOTTANT (VISCOSITE) C YP : FLOTTANT (EPAISSEUR DE LA COUCHE LIMITE) C UET : CHPOINT SCAL CENTRE (VITESSE DE FROTTEMENT) C NORM : CHPOINT VECT FACE (NORMALES A LA PAROI) C AK : CHPOINT SCAL CENTRE (VITESSE DE DEPOT) C ROG : POINT (MASSE VOLUMIQUE * G) C RAP : FLOTTANT (RAYON DES PARTICULES) C C*********************************************************************** IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C -INC PPARAM -INC CCOPTIO -INC CCVQUA4 -INC SMCOORD -INC SMELEME POINTEUR MELEMC.MELEME -INC SMCHPOI POINTEUR MUET.MCHPOI, MAK.MCHPOI, MNORM.MCHPOI POINTEUR NNU.MPOVAL,NYP.MPOVAL,NUET.MPOVAL,NNORM.MPOVAL,NAK.MPOVAL POINTEUR NROG.MPOVAL,NRAP.MPOVAL -INC SMLMOTS CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,CHAI,TYPC LOGICAL LOGI PARAMETER (NTB=1) CHARACTER*8 LTAB(NTB) DIMENSION KTAB(NTB),IXV(3) * SAVE IPAS * DATA LTAB/'KIZX '/,IPAS/0/ DATA LTAB/'KIZX '/ C***************************************************************************** CFPA C write(6,*)' DEBUT FPA ' CALL LITABS(LTAB,KTAB,NTB,1,IRET) IF(IRET.EQ.0)THEN WRITE(6,*)' Opérateur FPA :' WRITE(6,*)' On attend un ensemble de table soustypes' RETURN ENDIF MTABX=KTAB(1) CALL LEKTAB(MTABX,'EQEX',MTAB1) IF(MTAB1.EQ.0)THEN WRITE(6,*)' Opérateur FPA :' WRITE(6,*)' On ne trouve pas l''indice EQEX ? ' RETURN ENDIF CALL LEKTAB(MTAB1,'INCO',KINC) IF(KINC.EQ.0)THEN WRITE(6,*)' Opérateur FPA :' WRITE(6,*)' Il n''y a pas de table INCO ? ?.' RETURN ENDIF C*********************************************************************** C OPTIONS C IKOMP=0 KFORM=0 KIMPL=0 IAXI=0 IF(IFOMOD.EQ.0)IAXI=2 KOPTI=0 TYPE=' ' CALL ACMO(MTABX,'KOPT',TYPE,IENT) IF(TYPE.EQ.'TABLE')KOPTI=IENT IF(KOPTI.NE.0)THEN TYPE=' ' CALL ACMO(KOPTI,'KFORM',TYPE,IENT) IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'KFORM',KFORM) IF(KFORM.EQ.2)THEN WRITE(6,*)' Opérateur FPA ' WRITE(6,*)' Option VF non prevue ' RETURN ENDIF TYPE=' ' CALL ACMO(KOPTI,'KIMPL',TYPE,IENT) IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'KIMPL',KIMPL) TYPE=' ' CALL ACMO(KOPTI,'IDCEN',TYPE,IENT) IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'IDCEN',IDCEN) TYPE=' ' CALL ACMO(KOPTI,'IKOMP',TYPE,IENT) IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'IKOMP',IKOMP) IF(KIMPL.NE.0)THEN WRITE(6,*)' Opérateur FPA ' WRITE(6,*)' Seule l''option explicite est prévue' RETURN ENDIF ENDIF C***************************************************************************** C CALL ACMM(MTABX,'NOMZONE',NOMZ) CALL LEKTAB(MTABX,'DOMZ',MTABZ) IF(MTABZ.EQ.0)THEN WRITE(6,*)' Opérateur FPA ' WRITE(6,*)' On ne trouve pas l''indice DOMZ ? ' RETURN ENDIF CALL LEKTAB(MTABZ,'CENTRE',MELEMC) IF(MELEMC.EQ.0)GO TO 90 C C*********************************************************************** C Lecture des arguments CALL ACME(MTABX,'IARG',IARG) IF (IARG.NE.7)THEN WRITE(6,*)'Opérateur FPA : nombre d''argument incorrect' RETURN ENDIF C *** Lecture de NU **** IXV(1)=0 IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur FPA :', & MTABX,KINC,1,IXV,MNU,NNU,NPT1,NC1,IKNU,IRET) IF(IRET.EQ.0)RETURN IF(NNU.VPOCHA(1,1).LT.0.D0)THEN WRITE(6,*)'Opérateur FPA : ' WRITE(6,*)' Le 1er argument n''est pas convenable' WRITE(6,*)' Il s''agit de la viscosite. On attend un flottant > 0' RETURN ENDIF XNU=NNU.VPOCHA(1,1) C *** Lecture de YP **** IXV(1)=0 IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur FPA :', & MTABX,KINC,2,IXV,MYP,NYP,NPT2,NC2,IKYP,IRET) IF(IRET.EQ.0)RETURN IF(NYP.VPOCHA(1,1).LT.0.D0)THEN WRITE(6,*)'Opérateur FPA : ' WRITE(6,*)' Le 2eme argument n''est pas convenable' WRITE(6,*)' On attend un flottant > 0' RETURN ENDIF XYP=NYP.VPOCHA(1,1) C *** Lecture de uet **** IXV(1)=MELEMC IXV(2)=0 IXV(3)=0 CALL LEKCOF('Opérateur FPA :', & MTABX,KINC,3,IXV,MUET,NUET,NPT3,NC3,IKUET,IRET) IF(IRET.EQ.0)RETURN C *** Lecture de NORM *** IXV(1)=-MELEMC IXV(2)=0 IXV(3)=0 CALL LEKCOF('Opérateur FPA :', & MTABX,KINC,4,IXV,MNORM,NNORM,NPT4,NC4,IKNORM,IRET) IF(IRET.EQ.0)RETURN C *** Lecture de AK *** IXV(1)=MELEMC IXV(2)=0 IXV(3)=0 CALL LEKCOF('Opérateur FPA :', & MTABX,KINC,5,IXV,MAK,NAK,NPT5,NC5,IKAK,IRET) IF(IRET.EQ.0)RETURN C C *** Lecture de ROG *** IXV(1)=0 IXV(2)=0 IXV(3)=1 CALL LEKCOF('Opérateur FPA :', & MTABX,KINC,6,IXV,MROG,NROG,NPT6,NC6,IKROG,IRET) IF(IRET.EQ.0)RETURN C C *** Lecture de RAP **** IXV(1)=0 IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur FPA :', & MTABX,KINC,7,IXV,MRAP,NRAP,NPT7,NC7,IKRAP,IRET) IF(IRET.EQ.0)RETURN IF(NRAP.VPOCHA(1,1).LT.0.D0)THEN WRITE(6,*)'Opérateur FPA : ' WRITE(6,*)' Le 7eme argument n''est pas convenable' WRITE(6,*) &' Il s''agit du rayon des particules, on attend un flottant > 0' RETURN ENDIF C C C************************************************************************** C*****CALCUL DE AK(NU,YP,UET,NORM,ROG,RAP) C************************************************************************** C N = NAK.VPOCHA(/1) CALL XFPA(NNU.VPOCHA,NYP.VPOCHA,NROG.VPOCHA,NRAP.VPOCHA,N, 1 NUET.VPOCHA,NNORM.VPOCHA,NAK.VPOCHA) C C CALL KFPA C CALL LIROBJ('CHPOINT',MCHPO1,1,IRET) C CALL LICHT(MCHPO1,MPOVA1,TYPE,IGEOM) C DO 20 I=1,N C NAK.VPOCHA(I,1)=MPOVA1.VPOCHA(I,1) C20 CONTINUE C************************************************************************** C CALL ECROBJ('CHPOINT',MAK) C CALL ECROBJ('CHPOINT',MTTA) CALL ECROBJ('TABLE',MTABX) CALL ECME(MTABX,'IARG',2) CALL ECMO(MTABX,'ARG1','CHPOINT',MAK) XVAL=0.D0 CALL ECMF(MTABX,'ARG2',XVAL) CALL ECHIMP CALL ECME(MTABX,'IARG',7) CALL ECMF(MTABX,'ARG1',XNU) CALL ECMF(MTABX,'ARG2',XYP) C*************************************************************************** C SEGDES MUET,MAK,NAK,MNORM C SEGDES MELEMC C SEGSUP MPOVA1,MCHPO1 90 CONTINUE RETURN END