Télécharger la plaquette Cast3M


fr en

Télécharger prangl.eso

Retour à la liste

Numérotation des lignes : 

prangl

  1. C PRANGL    SOURCE    GOUNAND   26/09/03    21:15:07     12637          
  2.       SUBROUTINE PRANGL()
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : PRANGL
  7. C DESCRIPTION :
  8. C
  9. C
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
  13. C               mel : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES          :
  16. C APPELES (E/S)    :
  17. C APPELES (BLAS)   :
  18. C APPELES (CALCUL) :
  19. C APPELE PAR       :
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE    :
  22. C ENTREES            :
  23. C ENTREES/SORTIES    :
  24. C SORTIES            :
  25. C***********************************************************************
  26. C VERSION    : v1, 02/09/2026, version initiale
  27. C HISTORIQUE : v1, 02/09/2026, creation
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC SMCOORD
  34.       DIMENSION V0(3),V1(3),V2(3),V3(3)
  35. *
  36. * Executable statements
  37. *
  38. * Si IFLAG=1, on plante si vecteur nul
  39.       IFLAG=1
  40. *
  41. *  Lecture des vecteurs
  42. *
  43.       INTERR(1)=IDIM
  44.       IF (IDIM.LE.0) THEN
  45.          CALL ERREUR(709)
  46.          RETURN
  47.       ENDIF
  48.       CALL LIROBJ('POINT',IV1,1,IRET)
  49.       IF (IERR.NE.0) RETURN
  50.       CALL LIROBJ('POINT',IV2,1,IRET)
  51.       IF (IERR.NE.0) RETURN
  52.       CALL LIROBJ('POINT',IV3,0,IRET3)
  53.       IF (IERR.NE.0) RETURN
  54.       SEGACT MCOORD
  55.       IR1=(IV1-1)*(IDIM+1)
  56.       IR2=(IV2-1)*(IDIM+1)
  57.       IF (IRET3.NE.0) THEN
  58.          IF (IDIM.NE.3) THEN
  59.             CALL ERREUR(709)
  60.             RETURN
  61.          ENDIF
  62.          IR3=(IV3-1)*(IDIM+1)
  63.       ENDIF
  64.       DO J=1,IDIM
  65.          V1(J)=XCOOR(IR1+J)
  66.          V2(J)=XCOOR(IR2+J)
  67.          IF (IRET3.NE.0) THEN
  68.             V0(J)=0.D0
  69.             V3(J)=XCOOR(IR3+J)
  70.          ENDIF
  71.       ENDDO
  72. *
  73.       IF (IRET3.EQ.0) THEN
  74. * Calcul de l'angle (oriente en 2D)
  75.          CALL ANGLE(V1,V2,IDIM,XANG,IFLAG,IFLIG)
  76.       ELSE
  77. * Calcul de l'angle solide
  78.          CALL ANGSOL(V0,V1,V2,V3,XANG,IFLAG,IFLIG)
  79.       ENDIF
  80.       IF (IFLIG.NE.0) THEN
  81.          CALL ERREUR(277)
  82.          RETURN
  83.       ENDIF
  84. *
  85.       CALL ECRREE(XANG)
  86. *
  87. * Normal termination
  88. *
  89.       RETURN
  90. *
  91. * Format handling
  92. *
  93. *
  94. * Error handling
  95. *
  96. *
  97. * End of subroutine PRANGL
  98. *
  99.       END
  100.  
  101.  

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