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    OF166741  25/02/21    21:19:12     12166          
  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.       SEGMENT INFO
  32.         INTEGER INFELL(JG)
  33.       ENDSEGMENT
  34. *
  35.        CHARACTER*(LOCOMP) V(3)
  36.        DATA V/'VX','VY','VZ'/
  37. *
  38.        MMODEL=IPMODE
  39. *
  40. *    ACTIVATION DU MCHAML
  41. *
  42.       NSOUS=KMODEL(/1)
  43.       IF(IFLAG.NE.2)THEN
  44.         MCHELM=ICARA
  45.         SEGACT MCHELM
  46.       ELSE
  47.         N1=NSOUS
  48.         L1=16
  49.         N3=6
  50.         SEGINI MCHELM
  51.         ICARA=MCHELM
  52.         TITCHE='CARACTERISTIQUES'
  53.         IFOCHE=IFOUR
  54.       ENDIF
  55. *
  56. *    BOUCLE SUR LES SOUS-ZONES
  57. *
  58.       DO   500 ISOUS=1,NSOUS
  59.         NCOMP=0
  60.         IMODEL=KMODEL(ISOUS)
  61.         IPMAIL=IMAMOD
  62.         CALL VRACO1(IPMAIL,IPLIQU,IMELVA)
  63.         IF(IERR.NE.0)THEN
  64.             IF(IFLAG.NE.2)SEGSUP MCHELM
  65.             RETURN
  66.         ENDIF
  67.         IF(IFLAG.NE.2)THEN
  68.           MCHAML=ICHAML(ISOUS)
  69.           SEGACT MCHAML
  70.           NCOMP=IELVAL(/1)
  71.           N2=NCOMP+IDIM
  72.           SEGADJ MCHAML
  73.         ELSE
  74.          N2=IDIM
  75.          MELE=NEFMOD
  76.          if(infmod(/1).lt.5) then
  77.          CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  78.          IF (IERR.NE.0)THEN
  79.             IF(IFLAG.NE.2)SEGSUP MCHELM
  80.             RETURN
  81.          ENDIF
  82.          INFO=IPINF
  83.          IPMIN=INFELL(11)
  84.          segsup info
  85.          else
  86.          IPMIN=INFMOD(5)
  87.          endif
  88.          IMACHE(ISOUS)=IPMAIL
  89.          CONCHE(ISOUS)=CONMOD
  90.          INFCHE(ISOUS,1) = 0
  91.          INFCHE(ISOUS,2) = 0
  92.          INFCHE(ISOUS,3) = NIFOUR
  93.          INFCHE(ISOUS,4) = IPMIN
  94.          INFCHE(ISOUS,5) = 0
  95.          INFCHE(ISOUS,6) = 3
  96.          SEGINI MCHAML
  97.          ICHAML(ISOUS)=MCHAML
  98.         ENDIF
  99.         MPTVAL=IMELVA
  100.         SEGACT MPTVAL
  101.         DO 10 IC=1,IDIM
  102.           IELVAL(NCOMP+IC)=IVAL(IC)
  103.           NOMCHE(NCOMP+IC)=V(IC)
  104.           TYPCHE(NCOMP+IC)=TYVAL(IC)
  105.  10    CONTINUE
  106.        SEGSUP MPTVAL
  107.  500   CONTINUE
  108.  
  109.        RETURN
  110.        END
  111.  
  112.  
  113.  

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