Esope source files

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