Télécharger la plaquette Cast3M


fr en

Télécharger inqrtr.eso

Retour à la liste

Numérotation des lignes : 

inqrtr

  1. C INQRTR    SOURCE    GOUNAND   21/06/02    21:17:02     11022          
  2.       SUBROUTINE INQRTR(MYQRFS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : INQRTR
  7. C PROJET      : Noyau linéaire NLIN
  8. C DESCRIPTION :
  9. C LANGAGE     : ESOPE
  10. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  11. C               mél : gounand@semt2.smts.cea.fr
  12. C***********************************************************************
  13. C APPELES          :
  14. C APPELE PAR       :
  15. C***********************************************************************
  16. C ENTREES            : -
  17. C ENTREES/SORTIES    :
  18. C SORTIES            : -
  19. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  20. C***********************************************************************
  21. C VERSION    : v1, 17/10/02, version initiale
  22. C HISTORIQUE : v1, 17/10/02, création
  23. C HISTORIQUE :
  24. C HISTORIQUE :
  25. C***********************************************************************
  26. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  27. C en cas de modification de ce sous-programme afin de faciliter
  28. C la maintenance !
  29. C***********************************************************************
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCGEOME
  34. -INC TNLIN      
  35. *-INC SIQUAF
  36.       POINTEUR MYQRFS.IQUAFS
  37.       POINTEUR QRCOUR.IQUAF
  38.       INTEGER NDIMQR,NBNOQR
  39. -INC SMELEME
  40.       POINTEUR MYMEL.MELEME
  41.       POINTEUR SOUMEL.MELEME
  42.       INTEGER NBNN,NBELEM,NBSOUS,NBREF
  43. *
  44.       INTEGER IMPR,IRET
  45.       REAL*8 ZERO,UN,UNS3,UNS2
  46. *
  47.       PARAMETER (ZERO=0.D0,UN=1.D0,UNS3=1.D0/3.D0,UNS2=1.D0/2.D0)
  48. *
  49.       INTEGER NUMER
  50. *
  51. * Executable statements
  52. *
  53.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrtr'
  54. *
  55. * Elément QUAF TRI7
  56. *
  57.  
  58.       NDIMQR=2
  59.       NBNOQR=7
  60.       SEGINI QRCOUR
  61. * Numéro de l'élément géométrique dans NOMS
  62. * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  63. * cf. include CCGEOME
  64.       CALL FICH4('TRI7',NOMS,NOMBR,
  65.      $     NUMER,
  66.      $     IMPR,IRET)
  67.       IF (IRET.NE.0) GOTO 9999
  68.       QRCOUR.NUMQUF=NUMER
  69. *
  70. * Coordonnées des noeuds du QUAF de référence
  71. *
  72.       QRCOUR.XCONQR(1,1)=ZERO
  73.       QRCOUR.XCONQR(2,1)=ZERO
  74.       QRCOUR.XCONQR(1,2)=UNS2
  75.       QRCOUR.XCONQR(2,2)=ZERO
  76.       QRCOUR.XCONQR(1,3)=UN
  77.       QRCOUR.XCONQR(2,3)=ZERO
  78.       QRCOUR.XCONQR(1,4)=UNS2
  79.       QRCOUR.XCONQR(2,4)=UNS2
  80.       QRCOUR.XCONQR(1,5)=ZERO
  81.       QRCOUR.XCONQR(2,5)=UN
  82.       QRCOUR.XCONQR(1,6)=ZERO
  83.       QRCOUR.XCONQR(2,6)=UNS2
  84.       QRCOUR.XCONQR(1,7)=UNS3
  85.       QRCOUR.XCONQR(2,7)=UNS3
  86. *
  87. * Numero du centre
  88. *
  89.       QRCOUR.NUCENT=7
  90. *
  91. * Faces du TRI7 : 3 SEG3
  92. *
  93. *     Chapeau
  94.       NBNN=0
  95.       NBELEM=0
  96.       NBSOUS=1
  97.       NBREF=0
  98.       SEGINI MYMEL
  99. *     Faces SEG3
  100.       NBNN=3
  101.       NBELEM=3
  102.       NBSOUS=0
  103.       NBREF=0
  104.       SEGINI SOUMEL
  105.       CALL FICH4('SEG3',NOMS,NOMBR,
  106.      $     NUMER,
  107.      $     IMPR,IRET)
  108.       IF (IRET.NE.0) GOTO 9999
  109.       SOUMEL.ITYPEL=NUMER
  110. *     Face 1
  111.       SOUMEL.NUM(1,1)=1
  112.       SOUMEL.NUM(2,1)=2
  113.       SOUMEL.NUM(3,1)=3
  114. *     Face 2
  115.       SOUMEL.NUM(1,2)=3
  116.       SOUMEL.NUM(2,2)=4
  117.       SOUMEL.NUM(3,2)=5
  118. *     Face 3
  119.       SOUMEL.NUM(1,3)=5
  120.       SOUMEL.NUM(2,3)=6
  121.       SOUMEL.NUM(3,3)=1
  122.       SEGDES SOUMEL
  123.       MYMEL.LISOUS(1)=SOUMEL
  124.       SEGDES MYMEL
  125.       QRCOUR.LFACE=MYMEL
  126.       SEGDES QRCOUR
  127.       MYQRFS.LISQRF(**)=QRCOUR
  128. *
  129. * Normal termination
  130. *
  131.       IRET=0
  132.       RETURN
  133. *
  134. * Format handling
  135. *
  136. *
  137. * Error handling
  138. *
  139.  9999 CONTINUE
  140.       IRET=1
  141.       WRITE(IOIMP,*) 'An error was detected in subroutine inqrtr'
  142.       RETURN
  143. *
  144. * End of subroutine INQRTR
  145. *
  146.       END
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  

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