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

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