Esope source files

   1 : C MACHI2    SOURCE    GOUNAND   11/07/01    21:15:18     7020           
   2 :       SUBROUTINE MACHI2(IKAS)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C***********************************************************************
   6 : C NOM         : MACHI2
   7 : C DESCRIPTION : Changement de noms d'inconnues duales
   8 : C               d'une matrice (type MATRIK) pour qu'ils soient 
   9 : C               identiques aux noms d'inconnues primales
  10 : C               IKAS=1
  11 : C               ou pour qu'ils correspondent aux noms d'inconnues 
  12 : C               primales (noms standard CASTEM)
  13 : C               IKAS=2
  14 : C
  15 : C
  16 : C
  17 : C LANGAGE     : ESOPE
  18 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  19 : C               mél : gounand@semt2.smts.cea.fr
  20 : C***********************************************************************
  21 : C APPELES          : 
  22 : C APPELES (E/S)    :
  23 : C APPELES (BLAS)   :
  24 : C APPELES (CALCUL) :
  25 : C APPELE PAR       :
  26 : C***********************************************************************
  27 : C SYNTAXE GIBIANE    : 
  28 : C    MATRIK2  = 'KOPS'  'NINCDUPR'  MATRIK1 ;
  29 : C ENTREES            : -
  30 : C ENTREES/SORTIES    : -
  31 : C SORTIES            : -
  32 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  33 : C***********************************************************************
  34 : C VERSION    : v1, 22/02/2006, version initiale
  35 : C HISTORIQUE : v1, 22/02/2006, création
  36 : C HISTORIQUE :
  37 : C HISTORIQUE :
  38 : C***********************************************************************
  39 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  40 : C en cas de modification de ce sous-programme afin de faciliter
  41 : C la maintenance !
  42 : C***********************************************************************
  43 : -INC CCOPTIO
  44 : -INC CCHAMP
  45 : -INC SMLMOTS
  46 :       POINTEUR PRI.MLMOTS
  47 :       POINTEUR DUA.MLMOTS
  48 :       CHARACTER*8 MTYP,TYPE
  49 :       CHARACTER*8 BLAN,TYCHPO,TYLMOT,TYMATK,TYRIGI
  50 : *     
  51 : * Executable statements
  52 : *
  53 :       BLAN='        '
  54 :       TYCHPO='CHPOINT '
  55 :       TYLMOT='LISTMOTS'
  56 :       TYMATK='MATRIK  '
  57 :       TYRIGI='RIGIDITE'
  58 : * On construit les noms primaux et duaux en recopiant NOMDD et NOMDU 
  59 : * de CCHAMP
  60 : *
  61 :       JGN=4
  62 :       JGM=LNOMDD
  63 :       SEGINI PRI
  64 :       DO IGM=1,JGM
  65 :          PRI.MOTS(IGM)=NOMDD(IGM)
  66 :       ENDDO
  67 :       SEGDES PRI
  68 :       JGN=4
  69 :       JGM=LNOMDU
  70 :       SEGINI DUA
  71 :       DO IGM=1,JGM
  72 :          DUA.MOTS(IGM)=NOMDU(IGM)
  73 :       ENDDO
  74 :       SEGDES DUA
  75 :       TYPE=BLAN
  75 :       CALL QUETYP(TYPE,1,IRET)
  76 :       IF (TYPE.EQ.TYCHPO) THEN
  77 :          MTYP=TYLMOT
  78 :          IF (IKAS.EQ.1) THEN
  78 :             CALL ECROBJ(MTYP,PRI)
  78 :             CALL ECROBJ(MTYP,DUA)
  79 :          ELSEIF (IKAS.EQ.2) THEN
  79 :             CALL ECROBJ(MTYP,DUA)
  79 :             CALL ECROBJ(MTYP,PRI)
  80 :          ELSE
  80 :             CALL ERREUR(5)
  81 :             RETURN
  82 :          ENDIF
  82 :          CALL NOMC
  83 :       ELSEIF (TYPE.EQ.TYMATK.OR.TYPE.EQ.TYRIGI) THEN
  84 :          MTYP=TYLMOT
  85 :          IF (IKAS.EQ.1) THEN
  85 :             CALL ECROBJ(MTYP,PRI)
  85 :             CALL ECROBJ(MTYP,DUA)
  85 :             CALL ECROBJ(MTYP,PRI)
  85 :             CALL ECROBJ(MTYP,PRI)
  86 :          ELSEIF (IKAS.EQ.2) THEN
  86 :             CALL ECROBJ(MTYP,DUA)
  86 :             CALL ECROBJ(MTYP,PRI)
  86 :             CALL ECROBJ(MTYP,PRI)
  86 :             CALL ECROBJ(MTYP,PRI)
  87 :          ELSE
  87 :             CALL ERREUR(5)
  88 :             RETURN
  89 :          ENDIF
  89 :          CALL MACHIN
  90 :       ELSE
  91 :          MOTERR(1:8)=TYPE
  92 : *  39 2
  93 : *On ne veut pas d'objet de type %m1:8
  93 :          CALL ERREUR(131)
  94 :       ENDIF
  95 : *
  96 : * Normal termination
  97 : *
  98 :       RETURN
  99 : *
 100 : * Format handling
 101 : *
 102 : *
 103 : * Error handling
 104 : *
 105 :  9999 CONTINUE
 106 :       WRITE(IOIMP,*) 'An error was detected in subroutine machi2'
 106 :       CALL ERREUR(5)
 107 :       RETURN
 108 : *
 109 : * End of subroutine MACHI2
 110 : *
 111 :       END
 112 : 
 113 :  
 114 :  
 115 :  
 116 :  
 117 :  
 118 :  
 119 :