Télécharger la plaquette Cast3M


fr en

Télécharger inqrqu.eso

Retour à la liste

Numérotation des lignes : 

inqrqu

  1. C INQRQU    SOURCE    GOUNAND   21/06/02    21:16:59     11022          
  2.       SUBROUTINE INQRQU(MYQRFS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : INQRQU
  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, 21/07/03, version initiale
  22. C HISTORIQUE : v1, 21/07/03, 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
  46. *
  47.       PARAMETER (ZERO=0.D0,UN=1.D0)
  48. *
  49.       INTEGER NUMER
  50. *
  51. * Executable statements
  52. *
  53.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrqu'
  54. *
  55. * Elément QUAF QUA9
  56. *
  57.       NDIMQR=2
  58.       NBNOQR=9
  59.       SEGINI QRCOUR
  60. * Numéro de l'élément géométrique dans NOMS
  61. * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  62. * cf. include CCGEOME
  63.       CALL FICH4('QUA9',NOMS,NOMBR,
  64.      $     NUMER,
  65.      $     IMPR,IRET)
  66.       IF (IRET.NE.0) GOTO 9999
  67.       QRCOUR.NUMQUF=NUMER
  68. *
  69. * Coordonnées des noeuds du QUAF de référence
  70. *
  71.       QRCOUR.XCONQR(1,1)=-UN
  72.       QRCOUR.XCONQR(2,1)=-UN
  73.       QRCOUR.XCONQR(1,2)=ZERO
  74.       QRCOUR.XCONQR(2,2)=-UN
  75.       QRCOUR.XCONQR(1,3)=UN
  76.       QRCOUR.XCONQR(2,3)=-UN
  77.       QRCOUR.XCONQR(1,4)=UN
  78.       QRCOUR.XCONQR(2,4)=ZERO
  79.       QRCOUR.XCONQR(1,5)=UN
  80.       QRCOUR.XCONQR(2,5)=UN
  81.       QRCOUR.XCONQR(1,6)=ZERO
  82.       QRCOUR.XCONQR(2,6)=UN
  83.       QRCOUR.XCONQR(1,7)=-UN
  84.       QRCOUR.XCONQR(2,7)=UN
  85.       QRCOUR.XCONQR(1,8)=-UN
  86.       QRCOUR.XCONQR(2,8)=ZERO
  87.       QRCOUR.XCONQR(1,9)=ZERO
  88.       QRCOUR.XCONQR(2,9)=ZERO
  89. *
  90. * Numero du centre
  91. *
  92.       QRCOUR.NUCENT=9
  93. *
  94. * Faces du QUA9 : 4 SEG3
  95. *
  96. *     Chapeau
  97.       NBNN=0
  98.       NBELEM=0
  99.       NBSOUS=1
  100.       NBREF=0
  101.       SEGINI MYMEL
  102. *     Faces SEG3
  103.       NBNN=3
  104.       NBELEM=4
  105.       NBSOUS=0
  106.       NBREF=0
  107.       SEGINI SOUMEL
  108.       CALL FICH4('SEG3',NOMS,NOMBR,
  109.      $     NUMER,
  110.      $     IMPR,IRET)
  111.       IF (IRET.NE.0) GOTO 9999
  112.       SOUMEL.ITYPEL=NUMER
  113. *     Face 1
  114.       SOUMEL.NUM(1,1)=1
  115.       SOUMEL.NUM(2,1)=2
  116.       SOUMEL.NUM(3,1)=3
  117. *     Face 2
  118.       SOUMEL.NUM(1,2)=3
  119.       SOUMEL.NUM(2,2)=4
  120.       SOUMEL.NUM(3,2)=5
  121. *     Face 3
  122.       SOUMEL.NUM(1,3)=5
  123.       SOUMEL.NUM(2,3)=6
  124.       SOUMEL.NUM(3,3)=7
  125. *     Face 4
  126.       SOUMEL.NUM(1,4)=7
  127.       SOUMEL.NUM(2,4)=8
  128.       SOUMEL.NUM(3,4)=1
  129.       SEGDES SOUMEL
  130.       MYMEL.LISOUS(1)=SOUMEL
  131.       SEGDES MYMEL
  132.       QRCOUR.LFACE=MYMEL
  133.       SEGDES QRCOUR
  134.       MYQRFS.LISQRF(**)=QRCOUR
  135. *
  136. * Normal termination
  137. *
  138.       IRET=0
  139.       RETURN
  140. *
  141. * Format handling
  142. *
  143. *
  144. * Error handling
  145. *
  146.  9999 CONTINUE
  147.       IRET=1
  148.       WRITE(IOIMP,*) 'An error was detected in subroutine inqrqu'
  149.       RETURN
  150. *
  151. * End of subroutine INQRQU
  152. *
  153.       END
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  

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