Télécharger la plaquette Cast3M


fr en

Télécharger inqrpr.eso

Retour à la liste

Numérotation des lignes : 

inqrpr

  1. C INQRPR    SOURCE    GOUNAND   21/06/02    21:16:57     11022          
  2.       SUBROUTINE INQRPR(MYQRFS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : INQRPR
  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, 15/03/04, version initiale
  22. C HISTORIQUE : v1, 15/03/04, 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. -INC SMLENTI
  44.       POINTEUR INOD.MLENTI
  45. -INC SMLREEL
  46.       POINTEUR ZVAL.MLREEL
  47.       POINTEUR YVAL.MLREEL
  48.       POINTEUR XVAL.MLREEL
  49. *
  50.       INTEGER IMPR,IRET
  51.       REAL*8 ZERO,UN
  52.       REAL*8 UNS3
  53.       REAL*8 UNS2
  54.       PARAMETER (UNS3=1.D0/3.D0)
  55.       PARAMETER (UNS2=1.D0/2.D0)
  56.       PARAMETER (ZERO=0.D0,UN=1.D0)
  57. *
  58.       INTEGER NUMER
  59. *
  60. * Executable statements
  61. *
  62.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrpr'
  63. *
  64. * Elément QUAF PR21
  65. *
  66.       NDIMQR=3
  67.       NBNOQR=21
  68.       SEGINI QRCOUR
  69. * Numéro de l'élément géométrique dans NOMS
  70. * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  71. * cf. include CCGEOME
  72.       CALL FICH4('PR21',NOMS,NOMBR,
  73.      $     NUMER,
  74.      $     IMPR,IRET)
  75.       IF (IRET.NE.0) GOTO 9999
  76.       QRCOUR.NUMQUF=NUMER
  77. *
  78. * Coordonnées des noeuds du QUAF de référence
  79. *
  80.       JG=21
  81.       SEGINI INOD
  82.       DO IDDL=1,6
  83.          INOD.LECT(IDDL)=IDDL
  84.       ENDDO
  85.       INOD.LECT( 7)=19
  86.       INOD.LECT( 8)= 7
  87.       INOD.LECT( 9)=16
  88.       INOD.LECT(10)= 8
  89.       INOD.LECT(11)=17
  90.       INOD.LECT(12)= 9
  91.       INOD.LECT(13)=18
  92.       INOD.LECT(14)=21
  93.       DO IDDL=15,20
  94.          INOD.LECT(IDDL)=IDDL-5
  95.       ENDDO
  96.       INOD.LECT(21)=20
  97. *
  98.       JG=3
  99.       SEGINI ZVAL
  100.       ZVAL.PROG(1)=-UN
  101.       ZVAL.PROG(2)=ZERO
  102.       ZVAL.PROG(3)=UN
  103.       JG=7
  104.       SEGINI XVAL
  105.       SEGINI YVAL
  106.       XVAL.PROG(1)=ZERO
  107.       YVAL.PROG(1)=ZERO
  108.       XVAL.PROG(2)=UNS2
  109.       YVAL.PROG(2)=ZERO
  110.       XVAL.PROG(3)=UN
  111.       YVAL.PROG(3)=ZERO
  112.       XVAL.PROG(4)=UNS2
  113.       YVAL.PROG(4)=UNS2
  114.       XVAL.PROG(5)=ZERO
  115.       YVAL.PROG(5)=UN
  116.       XVAL.PROG(6)=ZERO
  117.       YVAL.PROG(6)=UNS2
  118.       XVAL.PROG(7)=UNS3
  119.       YVAL.PROG(7)=UNS3
  120.       ICPT=0
  121.       DO IZ=1,3
  122.          DO IT=1,7
  123.             ICPT=ICPT+1
  124.             JNOD=INOD.LECT(ICPT)
  125.             QRCOUR.XCONQR(1,JNOD)=XVAL.PROG(IT)
  126.             QRCOUR.XCONQR(2,JNOD)=YVAL.PROG(IT)
  127.             QRCOUR.XCONQR(3,JNOD)=ZVAL.PROG(IZ)
  128.          ENDDO
  129.       ENDDO
  130.       SEGSUP ZVAL
  131.       SEGSUP YVAL
  132.       SEGSUP XVAL
  133.       SEGSUP INOD
  134. *
  135. * Numero du centre
  136. *
  137.       QRCOUR.NUCENT=21
  138. *
  139. * Faces du PR21 : 2 TRI7 + 3 QUA9
  140. *
  141. *     Chapeau
  142.       NBNN=0
  143.       NBELEM=0
  144.       NBSOUS=2
  145.       NBREF=0
  146.       SEGINI MYMEL
  147. *     2 Faces TRI7
  148.       NBNN=7
  149.       NBELEM=2
  150.       NBSOUS=0
  151.       NBREF=0
  152.       SEGINI SOUMEL
  153.       CALL FICH4('TRI7',NOMS,NOMBR,
  154.      $     NUMER,
  155.      $     IMPR,IRET)
  156.       IF (IRET.NE.0) GOTO 9999
  157.       SOUMEL.ITYPEL=NUMER
  158. *     Face 1
  159.       SOUMEL.NUM(1,1)=1
  160.       SOUMEL.NUM(2,1)=2
  161.       SOUMEL.NUM(3,1)=3
  162.       SOUMEL.NUM(4,1)=4
  163.       SOUMEL.NUM(5,1)=5
  164.       SOUMEL.NUM(6,1)=6
  165.       SOUMEL.NUM(7,1)=19
  166. *     Face 2
  167.       SOUMEL.NUM(1,2)=10
  168.       SOUMEL.NUM(2,2)=11
  169.       SOUMEL.NUM(3,2)=12
  170.       SOUMEL.NUM(4,2)=13
  171.       SOUMEL.NUM(5,2)=14
  172.       SOUMEL.NUM(6,2)=15
  173.       SOUMEL.NUM(7,2)=20
  174.       SEGDES SOUMEL
  175.       MYMEL.LISOUS(1)=SOUMEL
  176. *     3 Faces QUA9
  177.       NBNN=9
  178.       NBELEM=3
  179.       NBSOUS=0
  180.       NBREF=0
  181.       SEGINI SOUMEL
  182.       CALL FICH4('QUA9',NOMS,NOMBR,
  183.      $     NUMER,
  184.      $     IMPR,IRET)
  185.       IF (IRET.NE.0) GOTO 9999
  186.       SOUMEL.ITYPEL=NUMER
  187. *     Face 1
  188.       SOUMEL.NUM(1,1)=1
  189.       SOUMEL.NUM(2,1)=2
  190.       SOUMEL.NUM(3,1)=3
  191.       SOUMEL.NUM(4,1)=8
  192.       SOUMEL.NUM(5,1)=12
  193.       SOUMEL.NUM(6,1)=11
  194.       SOUMEL.NUM(7,1)=10
  195.       SOUMEL.NUM(8,1)=7
  196.       SOUMEL.NUM(9,1)=16
  197. *     Face 2
  198.       SOUMEL.NUM(1,2)=3
  199.       SOUMEL.NUM(2,2)=4
  200.       SOUMEL.NUM(3,2)=5
  201.       SOUMEL.NUM(4,2)=9
  202.       SOUMEL.NUM(5,2)=14
  203.       SOUMEL.NUM(6,2)=13
  204.       SOUMEL.NUM(7,2)=12
  205.       SOUMEL.NUM(8,2)=8
  206.       SOUMEL.NUM(9,2)=17
  207. *     Face 3
  208.       SOUMEL.NUM(1,3)=5
  209.       SOUMEL.NUM(2,3)=6
  210.       SOUMEL.NUM(3,3)=1
  211.       SOUMEL.NUM(4,3)=7
  212.       SOUMEL.NUM(5,3)=10
  213.       SOUMEL.NUM(6,3)=15
  214.       SOUMEL.NUM(7,3)=14
  215.       SOUMEL.NUM(8,3)=9
  216.       SOUMEL.NUM(9,3)=18
  217.       SEGDES SOUMEL
  218.       MYMEL.LISOUS(2)=SOUMEL
  219.       SEGDES MYMEL
  220.       QRCOUR.LFACE=MYMEL
  221.       SEGDES QRCOUR
  222.       MYQRFS.LISQRF(**)=QRCOUR
  223. *
  224. * Normal termination
  225. *
  226.       IRET=0
  227.       RETURN
  228. *
  229. * Format handling
  230. *
  231. *
  232. * Error handling
  233. *
  234.  9999 CONTINUE
  235.       IRET=1
  236.       WRITE(IOIMP,*) 'An error was detected in subroutine inqrpr'
  237.       RETURN
  238. *
  239. * End of subroutine INQRPR
  240. *
  241.       END
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  

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