Télécharger la plaquette Cast3M


fr en

Télécharger vracor.eso

Retour à la liste

Numérotation des lignes : 

vracor

  1. C VRACOR    SOURCE    MB234859  25/09/08    21:16:17     12358          
  2.       SUBROUTINE VRACOR(IPMODE,IPLIQU,IFLAG,ICARA)
  3. **************************************************************
  4. *  CALUL DES VECTEURS DIRIGES VERS L'EXTERIEUR DU FLUIDE POUR
  5. *  LES ELEMENTS RACCORDS FLUIDE-MECANIQUE ,ET LES AJOUTER DANS
  6. *  LE CHAMP/ELEMENT DE CARACTERISTIQUES
  7. *
  8. *  ENTREES :
  9. *
  10. *   IPMODE = POINTEUR SUR UN OBJET MMODEL
  11. *   IPLIQU =POINTUER SUR LE MAILLAGE  LIQUIDE
  12. *   ICARA = POINTEUR SUR LE CHAMP/ELEMENT DE CARACTERISTIQUES
  13. *   IFLAG = 1 LE CHAMELEM DE CARACTERISTIQUES EXITE =2 IL N'EXISTE PAS
  14. *   SORTIES :
  15. *
  16. *    ICARA  =POINTEUR SUR LE CHAMP/ELEMENT DE CARACTERISTIQUES
  17. *            COMPLETE
  18. ****************************************************************
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8(A-H,O-Z)
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24.  
  25. -INC SMCHAML
  26. -INC SMMODEL
  27. -INC SMCOORD
  28.  
  29. -INC TMPTVAL
  30. *
  31.        CHARACTER*(LOCOMP) V(3)
  32.        DATA V/'VX','VY','VZ'/
  33. *
  34.        MMODEL=IPMODE
  35. *
  36. *    ACTIVATION DU MCHAML
  37. *
  38.       NSOUS=KMODEL(/1)
  39.       IF(IFLAG.NE.2)THEN
  40.         MCHELM=ICARA
  41.         SEGACT MCHELM
  42.       ELSE
  43.         N1=NSOUS
  44.         L1=16
  45.         N3=6
  46.         SEGINI MCHELM
  47.         ICARA=MCHELM
  48.         TITCHE='CARACTERISTIQUES'
  49.         IFOCHE=IFOUR
  50.       ENDIF
  51. *
  52. *    BOUCLE SUR LES SOUS-ZONES
  53. *
  54.       DO   500 ISOUS=1,NSOUS
  55.         NCOMP=0
  56.         IMODEL=KMODEL(ISOUS)
  57.         IPMAIL=IMAMOD
  58.         CALL VRACO1(IPMAIL,IPLIQU,IMELVA)
  59.         IF(IERR.NE.0)THEN
  60.             IF(IFLAG.NE.2)SEGSUP MCHELM
  61.             RETURN
  62.         ENDIF
  63.         IF(IFLAG.NE.2)THEN
  64.           MCHAML=ICHAML(ISOUS)
  65.           SEGACT MCHAML
  66.           NCOMP=IELVAL(/1)
  67.           N2=NCOMP+IDIM
  68.           SEGADJ MCHAML
  69.         ELSE
  70.          N2=IDIM
  71.          MELE=NEFMOD
  72.          IPMIN=INFMOD(5)
  73.          IMACHE(ISOUS)=IPMAIL
  74.          CONCHE(ISOUS)=CONMOD
  75.          INFCHE(ISOUS,1) = 0
  76.          INFCHE(ISOUS,2) = 0
  77.          INFCHE(ISOUS,3) = NIFOUR
  78.          INFCHE(ISOUS,4) = IPMIN
  79.          INFCHE(ISOUS,5) = 0
  80.          INFCHE(ISOUS,6) = 3
  81.          SEGINI MCHAML
  82.          ICHAML(ISOUS)=MCHAML
  83.         ENDIF
  84.         MPTVAL=IMELVA
  85.         SEGACT MPTVAL
  86.         DO 10 IC=1,IDIM
  87.           IELVAL(NCOMP+IC)=IVAL(IC)
  88.           NOMCHE(NCOMP+IC)=V(IC)
  89.           TYPCHE(NCOMP+IC)=TYVAL(IC)
  90.  10    CONTINUE
  91.        SEGSUP MPTVAL
  92.  500   CONTINUE
  93.  
  94.        RETURN
  95.        END
  96.  
  97.  
  98.  
  99.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales