Esope source files

   1 : C EXINCO    SOURCE    GOUNAND   11/06/14    21:15:21     7005           
   2 :       SUBROUTINE EXINCO()
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : EXINCO
   7 : C DESCRIPTION : Extrait d'une matrice RIGIDITE ou MATRIK
   8 : C               la sous-matrice
   9 : C               d'inconnues primales et duales celles données
  10 : C               en argument CH*4
  11 : C
  12 : C
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C APPELES          : 
  18 : C APPELES (E/S)    : 
  19 : C APPELES (BLAS)   :
  20 : C APPELES (CALCUL) :
  21 : C APPELE PAR       :
  22 : C***********************************************************************
  23 : C SYNTAXE GIBIANE    :
  24 : C    MATRIK2  = 'KOPS'  'EXTRINCO'  MATRIK1 LMOT1 LMOT2 ;
  25 : C                                   RIGI1
  26 : C ENTREES            :
  27 : C ENTREES/SORTIES    :
  28 : C SORTIES            :
  29 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  30 : C***********************************************************************
  31 : C VERSION    : v1, 30/05/2011, version initiale
  32 : C HISTORIQUE : v1, 30/05/2011, création
  33 : C HISTORIQUE :
  34 : C HISTORIQUE :
  35 : C***********************************************************************
  36 : -INC CCOPTIO
  37 : -INC SMLMOTS
  38 :       POINTEUR LINCP.MLMOTS
  39 :       POINTEUR LINCD.MLMOTS
  40 : *
  41 :       INTEGER IMPR,IRET
  42 :       CHARACTER*8 MONTYP
  43 : *     
  44 : * Executable statements
  45 : *
  46 :       IMPR=0
  47 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans exinco.eso' 
  48 : *     
  49 : * Lecture des arguments
  50 : *     
  50 :       CALL LIROBJ('LISTMOTS',LINCP,1,IRETOU)
  51 :       IF (IERR.NE.0) RETURN
  51 :       CALL LIROBJ('LISTMOTS',LINCD,1,IRETOU)
  52 :       IF (IERR.NE.0) RETURN
  52 :       CALL QUETYP(MONTYP,0    ,IRETOU)                                          
  53 :       IF (IRETOU.EQ.0) THEN                                                     
  53 :          CALL ERREUR(533)                                                       
  54 :          RETURN                                                                 
  55 :       ENDIF       
  56 : *
  57 : * Avec des MATRIK
  58 : *
  59 :       IF (MONTYP.EQ.'MATRIK  ') THEN
  59 :          CALL LIROBJ('MATRIK  ',MATIN,1,IRETOU)
  60 :          IF (IERR.NE.0) RETURN
  61 : *
  61 :          CALL EXINCK(MATIN,LINCP,LINCD,MATOUT,IMPR,IRET)
  62 :          IF (IRET.NE.0) GOTO 9999
  63 : *     
  63 :          CALL ECROBJ('MATRIK  ',MATOUT)
  64 : *
  65 : * Avec des RIGIDITE
  66 : *
  67 :       ELSEIF (MONTYP.EQ.'RIGIDITE') THEN
  67 :          CALL LIROBJ('RIGIDITE',IRIG,1,IRET)
  68 :          IF (IERR.NE.0) RETURN
  69 : *
  69 :          CALL EXINCR(IRIG,LINCP,LINCD,IRIG2)
  70 :          IF (IERR.NE.0) RETURN
  71 : *
  71 :          CALL ECROBJ('RIGIDITE',IRIG2)
  72 :       ELSE
  73 :          MOTERR(1:8)=MONTYP
  73 :          CALL ERREUR(39)
  74 :       ENDIF
  75 : *
  76 : * Normal termination
  77 : *
  78 : *      IRET=0
  79 :       RETURN
  80 : *
  81 : * Format handling
  82 : *
  83 : *
  84 : * Error handling
  85 : *
  86 :  9999 CONTINUE
  87 : *      IRET=1
  88 :       WRITE(IOIMP,*) 'An error was detected in subroutine exinco'
  88 :       CALL ERREUR(5)
  89 :       RETURN
  90 : *
  91 : * End of subroutine EXINCO
  92 : *
  93 :       END
  94 : 
  95 :  
  96 :  
  97 :  
  98 :  
  99 :