C VRACOR    SOURCE    MB234859  25/09/08    21:16:17     12358          
      SUBROUTINE VRACOR(IPMODE,IPLIQU,IFLAG,ICARA)
**************************************************************
*  CALUL DES VECTEURS DIRIGES VERS L'EXTERIEUR DU FLUIDE POUR
*  LES ELEMENTS RACCORDS FLUIDE-MECANIQUE ,ET LES AJOUTER DANS
*  LE CHAMP/ELEMENT DE CARACTERISTIQUES
*
*  ENTREES :
*
*   IPMODE = POINTEUR SUR UN OBJET MMODEL
*   IPLIQU =POINTUER SUR LE MAILLAGE  LIQUIDE
*   ICARA = POINTEUR SUR LE CHAMP/ELEMENT DE CARACTERISTIQUES
*   IFLAG = 1 LE CHAMELEM DE CARACTERISTIQUES EXITE =2 IL N'EXISTE PAS
*   SORTIES :
*
*    ICARA  =POINTEUR SUR LE CHAMP/ELEMENT DE CARACTERISTIQUES
*            COMPLETE
****************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO

-INC SMCHAML
-INC SMMODEL
-INC SMCOORD

-INC TMPTVAL
*
       CHARACTER*(LOCOMP) V(3)
       DATA V/'VX','VY','VZ'/
*
       MMODEL=IPMODE
*
*    ACTIVATION DU MCHAML
*
      NSOUS=KMODEL(/1)
      IF(IFLAG.NE.2)THEN
        MCHELM=ICARA
        SEGACT MCHELM
      ELSE
        N1=NSOUS
        L1=16
        N3=6
        SEGINI MCHELM
        ICARA=MCHELM
        TITCHE='CARACTERISTIQUES'
        IFOCHE=IFOUR
      ENDIF
*
*    BOUCLE SUR LES SOUS-ZONES
*
      DO   500 ISOUS=1,NSOUS
        NCOMP=0
        IMODEL=KMODEL(ISOUS)
        IPMAIL=IMAMOD
        CALL VRACO1(IPMAIL,IPLIQU,IMELVA)
        IF(IERR.NE.0)THEN
            IF(IFLAG.NE.2)SEGSUP MCHELM
            RETURN
        ENDIF
        IF(IFLAG.NE.2)THEN
          MCHAML=ICHAML(ISOUS)
          SEGACT MCHAML
          NCOMP=IELVAL(/1)
          N2=NCOMP+IDIM
          SEGADJ MCHAML
        ELSE
         N2=IDIM
         MELE=NEFMOD
         IPMIN=INFMOD(5)
         IMACHE(ISOUS)=IPMAIL
         CONCHE(ISOUS)=CONMOD
         INFCHE(ISOUS,1) = 0
         INFCHE(ISOUS,2) = 0
         INFCHE(ISOUS,3) = NIFOUR
         INFCHE(ISOUS,4) = IPMIN
         INFCHE(ISOUS,5) = 0
         INFCHE(ISOUS,6) = 3
         SEGINI MCHAML
         ICHAML(ISOUS)=MCHAML
        ENDIF
        MPTVAL=IMELVA
        SEGACT MPTVAL
        DO 10 IC=1,IDIM
          IELVAL(NCOMP+IC)=IVAL(IC)
          NOMCHE(NCOMP+IC)=V(IC)
          TYPCHE(NCOMP+IC)=TYVAL(IC)
 10    CONTINUE
       SEGSUP MPTVAL
 500   CONTINUE

       RETURN
       END