Esope source files

   1 : C FIQUAF    SOURCE    CHAT      07/10/29    21:19:51     5940           
   2 :       SUBROUTINE FIQUAF(ITYQUF,MYQRFS,
   3 :      $     MYQRF,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : FIQUAF
   9 : C PROJET      : Noyau linéaire NLIN
  10 : C DESCRIPTION : Cherche un QUAF par son nunméro.
  11 : C
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C APPELES          : OOOETA (état d'un segment)
  17 : C APPELE PAR       : EXTFAC
  18 : C***********************************************************************
  19 : C ENTREES            :
  20 : C                     
  21 : C SORTIES            :
  22 : C***********************************************************************
  23 : C VERSION    : v1, 17/12/02, version initiale
  24 : C HISTORIQUE : v1, 17/12/02, création
  25 : C HISTORIQUE :
  26 : C***********************************************************************
  27 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  28 : C en cas de modification de ce sous-programme afin de faciliter
  29 : C la maintenance !
  30 : C***********************************************************************
  31 : -INC CCOPTIO
  32 : -INC CCGEOME
  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 :       POINTEUR MYQRF.IQUAF
  47 : *
  48 :       INTEGER IMPR,IRET
  49 : *
  50 :       INTEGER MQSETA
  51 :       INTEGER IQRFS,NQRFS
  52 :       LOGICAL LFOUND
  53 : *     
  54 : * Executable statements
  55 : *
  56 :       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans fiquaf'
  57 :       LFOUND=.FALSE.
  58 : * On veut laisser MYQRFS dans le même état (actif, inactif) qu'avant
  59 : * l'appel à FIQUAF.
  59 :       CALL OOOETA(MYQRFS,MQSETA)
  60 :       IF (MQSETA.NE.1) SEGACT MYQRFS
  61 :       NQRFS=MYQRFS.LISQRF(/1)
  62 :       IQRFS=0
  63 : * Boucle 1 : repeat...until
  64 :  1    CONTINUE
  65 :       IQRFS=IQRFS+1
  66 :       QRCOUR=MYQRFS.LISQRF(IQRFS)
  67 :       SEGACT QRCOUR
  68 :       IF (QRCOUR.NUMQUF.EQ.ITYQUF) THEN
  69 :          LFOUND=.TRUE.
  70 :       ENDIF
  71 :       SEGDES QRCOUR
  72 :       IF (.NOT.LFOUND.AND.IQRFS.LT.NQRFS) GOTO 1
  73 :       IF (LFOUND) THEN
  74 :          MYQRF=QRCOUR
  75 :       ELSE
  76 :          WRITE(IOIMP,*) 'On n''a pas trouvé ',NOMS(ITYQUF),
  77 :      $        'dans les quafs de reference'
  78 :          GOTO 9999
  79 :       ENDIF
  80 :       IF (MQSETA.NE.1) SEGDES MYQRFS
  81 : *
  82 : * Normal termination
  83 : *
  84 :       IRET=0
  85 :       RETURN
  86 : *
  87 : * Format handling
  88 : *
  89 : *
  90 : * Error handling
  91 : *
  92 :  9999 CONTINUE
  93 :       IRET=1
  94 :       WRITE(IOIMP,*) 'An error was detected in subroutine fiquaf'
  95 :       RETURN
  96 : *
  97 : * End of subroutine fiquaf
  98 : *
  99 :       END
 100 : 
 101 :  
 102 :