Télécharger la plaquette Cast3M


fr en

Télécharger vsur.eso

Retour à la liste

Numérotation des lignes : 

vsur

  1. C VSUR      SOURCE    PV        20/03/31    14:34:23     10567          
  2.       SUBROUTINE VSUR
  3. C=====================================================================
  4. C    OPERATEUR POUR CALCULER LES VECTEURS SURFACIQUES AUX POINTS
  5. C               DE GAUSS DES COQUES
  6. C
  7. C    CHAM = VSUR  MODL  (MOT1)
  8. C              MODL : MODELE de calcul , type MMODEL
  9. C              CHAM : CHAMELEM de sous type VECTEUR contenant
  10. C                       les JACOBIENS aux POINTS DE GAUSS
  11. C              MOT1 : MOT 'NORM' : les vecteurs sont normes
  12. C
  13. C=====================================================================
  14. C
  15.       IMPLICIT INTEGER(I-N)
  16.       IMPLICIT REAL*8(A-H,O-Z)
  17.       PARAMETER(XZER=0.D0,UNDEMI=.5D0,UN=1.D0)
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMCHAML
  22. -INC SMCOORD
  23. C
  24. C
  25. C
  26. C
  27. C           IPMODL          MODELE MMODEL
  28. C           IPCHE           CHAMELEM DE SOUS TYPE SCALAIRE
  29. C                           CONTENANT LES VECTEURS SURFACIQUES
  30. C
  31. C
  32.       CHARACTER*4 MCLE(1)
  33.       DATA NCLE /1/
  34.       DATA MCLE /'NORM'/
  35.       segact mcoord
  36.       IPMODL=0
  37.       IPCHE=0
  38.       IRET=0
  39. C
  40. C     LECTURE DU MODELE
  41. C
  42.       CALL LIROBJ('MMODEL',IPMODL,1,IRTM)
  43.       IF (IERR.NE.0) RETURN
  44. C
  45. C     LECTURE DU MOT
  46. C
  47.       CALL LIRMOT(MCLE,NCLE,ICLE,0)
  48.       IF (IERR.NE.0) RETURN
  49.       IF (ICLE.NE.1) THEN
  50.          INORM = 0
  51.       ELSE
  52.          INORM = 1
  53.       ENDIF
  54. C
  55. C     CALCUL DU JACOBIEN
  56. C
  57.       CALL JACONO(IPMODL,INORM,IPCHE,IRET)
  58. C
  59.       IF(IRET.NE.0) CALL ECROBJ('MCHAML',IPCHE)
  60.       RETURN
  61.       END
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  

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