Esope source files

   1 : C RELR12    SOURCE    GOUNAND   11/05/24    21:15:54     6976           
   2 :       SUBROUTINE RELR12(MLIN,
   3 :      $     LINCP,LINCD,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : RELR12
   9 : C DESCRIPTION :
  10 : * Construction de :
  11 : * - l'ensemble des noms d'inconnues primales : LINCP
  12 : * - l'ensemble des noms d'inconnues duales   : LINCD
  13 : C
  14 : C
  15 : C
  16 : C LANGAGE     : ESOPE
  17 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  18 : C               mél : gounand@semt2.smts.cea.fr
  19 : C***********************************************************************
  20 : C APPELES          : 
  21 : C APPELES (E/S)    : 
  22 : C APPELES (BLAS)   :
  23 : C APPELES (CALCUL) :
  24 : C APPELE PAR       : RELR10
  25 : C***********************************************************************
  26 : C SYNTAXE GIBIANE    :
  27 : C ENTREES            :
  28 : C ENTREES/SORTIES    :
  29 : C SORTIES            :
  30 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  31 : C***********************************************************************
  32 : C VERSION    : v1, 26/06/2003, version initiale
  33 : C HISTORIQUE : v1, 26/06/2003, création
  34 : C HISTORIQUE :
  35 : C HISTORIQUE :
  36 : C***********************************************************************
  37 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  38 : C en cas de modification de ce sous-programme afin de faciliter
  39 : C la maintenance !
  40 : C***********************************************************************
  41 : -INC CCOPTIO
  42 : -INC SMCOORD
  43 : -INC SMRIGID
  44 :       POINTEUR MLIN.MRIGID
  45 :       POINTEUR DES.DESCR
  46 : -INC SMLMOTS
  47 :       POINTEUR LINCP.MLMOTS
  48 :       POINTEUR LINCD.MLMOTS
  49 :       POINTEUR LINTMP.MLMOTS
  50 : *
  51 :       INTEGER IMPR,IRET
  52 : *     
  53 : * Executable statements
  54 : *
  55 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr12.eso' 
  56 : *
  57 :       SEGACT MLIN
  58 :       NRIG=MLIN.IRIGEL(/2)
  59 : *
  60 : * Primale
  61 : *
  62 :       JGN=4
  63 :       JGM=0
  64 :       IGM=0
  65 :       SEGINI LINTMP
  66 :       DO IRIG=1,NRIG
  67 :          DES=MLIN.IRIGEL(3,IRIG)
  68 :          SEGACT DES
  69 :          NDDL=DES.LISINC(/2)
  70 :          JGM=JGM+NDDL
  71 :          SEGADJ LINTMP
  72 :          DO IDDL=1,NDDL
  73 :             IGM=IGM+1
  74 :             LINTMP.MOTS(IGM)=DES.LISINC(IDDL)
  75 :          ENDDO
  76 :          SEGDES DES
  77 :       ENDDO
  78 : * Suppression des doublons
  79 :       SEGINI LINCP
  79 :       CALL CUNIQ(LINTMP.MOTS,JGN,JGM,
  80 :      $     LINCP.MOTS,JGM2,
  81 :      $     IMPR,IRET)
  82 :       IF (IRET.NE.0) GOTO 9999
  83 :       JGM=JGM2
  84 :       SEGADJ LINCP
  85 :       SEGDES LINCP
  86 :       SEGSUP LINTMP
  87 : *
  88 : * Duale (copie conforme du dessus)
  89 : *
  90 :       JGN=4
  91 :       JGM=0
  92 :       IGM=0
  93 :       SEGINI LINTMP
  94 :       DO IRIG=1,NRIG
  95 :          DES=MLIN.IRIGEL(3,IRIG)
  96 :          SEGACT DES
  97 :          NDDL=DES.LISDUA(/2)
  98 :          JGM=JGM+NDDL
  99 :          SEGADJ LINTMP
 100 :          DO IDDL=1,NDDL
 101 :             IGM=IGM+1
 102 :             LINTMP.MOTS(IGM)=DES.LISDUA(IDDL)
 103 :          ENDDO
 104 :          SEGDES DES
 105 :       ENDDO
 106 : * Suppression des doublons
 107 :       SEGINI LINCD
 107 :       CALL CUNIQ(LINTMP.MOTS,JGN,JGM,
 108 :      $     LINCD.MOTS,JGM2,
 109 :      $     IMPR,IRET)
 110 :       IF (IRET.NE.0) GOTO 9999
 111 :       JGM=JGM2
 112 :       SEGADJ LINCD
 113 :       SEGDES LINCD
 114 :       SEGSUP LINTMP
 115 :       SEGDES MLIN
 116 : *
 117 : * Normal termination
 118 : *
 119 :       IRET=0
 120 :       RETURN
 121 : *
 122 : * Format handling
 123 : *
 124 : *
 125 : * Error handling
 126 : *
 127 :  9999 CONTINUE
 128 :       IRET=1
 129 :       WRITE(IOIMP,*) 'An error was detected in subroutine relr12'
 130 :       RETURN
 131 : *
 132 : * End of subroutine RELR12
 133 : *
 134 :       END
 135 : 
 136 :