Esope source files

   1 : C INQRTR    SOURCE    CHAT      07/10/29    21:21:07     5940           
   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 : -INC CCOPTIO
  31 : -INC CCGEOME
  32 : CBEGININCLUDE SIQUAF
  33 :       SEGMENT IQUAF
  34 :       INTEGER NUMQUF
  35 :       REAL*8 XCONQR(NDIMQR,NBNOQR)
  36 :       INTEGER NUCENT
  37 :       POINTEUR LFACE.MELEME
  38 :       ENDSEGMENT
  39 :       SEGMENT IQUAFS
  40 :       POINTEUR LISQRF(NBQRF).IQUAF
  41 :       ENDSEGMENT
  42 : CENDINCLUDE SIQUAF
  43 :       POINTEUR MYQRFS.IQUAFS
  44 :       POINTEUR QRCOUR.IQUAF
  45 :       INTEGER NDIMQR,NBNOQR
  46 : -INC SMELEME
  47 :       POINTEUR MYMEL.MELEME
  48 :       POINTEUR SOUMEL.MELEME
  49 :       INTEGER NBNN,NBELEM,NBSOUS,NBREF
  50 : *
  51 :       INTEGER IMPR,IRET
  52 :       REAL*8 ZERO,UN,UNS3,UNS2
  53 : *
  54 :       PARAMETER (ZERO=0.D0,UN=1.D0,UNS3=1.D0/3.D0,UNS2=1.D0/2.D0)
  55 : *
  56 :       INTEGER NUMER
  57 : *     
  58 : * Executable statements
  59 : *
  60 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrtr'
  61 : *
  62 : * Elément QUAF TRI7
  63 : *
  64 : 
  65 :       NDIMQR=2
  66 :       NBNOQR=7
  67 :       SEGINI QRCOUR
  68 : * Numéro de l'élément géométrique dans NOMS
  69 : * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  70 : * cf. include CCGEOME
  70 :       CALL FICH4('TRI7',NOMS,NOMBR,
  71 :      $     NUMER,
  72 :      $     IMPR,IRET)
  73 :       IF (IRET.NE.0) GOTO 9999
  74 :       QRCOUR.NUMQUF=NUMER
  75 : *
  76 : * Coordonnées des noeuds du QUAF de référence
  77 : *
  78 :       QRCOUR.XCONQR(1,1)=ZERO
  79 :       QRCOUR.XCONQR(2,1)=ZERO
  80 :       QRCOUR.XCONQR(1,2)=UNS2
  81 :       QRCOUR.XCONQR(2,2)=ZERO
  82 :       QRCOUR.XCONQR(1,3)=UN
  83 :       QRCOUR.XCONQR(2,3)=ZERO
  84 :       QRCOUR.XCONQR(1,4)=UNS2
  85 :       QRCOUR.XCONQR(2,4)=UNS2
  86 :       QRCOUR.XCONQR(1,5)=ZERO
  87 :       QRCOUR.XCONQR(2,5)=UN
  88 :       QRCOUR.XCONQR(1,6)=ZERO
  89 :       QRCOUR.XCONQR(2,6)=UNS2
  90 :       QRCOUR.XCONQR(1,7)=UNS3
  91 :       QRCOUR.XCONQR(2,7)=UNS3
  92 : *
  93 : * Numero du centre
  94 : *
  95 :       QRCOUR.NUCENT=7
  96 : *
  97 : * Faces du TRI7 : 3 SEG3
  98 : *
  99 : *     Chapeau
 100 :       NBNN=0
 101 :       NBELEM=0
 102 :       NBSOUS=1
 103 :       NBREF=0
 104 :       SEGINI MYMEL
 105 : *     Faces SEG3
 106 :       NBNN=3
 107 :       NBELEM=3
 108 :       NBSOUS=0
 109 :       NBREF=0
 110 :       SEGINI SOUMEL
 110 :       CALL FICH4('SEG3',NOMS,NOMBR,
 111 :      $     NUMER,
 112 :      $     IMPR,IRET)
 113 :       IF (IRET.NE.0) GOTO 9999
 114 :       SOUMEL.ITYPEL=NUMER
 115 : *     Face 1
 116 :       SOUMEL.NUM(1,1)=1
 117 :       SOUMEL.NUM(2,1)=2
 118 :       SOUMEL.NUM(3,1)=3
 119 : *     Face 2
 120 :       SOUMEL.NUM(1,2)=3
 121 :       SOUMEL.NUM(2,2)=4
 122 :       SOUMEL.NUM(3,2)=5
 123 : *     Face 3
 124 :       SOUMEL.NUM(1,3)=5
 125 :       SOUMEL.NUM(2,3)=6
 126 :       SOUMEL.NUM(3,3)=1
 127 :       SEGDES SOUMEL
 128 :       MYMEL.LISOUS(1)=SOUMEL
 129 :       SEGDES MYMEL
 130 :       QRCOUR.LFACE=MYMEL
 131 :       SEGDES QRCOUR
 132 :       MYQRFS.LISQRF(**)=QRCOUR
 133 : *
 134 : * Normal termination
 135 : *
 136 :       IRET=0
 137 :       RETURN
 138 : *
 139 : * Format handling
 140 : *
 141 : *
 142 : * Error handling
 143 : *
 144 :  9999 CONTINUE
 145 :       IRET=1
 146 :       WRITE(IOIMP,*) 'An error was detected in subroutine inqrtr'
 147 :       RETURN
 148 : *
 149 : * End of subroutine INQRTR
 150 : *
 151 :       END
 152 : 
 153 :  
 154 :  
 155 :