Esope source files

   1 : C INQRFS    SOURCE    GOUNAND   06/08/04    21:16:17     5520           
   2 :       SUBROUTINE INQRFS(MYQRFS,IMPR,IRET)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : INQRFS
   7 : C PROJET      : Noyau linéaire NLIN
   8 : C DESCRIPTION : Initialise le segment contenant les informations sur
   9 : C               les QUAFs de référence.
  10 : C
  11 : C LANGAGE     : ESOPE
  12 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13 : C               mél : gounand@semt2.smts.cea.fr
  14 : C***********************************************************************
  15 : C APPELES          : 
  16 : C APPELES (E/S)    : PRQRF
  17 : C APPELE PAR       : 
  18 : C***********************************************************************
  19 : C ENTREES            : -
  20 : C SORTIES            : MYQRFS
  21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22 : C***********************************************************************
  23 : C VERSION    : v1, 17/10/02, version initiale
  24 : C HISTORIQUE : v1, 17/10/02, création
  25 : C HISTORIQUE :
  26 : C HISTORIQUE :
  27 : C***********************************************************************
  28 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29 : C en cas de modification de ce sous-programme afin de faciliter
  30 : C la maintenance !
  31 : C***********************************************************************
  32 : -INC CCOPTIO
  33 : CBEGININCLUDE SIQUAF
  34 :       SEGMENT IQUAF
  35 :       INTEGER NUMQUF
  36 :       REAL*8 XCONQR(NDIMQR,NBNOQR)
  37 :       INTEGER NUCENT
  38 :       POINTEUR LFACE.MELEME
  39 :       ENDSEGMENT
  40 :       SEGMENT IQUAFS
  41 :       POINTEUR LISQRF(NBQRF).IQUAF
  42 :       ENDSEGMENT
  43 : CENDINCLUDE SIQUAF
  44 :       POINTEUR MYQRFS.IQUAFS
  45 :       POINTEUR QRCOUR.IQUAF
  46 :       INTEGER NBQRF
  47 : *
  48 :       INTEGER IMPR,IRET
  49 : *
  50 :       INTEGER NBDQR,INBDQR
  51 : *     
  52 : * Executable statements
  53 : *
  54 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrfs'
  55 : *
  56 : * Initialisation du segment contenant les infos sur les QUAFS
  57 : * de référence 
  58 : *
  59 :       NBQRF=0
  60 :       SEGINI MYQRFS
  61 : *
  62 : * On initialise les QUAFs de référence de dimension 1 (segments)
  63 : *
  63 :       CALL INQRSE(MYQRFS,IMPR,IRET)
  64 :       IF (IRET.NE.0) GOTO 9999
  65 : *
  66 : * On initialise les éléments de référence de dimension 2
  67 : * de forme géométrique triangulaire.
  68 : *
  68 :       CALL INQRTR(MYQRFS,IMPR,IRET)
  69 :       IF (IRET.NE.0) GOTO 9999
  70 : *
  71 : * On initialise les éléments de référence de dimension 2
  72 : * de forme géométrique carrée.
  73 : *
  73 :       CALL INQRQU(MYQRFS,IMPR,IRET)
  74 :       IF (IRET.NE.0) GOTO 9999
  75 : *
  76 : * On initialise les éléments de référence de dimension 3
  77 : * de forme géométrique tétraèdrique.
  78 : *
  78 :       CALL INQRTE(MYQRFS,IMPR,IRET)
  79 :       IF (IRET.NE.0) GOTO 9999
  80 : *
  81 : * On initialise les éléments de référence de dimension 3
  82 : * de forme géométrique pyramidale.
  83 : *
  83 :       CALL INQRPY(MYQRFS,IMPR,IRET)
  84 :       IF (IRET.NE.0) GOTO 9999
  85 : *
  86 : * On initialise les éléments de référence de dimension 3
  87 : * de forme géométrique prismatique à base triangle.
  88 : *
  88 :       CALL INQRPR(MYQRFS,IMPR,IRET)
  89 :       IF (IRET.NE.0) GOTO 9999
  90 : *
  91 : * On initialise les éléments de référence de dimension 3
  92 : * de forme géométrique cubique.
  93 : *
  93 :       CALL INQRCU(MYQRFS,IMPR,IRET)
  94 :       IF (IRET.NE.0) GOTO 9999
  95 : *
  96 : * Impression finale
  97 : *     
  98 :       NBDQR=MYQRFS.LISQRF(/1)
  99 :       IF (IMPR.GT.1) THEN
 100 :          DO 3 INBDQR=1,NBDQR
 101 :             WRITE(IOIMP,*) 'Quaf. de référence ',INBDQR
 102 :             QRCOUR=MYQRFS.LISQRF(INBDQR)
 102 :             CALL PRQRF(QRCOUR,IMPR,IRET)
 103 :             IF (IRET.NE.0) GOTO 9999
 104 :  3       CONTINUE
 105 :       ENDIF
 106 :       SEGDES MYQRFS
 107 : *
 108 : * Normal termination
 109 : *
 110 :       IRET=0
 111 :       RETURN
 112 : *
 113 : * Format handling
 114 : *
 115 : *
 116 : * Error handling
 117 : *
 118 :  9999 CONTINUE
 119 :       IRET=1
 120 :       WRITE(IOIMP,*) 'An error was detected in subroutine inqrfs'
 121 :       RETURN
 122 : *
 123 : * End of subroutine INQRFS
 124 : *
 125 :       END
 126 : 
 127 :  
 128 :