Esope source files

   1 : C INQRSE    SOURCE    CHAT      07/10/29    21:21:03     5940           
   2 :       SUBROUTINE INQRSE(MYQRFS,IMPR,IRET)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : INQRSE
   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 : *
  53 :       REAL*8 ZERO,UN
  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 inqrse'
  61 : *
  62 : * Elément QUAF SEG3
  63 : *
  64 : 
  65 :       NDIMQR=1
  66 :       NBNOQR=3
  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('SEG3',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)=-UN
  79 :       QRCOUR.XCONQR(1,2)=ZERO
  80 :       QRCOUR.XCONQR(1,3)=UN
  81 : *
  82 : * Numero du centre
  83 : *
  84 :       QRCOUR.NUCENT=2
  85 : *
  86 : * Faces du SEG3 : 2 POI1
  87 : *
  88 : *     Chapeau
  89 :       NBNN=0
  90 :       NBELEM=0
  91 :       NBSOUS=1
  92 :       NBREF=0
  93 :       SEGINI MYMEL
  94 : *     Faces SEG3
  95 :       NBNN=3
  96 :       NBELEM=3
  97 :       NBSOUS=0
  98 :       NBREF=0
  99 :       SEGINI SOUMEL
  99 :       CALL FICH4('POI1',NOMS,NOMBR,
 100 :      $     NUMER,
 101 :      $     IMPR,IRET)
 102 :       IF (IRET.NE.0) GOTO 9999
 103 :       SOUMEL.ITYPEL=NUMER
 104 : *     Face 1
 105 :       SOUMEL.NUM(1,1)=1
 106 : *     Face 2
 107 :       SOUMEL.NUM(1,2)=3
 108 :       SEGDES SOUMEL
 109 :       MYMEL.LISOUS(1)=SOUMEL
 110 :       SEGDES MYMEL
 111 :       QRCOUR.LFACE=MYMEL
 112 : 
 113 : *
 114 : * Pas de faces pour un segment
 115 : *
 116 :       SEGDES QRCOUR
 117 :       MYQRFS.LISQRF(**)=QRCOUR
 118 : *
 119 : * Normal termination
 120 : *
 121 :       IRET=0
 122 :       RETURN
 123 : *
 124 : * Format handling
 125 : *
 126 : *
 127 : * Error handling
 128 : *
 129 :  9999 CONTINUE
 130 :       IRET=1
 131 :       WRITE(IOIMP,*) 'An error was detected in subroutine inqrse'
 132 :       RETURN
 133 : *
 134 : * End of subroutine INQRSE
 135 : *
 136 :       END
 137 : 
 138 :  
 139 :  
 140 :