Télécharger geoqua.eso

Retour à la liste

Numérotation des lignes :

  1. C GEOQUA SOURCE BP208322 16/11/18 21:17:23 9177
  2. SUBROUTINE GEOQUA(ITQUAF,
  3. $ JDIAMA,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : GEOQUA
  9. C DESCRIPTION :
  10. C
  11. * Calcul d'une propriété géométrique d'un QUAF régulier de côté 1 :
  12. * ici le diamètre du cercle circonscrit.
  13. * Cela sert pour le decentrement.
  14. C
  15. C LANGAGE : ESOPE
  16. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  17. C mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES :
  20. C APPELES (E/S) :
  21. C APPELES (BLAS) :
  22. C APPELES (CALCUL) :
  23. C APPELE PAR :
  24. C***********************************************************************
  25. C SYNTAXE GIBIANE :
  26. C ENTREES :
  27. C ENTREES/SORTIES :
  28. C SORTIES :
  29. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  30. C***********************************************************************
  31. C VERSION : v1, 04/10/2005, version initiale
  32. C HISTORIQUE : v1, 04/10/2005, création
  33. C HISTORIQUE :
  34. C HISTORIQUE :
  35. C***********************************************************************
  36. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  37. C en cas de modification de ce sous-programme afin de faciliter
  38. C la maintenance !
  39. C***********************************************************************
  40. -INC CCOPTIO
  41. -INC CCGEOME
  42. CBEGININCLUDE SMCHAEL
  43. SEGMENT MCHAEL
  44. POINTEUR IMACHE(N1).MELEME
  45. POINTEUR ICHEVA(N1).MCHEVA
  46. ENDSEGMENT
  47. SEGMENT MCHEVA
  48. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  49. ENDSEGMENT
  50. SEGMENT LCHEVA
  51. POINTEUR LISCHE(NBCHE).MCHEVA
  52. ENDSEGMENT
  53. CENDINCLUDE SMCHAEL
  54. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  55. POINTEUR JDIAMA.MCHEVA
  56. *
  57. CHARACTER*4 CQUAF
  58. LOGICAL LBID
  59. INTEGER IMPR,IRET
  60.  
  61. *
  62. * Executable statements
  63. *
  64. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans geoqua.eso'
  65. CQUAF=NOMS(ITQUAF)
  66. *
  67. IF (CQUAF.EQ.'SEG3') THEN
  68. XDIAMA=1.D0
  69. ELSEIF (CQUAF.EQ.'TRI7') THEN
  70. XDIAMA=2.D0/(SQRT(3.D0))
  71. ELSEIF (CQUAF.EQ.'QUA9') THEN
  72. XDIAMA=SQRT(2.D0)
  73. ELSEIF (CQUAF.EQ.'TE15') THEN
  74. XDIAMA=SQRT(3.D0/2.D0)
  75. ELSEIF (CQUAF.EQ.'PY19') THEN
  76. XDIAMA=SQRT(2.D0)
  77. ELSEIF (CQUAF.EQ.'PR21') THEN
  78. XDIAMA=SQRT(7.D0/3.D0)
  79. ELSEIF (CQUAF.EQ.'CU27') THEN
  80. XDIAMA=SQRT(3.D0)
  81. ELSE
  82. WRITE(IOIMP,*) 'Diametre interne de ',CQUAF,' non implemente'
  83. GOTO 9999
  84. ENDIF
  85. *
  86. NBLIG=1
  87. NBCOL=1
  88. N2LIG=1
  89. N2COL=1
  90. NBPOI=1
  91. NBELM=1
  92. SEGINI JDIAMA
  93. JDIAMA.VELCHE(1,1,1,1,1,1)=XDIAMA
  94. SEGDES JDIAMA
  95. *
  96. * Normal termination
  97. *
  98. IRET=0
  99. RETURN
  100. *
  101. * Format handling
  102. *
  103. 9999 CONTINUE
  104. IRET=1
  105. WRITE(IOIMP,*) 'An error was detected in subroutine geoqua'
  106. RETURN
  107. *
  108. * End of subroutine GEOQUA
  109. *
  110. END
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  

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