Esope source files

   1 : C RELR10    SOURCE    GOUNAND   11/05/24    21:15:51     6976           
   2 :       SUBROUTINE RELR10(MLIN,MATASS,IMPR,IRET)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : RELR10
   7 : C DESCRIPTION : Assemblage d'un rigidité
   8 : C
   9 : C
  10 : C
  11 : C LANGAGE     : ESOPE
  12 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  13 : C               mél : gounand@semt2.smts.cea.fr
  14 : C***********************************************************************
  15 : C APPELES          : 
  16 : C APPELES (E/S)    : 
  17 : C APPELES (BLAS)   :
  18 : C APPELES (CALCUL) :
  19 : C APPELE PAR       :
  20 : C***********************************************************************
  21 : C SYNTAXE GIBIANE    :
  22 : C ENTREES            :
  23 : C ENTREES/SORTIES    :
  24 : C SORTIES            :
  25 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26 : C***********************************************************************
  27 : C VERSION    : v1, 26/06/2003, version initiale
  28 : C HISTORIQUE : v1, 26/06/2003, création
  29 : C HISTORIQUE :
  30 : C HISTORIQUE :
  31 : C***********************************************************************
  32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33 : C en cas de modification de ce sous-programme afin de faciliter
  34 : C la maintenance !
  35 : C***********************************************************************
  36 : -INC CCOPTIO
  37 : -INC SMRIGID
  38 :       POINTEUR MLIN.MRIGID
  39 : * Includes persos
  40 : CBEGININCLUDE SMMINC
  41 :       SEGMENT MINC
  42 :       INTEGER     NPOS(NPT+1)
  43 :       INTEGER     MPOS(NPT,NBI+1)
  44 :       ENDSEGMENT
  45 :       SEGMENT IMINC
  46 :       INTEGER LNUPO (NDDL)
  47 :       INTEGER LNUINC(NDDL)
  48 :       ENDSEGMENT
  49 : CENDINCLUDE SMMINC
  50 :       POINTEUR MINCP.MINC
  51 :       POINTEUR MINCD.MINC
  52 : CBEGININCLUDE SMPMORS
  53 :       SEGMENT PMORS
  54 :       INTEGER IA (NTT+1)
  55 :       INTEGER JA (NJA)
  56 :       ENDSEGMENT
  57 : CENDINCLUDE SMPMORS
  58 :       POINTEUR PROFM.PMORS
  59 : CBEGININCLUDE SMIZA
  60 :       SEGMENT IZA
  61 :       REAL*8  A(NBVA)
  62 :       ENDSEGMENT
  63 : CENDINCLUDE SMIZA
  64 :       POINTEUR VALM.IZA
  65 : CBEGININCLUDE SMMATASS
  66 :       SEGMENT MATASS
  67 :       POINTEUR KJPOPA.MLENTI
  68 :       POINTEUR LINCPA.MLMOTS
  69 :       POINTEUR MINCPA.MINC
  70 :       POINTEUR KJPODA.MLENTI
  71 :       POINTEUR LINCDA.MLMOTS
  72 :       POINTEUR MINCDA.MINC
  73 :       POINTEUR PROFMA.PMORS
  74 :       POINTEUR VALMA.IZA
  75 :       ENDSEGMENT
  76 : CENDINCLUDE SMMATASS
  77 : *
  78 : -INC SMLENTI
  79 :       POINTEUR KJSPGP.MLENTI
  80 :       POINTEUR KJSPGD.MLENTI
  81 : -INC SMLMOTS
  82 :       POINTEUR LINCP.MLMOTS
  83 :       POINTEUR LINCD.MLMOTS
  84 : *
  85 :       INTEGER IMPR,IRET
  86 : *     
  87 : * Executable statements
  88 : *
  89 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr10.eso' 
  90 : *
  91 : * Construction de :
  92 : * - l'ensemble des points sur lesquels il y a au moins une inconnue
  93 : *   primale : KJSPGP
  94 : * - l'ensemble des points sur lesquels il y a au moins une inconnue
  95 : *   duale : KJSPGD
  96 : *
  96 :       CALL RELR11(MLIN,KJSPGP,KJSPGD,IMPR,IRET)
  97 :       IF (IRET.NE.0) GOTO 9999
  98 : *      SEGPRT,KJSPGP
  99 : *      SEGPRT,KJSPGD
 100 : *
 101 : * Construction de :
 102 : * - l'ensemble des noms d'inconnues primales : LINCP
 103 : * - l'ensemble des noms d'inconnues duales   : LINCD
 104 : *
 104 :       CALL RELR12(MLIN,LINCP,LINCD,IMPR,IRET)
 105 :       IF (IRET.NE.0) GOTO 9999
 106 : *      SEGPRT,LINCP
 107 : *      SEGPRT,LINCD
 108 : *
 109 : * Construction des tableaux de correspondance ddl <-> (point, nom de
 110 : * variable) : 
 111 : * - pour les inconnues primales : MINCP
 112 : * - pour les inconnues duales   : MINCD
 113 : *
 113 :       CALL RELR13(MLIN,KJSPGP,KJSPGD,LINCP,LINCD,
 114 :      $     MINCP,MINCD,
 115 :      $     IMPR,IRET)
 116 :       IF (IRET.NE.0) GOTO 9999
 117 : *      SEGPRT,MINCP
 118 : *      SEGPRT,MINCD
 119 : *
 120 : * Construction du profil Morse de la matrice assemblée
 121 : * Celui-ci est ordonné (les numeros de colonnes
 122 : * dans IA sont en ordre croissant)
 123 : * Remplissage des valeurs de la matrice Morse
 124 : * On pourrait reprendre ce qu'il y a dans prase3
 125 : * pour accélérer la formation du profil.
 125 :       CALL RELR14(MLIN,KJSPGP,KJSPGD,LINCP,LINCD,
 126 :      $     MINCP,MINCD,
 127 :      $     PROFM,VALM,
 128 :      $     IMPR,IRET)
 129 :       IF (IRET.NE.0) GOTO 9999
 130 : *      SEGPRT,PROFM
 131 : *      SEGPRT,VALM
 132 : *
 133 : * Remplissage de MATASS
 134 : *
 135 :       SEGINI MATASS
 136 :       MATASS.KJPOPA=KJSPGP
 137 :       MATASS.LINCPA=LINCP
 138 :       MATASS.MINCPA=MINCP
 139 :       MATASS.KJPODA=KJSPGD
 140 :       MATASS.LINCDA=LINCD
 141 :       MATASS.MINCDA=MINCD
 142 :       MATASS.PROFMA=PROFM
 143 :       MATASS.VALMA =VALM 
 144 :       SEGDES MATASS
 145 : *
 146 : * Normal termination
 147 : *
 148 :       IRET=0
 149 :       RETURN
 150 : *
 151 : * Format handling
 152 : *
 153 : *
 154 : * Error handling
 155 : *
 156 :  9999 CONTINUE
 157 :       IRET=1
 158 :       WRITE(IOIMP,*) 'An error was detected in subroutine relr10'
 159 :       RETURN
 160 : *
 161 : * End of subroutine RELR10
 162 : *
 163 :       END
 164 : 
 165 :