Sources Esope | Cast3M

fpa
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