Esope source files

   1 : C CMCT2     SOURCE    CHAT      09/10/09    21:16:24     6519           
   2 :       SUBROUTINE CMCT2(MCOEF,LSINCO,IRIG2)
   3 : *_______________________________________________________________________
   4 : c
   5 : c      opérateur cmct
   6 : c
   7 : c entrée
   8 : c   MCOEF : coefficient de la matrice de blocage reordonnés
   9 : c   LSINCO : indice du dit tableau
  10 : c     
  11 : c sortie
  12 : c   IRIG2 : rigidité contenant la matrice condensée
  13 : c
  14 : *_______________________________________________________________________
  15 : 
  16 :       IMPLICIT INTEGER(I-N)
  17 :       IMPLICIT REAL*8(A-H,O-Z)
  18 : *
  19 : -INC CCOPTIO
  20 : -INC SMRIGID
  21 : -INC SMELEME
  22 : -INC SMCOORD
  23 : *
  24 : * tableau pour pointer vers MCOEF à partir du nombre d'inconnues
  25 : * 
  26 :       SEGMENT LSINCO
  27 :           INTEGER LESINC(NINC,2)
  28 :           REAL*8  XMAS(NINC)
  29 :       ENDSEGMENT
  30 : *
  31 : *  tableau des coefficient de la matrice C
  32 : *  ordonné dans l'ordre des inconnues
  33 :       SEGMENT MCOEF 
  34 : *        numero du noeud support du multiplicateur ligne 1
  35 : *        est il en marié avec un autre multiplicateur ligne 2 
  36 :          INTEGER ICOEF(2,NCOEF)
  37 : *         valeur des coefficients
  38 :          REAL*8 XCOEF(NCOEF) 
  39 :       ENDSEGMENT
  40 : *
  41 :       SEGMENT WORK1
  42 :             REAL*8 XDUM(NBNN)
  43 :       ENDSEGMENT
  44 :       LOGICAL NOER
  45 : *_______________________________________________________________________
  46 : 
  47 :       NOER = .TRUE.
  48 : *  il y a autant de matrices élémentaires qu'il y a de coefficients
  49 : *   
  50 :       NRIGEL = LESINC(/1)
  51 :       NRIGE = 7
  52 :       SEGINI MRIGID 
  53 :       IRIG2 = MRIGID
  54 :       MTYMAT = 'RIGIDITE' 
  55 : *
  56 : *    boucle sur les sous zones
  57 : *
  58 :       DO 700 I=1,NRIGEL
  59 :         GRXDUM = 0.D0
  60 :         PTXDUM = 9.D50
  61 :         COERIG(I) = 1.D0
  62 :         NBNN = LESINC(I,2)
  63 : *
  64 : *  il faut tenir compte des doubles multiplicateurs
  65 :         DO 100 J=0,LESINC(I,2)-1
  66 :             IF (ICOEF(2,J+LESINC(I,1)).NE.0) NBNN = NBNN + 1
  67 :  100    CONTINUE
  68 : *
  69 : * creation du maillage et du vecteur des coefficients
  70 :         NBELEM = 1    
  71 :         NBSOUS = 0
  72 :         NBREF = 0 
  73 :         SEGINI WORK1 
  74 :         SEGINI MELEME
  75 :         INOEU = 0 
  76 :         DO 200 J=0,LESINC(I,2)-1
  77 :              INOEU = INOEU + 1
  78 :              NUM(INOEU,1) = ICOEF(1,J+LESINC(I,1))
  79 :              XDUM(INOEU) = XCOEF(J+LESINC(I,1))
  80 :              IF (ICOEF(2,J+LESINC(I,1)).NE.0) THEN
  81 :                 INOEU = INOEU + 1
  82 :                 NUM(INOEU,1) = ICOEF(2,J+LESINC(I,1))
  83 :                 XDUM(INOEU) = XDUM(INOEU-1)
  84 :              ENDIF
  85 :              GRXDUM=MAX(GRXDUM,ABS(XDUM(INOEU)))
  86 :              IF (XDUM(INOEU).NE.0.D0) THEN
  87 :                 PTXDUM=MIN(PTXDUM,ABS(XDUM(INOEU)))
  88 :              ENDIF
  89 :  200    CONTINUE
  90 : *
  91 : *  petit controle sur le conditionnement de la matrice
  92 :         IF (((PTXDUM/GRXDUM).LT.1.D-12).AND.NOER) THEN
  92 :            CALL ERREUR(-320)
  93 :            NOER = .FALSE.
  94 :         ENDIF
  95 :         ITYPEL = 29
  96 :         IRIGEL(1,I) = MELEME
  97 : *
  98 : *    segment descripteur DESCR
  99 :         NLIGRP = NBNN
 100 :         NLIGRD = NBNN
 101 :         SEGINI DESCR
 102 :         DO 300 J=1,NBNN 
 103 :           LISINC(J)='LX  '
 104 :           LISDUA(J)='FLX '
 105 :           NOELEP(J)=J
 106 :           NOELED(J)=J
 107 :  300    CONTINUE
 108 :         IRIGEL(3,I) = DESCR
 109 : *
 110 : *   la matrice elle meme
 111 : *
 112 :          NELRIG = 1
 113 :          SEGINI xMATRI 
 114 :          IRIGEL(4,I)=xMATRI
 115 : *         SEGINI XMATRI
 116 : *         IMATTT(1)=XMATRI            
 117 :          DO 600 J=1,NLIGRP
 118 :            DO 500 K=1,NLIGRP
 119 :               RE(K,J,1)=XDUM(K)*XDUM(J)*XMAS(I)
 120 :  500       CONTINUE
 121 :  600     CONTINUE
 122 : *
 123 : *     dans le cas des doubles multiplicateurs il faut rajouter la matrice
 124 : *    bidiagonale
 125 : *
 126 :         INOEU = 0 
 127 :         DO 650 J=0,LESINC(I,2)-1
 128 :              INOEU = INOEU + 1
 129 :              IF (ICOEF(2,J+LESINC(I,1)).NE.0) THEN
 130 :                 RE(INOEU,INOEU+1,1)=RE(INOEU,INOEU+1,1) + 
 131 :      &                            RE(INOEU,INOEU,1)/1.5D0
 132 :                 RE(INOEU,INOEU,1)= RE(INOEU,INOEU,1)/3.D0
 133 :                 RE(INOEU+1,INOEU+1,1)=RE(INOEU,INOEU,1)
 134 :                 RE(INOEU+1,INOEU,1)=RE(INOEU,INOEU+1,1)
 135 :                 INOEU = INOEU + 1
 136 :                 NUM(INOEU,1) = ICOEF(2,J+LESINC(I,1))
 137 :                 XDUM(INOEU) = XDUM(INOEU-1)
 138 :               ENDIF
 139 :  650    CONTINUE    
 140 :          SEGDES XMATRI
 141 : *         SEGACT XMATRI
 142 : * 
 143 :         SEGDES DESCR
 144 : *        SEGDES XMATRI,IMATRI
 145 :         SEGSUP WORK1
 146 :         SEGDES MELEME
 147 :  700  CONTINUE  
 148 : *
 149 :       SEGSUP LSINCO,MCOEF
 150 :       SEGDES MRIGID
 151 : *_______________________________________________________________________
 152 :       RETURN
 153 :       END
 154 :      
 155 :  
 156 :  
 157 :  
 158 :  
 159 :  
 160 :  
 161 :  
 162 :