Esope source files

   1 : C RELR11    SOURCE    GOUNAND   11/05/24    21:15:52     6976           
   2 :       SUBROUTINE RELR11(MLIN,
   3 :      $     KJSPGP,KJSPGD,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : RELR11
   9 : C DESCRIPTION : Assemblage d'un rigidité
  10 : C Construction de :
  11 : C - l'ensemble des points sur lesquels il y a au moins une inconnue
  12 : C   primale : KJSPGP
  13 : C - l'ensemble des points sur lesquels il y a au moins une inconnue
  14 : C   duale : KJSPGD
  15 : C
  16 : C
  17 : C
  18 : C LANGAGE     : ESOPE
  19 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  20 : C               mél : gounand@semt2.smts.cea.fr
  21 : C***********************************************************************
  22 : C APPELES          : 
  23 : C APPELES (E/S)    : 
  24 : C APPELES (BLAS)   :
  25 : C APPELES (CALCUL) :
  26 : C APPELE PAR       : RELR10
  27 : C***********************************************************************
  28 : C SYNTAXE GIBIANE    :
  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, 26/06/2003, version initiale
  35 : C HISTORIQUE : v1, 26/06/2003, 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 SMCOORD
  45 : -INC SMRIGID
  46 :       POINTEUR MLIN.MRIGID
  47 :       POINTEUR DES.DESCR
  48 : -INC SMELEME
  49 :       POINTEUR MEL.MELEME
  50 : -INC SMLENTI
  51 :       POINTEUR KJSPGP.MLENTI
  52 :       POINTEUR KLSPGP.MLENTI
  53 :       POINTEUR KJSPGD.MLENTI
  54 :       POINTEUR KLSPGD.MLENTI
  55 : *
  56 :       INTEGER IMPR,IRET
  57 : *     
  58 : * Executable statements
  59 : *
  60 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr11.eso' 
  61 : *
  62 :       SEGACT MLIN
  63 :       NRIG=MLIN.IRIGEL(/2)
  64 : *
  65 : * Primale
  66 : *
  67 :       JG=XCOOR(/1)/(IDIM+1)
  68 :       SEGINI KLSPGP
  69 : *   degré et fin de la liste chaînée
  70 :       LDG=0
  71 :       LAST=-1
  72 :       DO IRIG=1,NRIG
  73 :          MEL=MLIN.IRIGEL(1,IRIG)
  74 :          SEGACT MEL
  75 :          NEL=MEL.NUM(/2)
  76 :          DES=MLIN.IRIGEL(3,IRIG)
  77 :          SEGACT DES
  78 :          NDDL=DES.NOELEP(/1)
  79 :          DO IEL=1,NEL
  80 :             DO IDDL=1,NDDL
  81 :                NUMNO=MEL.NUM(DES.NOELEP(IDDL),IEL)
  82 :                IF (KLSPGP.LECT(NUMNO).EQ.0) THEN
  83 :                   LDG=LDG+1
  84 :                   KLSPGP.LECT(NUMNO)=LAST
  85 :                   LAST=NUMNO
  86 :                ENDIF
  87 :             ENDDO
  88 :          ENDDO
  89 :          SEGDES DES
  90 :          SEGDES MEL
  91 :       ENDDO
  92 : *   transfert de la liste chainee dans KJSPGP
  93 :       JG=LDG
  94 :       SEGINI KJSPGP
  95 :       DO IDG=1,LDG
  96 :          IPREC=KLSPGP.LECT(LAST)
  97 :          KJSPGP.LECT(IDG)=LAST
  98 :          LAST=IPREC
  99 :       ENDDO
 100 :       SEGSUP KLSPGP
 101 :       SEGDES KJSPGP
 102 : *
 103 : * Duale (copie conforme du dessus)
 104 : *
 105 :       JG=XCOOR(/1)/(IDIM+1)
 106 :       SEGINI KLSPGD
 107 : *   degré et fin de la liste chaînée
 108 :       LDG=0
 109 :       LAST=-1
 110 :       DO IRIG=1,NRIG
 111 :          MEL=MLIN.IRIGEL(1,IRIG)
 112 :          SEGACT MEL
 113 :          NEL=MEL.NUM(/2)
 114 :          DES=MLIN.IRIGEL(3,IRIG)
 115 :          SEGACT DES
 116 :          NDDL=DES.NOELED(/1)
 117 :          DO IEL=1,NEL
 118 :             DO IDDL=1,NDDL
 119 :                NUMNO=MEL.NUM(DES.NOELED(IDDL),IEL)
 120 :                IF (KLSPGD.LECT(NUMNO).EQ.0) THEN
 121 :                   LDG=LDG+1
 122 :                   KLSPGD.LECT(NUMNO)=LAST
 123 :                   LAST=NUMNO
 124 :                ENDIF
 125 :             ENDDO
 126 :          ENDDO
 127 :          SEGDES DES
 128 :          SEGDES MEL
 129 :       ENDDO
 130 : *   transfert de la liste chainee dans KJSPGD
 131 :       JG=LDG
 132 :       SEGINI KJSPGD
 133 :       DO IDG=1,LDG
 134 :          IPREC=KLSPGD.LECT(LAST)
 135 :          KJSPGD.LECT(IDG)=LAST
 136 :          LAST=IPREC
 137 :       ENDDO
 138 :       SEGSUP KLSPGD
 139 :       SEGDES KJSPGD
 140 :       SEGDES MLIN
 141 : *
 142 : * Normal termination
 143 : *
 144 :       IRET=0
 145 :       RETURN
 146 : *
 147 : * Format handling
 148 : *
 149 : *
 150 : * Error handling
 151 : *
 152 :  9999 CONTINUE
 153 :       IRET=1
 154 :       WRITE(IOIMP,*) 'An error was detected in subroutine relr11'
 155 :       RETURN
 156 : *
 157 : * End of subroutine RELR11
 158 : *
 159 :       END
 160 : 
 161 :