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

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