Esope source files

   1 : C PRMCP3    SOURCE    MAGN      09/07/30    21:20:39     6458           
   2 :       SUBROUTINE PRMCP3(MMATEL,MSOPRI,
   3 :      $     ICOGLO,ICMPRI,ICMDUA,ICCPRI,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : PRMCP3
   9 : C DESCRIPTION : Construction du repérage des inconnues.
  10 : C
  11 : * Repérage global des inconnues : ICOGLO (LISTMOTS)
  12 : * Numéros des inconnues primales et duales de la matrice exprimées 
  13 : * dans ce repérage : ICMPRI, ICMDUA
  14 : * Numéros des inconnues du chpoint primal : ICCPRI
  15 : C
  16 : C
  17 : C LANGAGE     : ESOPE
  18 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  19 : C               mél : gounand@semt2.smts.cea.fr
  20 : C***********************************************************************
  21 : C APPELES          : CUNIQ, CREPER
  22 : C APPELE PAR       : PRMCP2
  23 : C***********************************************************************
  24 : C ENTREES            : MMATEL, MSOPRI
  25 : C ENTREES/SORTIES    : -
  26 : C SORTIES            : ICOGLO, ICMPRI, ICMDUA, ICCPRI
  27 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  28 : C***********************************************************************
  29 : C VERSION    : v1, 18/04/2000, version initiale
  30 : C HISTORIQUE : v1, 18/04/2000, création
  31 : C HISTORIQUE :
  32 : C HISTORIQUE :
  33 : C***********************************************************************
  34 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35 : C en cas de modification de ce sous-programme afin de faciliter
  36 : C la maintenance !
  37 : C***********************************************************************
  38 : -INC CCOPTIO
  39 : -INC SMMATRIK
  40 :       POINTEUR MMATEL.IMATRI
  41 : -INC SMCHPOI
  42 :       POINTEUR MSOPRI.MSOUPO
  43 : -INC SMLMOTS
  44 :       INTEGER JGM,JGN
  45 :       POINTEUR ICOGLO.MLMOTS
  46 :       POINTEUR ICCPR2.MLMOTS
  47 :       POINTEUR GPINCS.MLMOTS
  48 : -INC SMLENTI
  49 :       INTEGER JG
  50 :       POINTEUR ICMPRI.MLENTI
  51 :       POINTEUR ICMDUA.MLENTI
  52 :       POINTEUR ICCPRI.MLENTI
  53 : *
  54 :       INTEGER IMPR,IRET
  55 : *
  56 :       INTEGER LNMOTS
  57 :       PARAMETER (LNMOTS=8)
  58 : *
  59 :       INTEGER IBMC,IBMM,IINC
  60 :       INTEGER NBMC,NBMM
  61 :       INTEGER NIUNIQ
  62 : *     
  63 : * Executable statements
  64 : *
  65 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp3.eso' 
  66 :       SEGACT MMATEL
  67 :       SEGACT MSOPRI
  68 :       NBMM=MMATEL.LISPRI(/2)
  69 :       NBMC=MSOPRI.NOCOMP(/2)
  70 :       JGN=LNMOTS
  71 :       JGM=NBMC
  72 :       SEGINI ICCPR2
  73 :       DO 1 IBMC=1,NBMC
  74 :          ICCPR2.MOTS(IBMC)=MSOPRI.NOCOMP(IBMC)//'    '
  75 :  1    CONTINUE
  76 :       JGN=LNMOTS
  77 :       JGM=(2*NBMM)+NBMC
  78 :       SEGINI GPINCS
  79 :       IINC=0
  80 :       DO 2 IBMM=1,NBMM
  81 :          IINC=IINC+1
  82 :          GPINCS.MOTS(IINC)=MMATEL.LISPRI(IBMM)
  83 :  2    CONTINUE
  84 :       DO 4 IBMM=1,NBMM
  85 :          IINC=IINC+1
  86 :          GPINCS.MOTS(IINC)=MMATEL.LISDUA(IBMM)
  87 :  4    CONTINUE
  88 :       DO 6 IBMC=1,NBMC
  89 :          IINC=IINC+1
  90 :          GPINCS.MOTS(IINC)=ICCPR2.MOTS(IBMC)
  91 :  6    CONTINUE
  92 : * Elimination des doublons dans les noms
  93 :       JGN=LNMOTS
  94 :       JGM=IINC
  95 :       SEGINI ICOGLO
  95 :       CALL CUNIQ(GPINCS.MOTS,LNMOTS,IINC,
  96 :      $     ICOGLO.MOTS,NIUNIQ,
  97 :      $     IMPR,IRET)
  98 :       IF (IRET.NE.0) GOTO 9999
  99 :       JGN=LNMOTS
 100 :       JGM=NIUNIQ
 101 :       SEGADJ,ICOGLO
 102 :       SEGSUP GPINCS
 103 : * Noms des inconnues primales et duales de MMATEL et du chpo. primal 
 104 : * dans le repérage défini par ICOGLO : ICMPRI, ICMDUA et ICCPRI
 105 :       JG=NBMM
 106 :       SEGINI ICMPRI
 106 :       CALL CREPER(LNMOTS,NBMM,NIUNIQ,
 107 :      $     MMATEL.LISPRI,ICOGLO.MOTS,
 108 :      $     ICMPRI.LECT,
 109 :      $     IMPR,IRET)
 110 :       IF (IRET.NE.0) GOTO 9999
 111 :       SEGDES ICMPRI
 112 :       JG=NBMM
 113 :       SEGINI ICMDUA
 113 :       CALL CREPER(LNMOTS,NBMM,NIUNIQ,
 114 :      $     MMATEL.LISDUA,ICOGLO.MOTS,
 115 :      $     ICMDUA.LECT,
 116 :      $     IMPR,IRET)
 117 :       IF (IRET.NE.0) GOTO 9999
 118 :       SEGDES ICMDUA
 119 :       JG=NBMC
 120 :       SEGINI ICCPRI
 120 :       CALL CREPER(LNMOTS,NBMC,NIUNIQ,
 121 :      $     ICCPR2.MOTS,ICOGLO.MOTS,
 122 :      $     ICCPRI.LECT,
 123 :      $     IMPR,IRET)
 124 :       IF (IRET.NE.0) GOTO 9999
 125 :       SEGDES ICCPRI
 126 :       SEGDES ICOGLO
 127 :       SEGSUP ICCPR2
 128 :       SEGDES MSOPRI
 129 :       SEGDES MMATEL
 130 : *
 131 : * Normal termination
 132 : *
 133 :       IRET=0
 134 :       RETURN
 135 : *
 136 : * Format handling
 137 : *
 138 : *
 139 : * Error handling
 140 : *
 141 :  9999 CONTINUE
 142 :       IRET=1
 143 :       WRITE(IOIMP,*) 'An error was detected in subroutine prmcp3'
 144 :       RETURN
 145 : *
 146 : * End of subroutine PRMCP3
 147 : *
 148 :       END
 149 : 
 150 :  
 151 :  
 152 :  
 153 :