Esope source files

   1 : C FICOMP    SOURCE    GOUNAND   05/12/21    21:20:31     5281           
   2 :       SUBROUTINE FICOMP(CNOM,MYCOMS,
   3 :      $     MYCOM,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : FICOMP
   9 : C PROJET      : Noyau linéaire NLIN
  10 : C DESCRIPTION : Cherche les infos sur une loi de comportement par son 
  11 : C               nom.
  12 : C
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C APPELES          : OOOETA (état d'un segment)
  18 : C APPELE PAR       :
  19 : C***********************************************************************
  20 : C ENTREES            :
  21 : C                     
  22 : C SORTIES            :
  23 : C***********************************************************************
  24 : C VERSION    : v1, 10/05/04, version initiale
  25 : C HISTORIQUE : v1, 10/05/04, création
  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 SLCOMP
  34 :       SEGMENT COMP
  35 :       CHARACTER*8 NOMCOM
  36 :       INTEGER DERCOF(NCOCOF)
  37 :       LOGICAL LTREF
  38 :       ENDSEGMENT
  39 :       SEGMENT COMPS
  40 :       POINTEUR LISCOM(NBCOMP).COMP
  41 :       ENDSEGMENT
  42 : CENDINCLUDE SLCOMP
  43 :       POINTEUR MYCOMS.COMPS
  44 :       POINTEUR COCOUR.COMP
  45 :       POINTEUR MYCOM.COMP
  46 : *
  47 :       INTEGER IMPR,IRET
  48 : *
  49 :       CHARACTER*(*) CNOM
  50 :       INTEGER LCNOM
  51 :       INTEGER MCSETA
  52 :       INTEGER ICOMPS,NCOMPS
  53 :       LOGICAL LFOUND
  54 : *     
  55 : * Executable statements
  56 : *
  57 :       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ficomp'
  58 :       LFOUND=.FALSE.
  59 :       LCNOM=LEN(CNOM)
  60 : * On veut laisser MYCOMS dans le même état (actif, inactif) qu'avant
  61 : * l'appel à FICOMP.
  61 :       CALL OOOETA(MYCOMS,MCSETA)
  62 :       IF (MCSETA.NE.1) SEGACT MYCOMS
  63 :       NCOMPS=MYCOMS.LISCOM(/1)
  64 :       ICOMPS=0
  65 : * Boucle 1 : repeat...until
  66 :  1    CONTINUE
  67 :       ICOMPS=ICOMPS+1
  68 :       COCOUR=MYCOMS.LISCOM(ICOMPS)
  69 :       SEGACT COCOUR
  70 :       IF (COCOUR.NOMCOM(/1).EQ.LCNOM) THEN
  71 :          IF (COCOUR.NOMCOM.EQ.CNOM) THEN
  72 :             LFOUND=.TRUE.
  73 :          ENDIF
  74 :       ENDIF
  75 :       SEGDES COCOUR
  76 :       IF (.NOT.LFOUND.AND.ICOMPS.LT.NCOMPS) GOTO 1
  77 :       IF (LFOUND) THEN
  78 :          MYCOM=COCOUR
  79 :       ELSE
  80 :          WRITE(IOIMP,*) 'On n''a pas trouvé ',CNOM,
  81 :      $        'dans les lois de comportement'
  82 :          GOTO 9999
  83 :       ENDIF
  84 :       IF (MCSETA.NE.1) SEGDES MYCOMS
  85 : *
  86 : * Normal termination
  87 : *
  88 :       IRET=0
  89 :       RETURN
  90 : *
  91 : * Format handling
  92 : *
  93 : *
  94 : * Error handling
  95 : *
  96 :  9999 CONTINUE
  97 :       IRET=1
  98 :       WRITE(IOIMP,*) 'An error was detected in subroutine ficomp'
  99 :       RETURN
 100 : *
 101 : * End of subroutine ficomp
 102 : *
 103 :       END
 104 : 
 105 :