Esope source files

   1 : C SUPNRM    SOURCE    PV        10/10/13    21:15:51     6781           
   2 :       SUBROUTINE SUPNRM(IMMATRI,MRIGID,dnormm)
   3 : c=======================================================================
   4 : c       sous routine utilisée par l'opérateur super option 'rigidite'
   5 : c       appelée par supri
   6 : c
   7 : c       modifie la matrice condensée obtenue lorsque les inconnues
   8 : c       maitres ont été normalisées comme c'est le cas lorsqu'un 
   9 : c       multiplicateur de Lagrange est maitre
  10 : c
  11 : c       en entrée
  12 : c         IMMATRI :  la triangulation modifiée de la matrice totale
  13 : c                    qui contient en particulier les coefficients
  14 : c                    de normalisation
  15 : c                    segment desactivé
  16 : c         MRIGID :   la matrice condensée résultante. On ne considère
  17 : c                    que la première sous zone qui contient la matrice
  18 : c                    condensée. Les autres sous zones contiennent 
  19 : c                    des blocages n'agissant que sur des inconnues 
  20 : c                    maitres
  21 : c                    segment encore actif
  22 : c
  23 : c       en sortie 
  24 : c                    la matrice de la première sous zone est modifieé 
  25 : c                    par le coefficient de normalisation   
  26 : c
  27 : c       appelée par super
  28 : c
  29 : c=======================================================================
  30 :       IMPLICIT INTEGER(I-N)
  31 :       IMPLICIT REAL*8(A-H,O-Z)
  32 : -INC CCOPTIO
  33 : -INC SMCOORD
  34 : -INC SMRIGID
  35 : -INC SMELEME
  36 : -INC SMMATRI  
  37 :       SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  38 :       SEGMENT NCOOR(NNO)
  39 :       SEGMENT DNORMM(NLIGRP)
  40 : c  
  41 : c executable
  42 : c
  43 :       MMATRI = IMMATRI
  44 :       SEGACT MMATRI
  45 : c
  46 : c  on etablit la correspondance entre les noeuds du maillage de la
  47 : c  rigidité et les noeuds du maillage de MMATRI
  48 : c 
  49 :       IPT1 = IRIGEL(1,1)
  50 :       IPT2 = IGEOMA
  51 :       SEGACT IPT1,IPT2
  52 : c
  53 :       IF ( IPT1.ITYPEL .NE. 28 .OR. IPT2.ITYPEL .NE. 1) THEN
  54 :          WRITE(IOIMP,*) 'Erreur 1 dans la routine SUPNRM'
  55 :          WRITE(IOIMP,*) 'Les types d élements ne sont pas les bons'
  55 :          CALL ERREUR(5)
  56 :       ENDIF
  57 : c   ncoor va contenir cette correspondance
  58 :       NNO = IPT1.NUM(/1)
  59 :       SEGINI NCOOR
  60 :       SEGINI ICPR
  61 : c on cree un tableau intermédiaire qui donne le numéro dans ipt2
  62 : c a partir du numéro global
  63 :       DO 100 I=1,IPT2.NUM(/2)
  64 :           ICPR(IPT2.NUM(1,I)) = I
  65 :  100  CONTINUE
  66 : c
  67 :       DO 110 I=1,NNO
  68 :           NCOOR(I) = ICPR(IPT1.NUM(I,1))
  69 : *          IF (NCOOR(I) .EQ. 0) WRITE(6,*) 'Correspondance foireuse'
  70 : *          write(6,*) 'Correspondance IPT1' , I , 'IPT2', NCOOR(I)
  71 :  110  CONTINUE
  72 : c
  73 :       SEGSUP ,ICPR
  74 : c
  75 : c on boucle maintenant sur chaque inconnue de la matrice condensée
  76 : c on récupère le numéro d'inconnue pour avoir le coefficient de
  77 : c normalisation que l'on met dans DNORMM
  78 : c
  79 : c  on active MMATRI
  80 :       MINCPO = IINCPO 
  81 :       SEGACT ,MINCPO
  82 : c     
  83 :       MIMIK = IIMIK
  84 :       SEGACT ,MIMIK
  85 :       MHARK = IHARK
  86 :       SEGACT ,MHARK
  87 :       MDNOR = IDNORM
  88 :       SEGACT ,MDNOR
  89 : c
  90 :       DESCR = IRIGEL(3,1)
  91 : c
  92 :       NLIGRP = LISINC(/2)
  93 :       NLIGRD = LISDUA(/2)
  94 :       IF (NLIGRP .NE. NLIGRD) THEN
  95 :            WRITE(IOIMP,*) 'Erreur 2 dans la routine SUPNRM'
  96 :            WRITE(IOIMP,*) 'La matrice condensée n est pas carrée'
  96 :            CALL ERREUR(5)
  97 :            RETURN
  98 :       ENDIF
  99 :       SEGINI , DNORMM
 100 : c
 101 : c  boucle sur les inconnues de DESCR 
 102 : c
 103 :       DO 200 I=1,NLIGRP
 104 :          IPOI1 = NCOOR(NOELEP(I))
 105 : *      write(6,*) 'Pt',IPT1.NUM(NOELEP(I),1),' inc',LISINC(I),
 106 : *     &            'Four' , IRIGEL(5,1)
 107 :          DO 120 J=1,INCPO(/1)
 108 :            KK = INCPO(J,IPOI1)
 109 :            IF ( KK.NE.0) THEN
 110 : *      write(6,*) 'KK',kk,'Pt',IPT2.NUM(1,IPOI1),' inc',IMIK(J),
 111 : *     &            'Four' , IHAR(J)
 112 :             IF (IMIK(J).EQ.LISINC(I).AND.IHAR(J).EQ.IRIGEL(5,1))THEN
 113 :                DNORMM(I) = DNOR(KK)
 114 :                IF (IIMPI.EQ.9022) WRITE(IOIMP,910)(IPT2.NUM(1,IPOI1)),
 115 :      &             LISINC(I),DNORMM(I)
 116 : c               
 117 : c                 boucle conditionnelle on saute la fin de la boucle
 118 :                   GOTO 200
 119 :             ENDIF
 120 :            ENDIF
 121 :  120     CONTINUE
 122 :  910    FORMAT ('Noeud ',I4,'  Composante ',A,'  Coef Norm ',E9.3)
 123 : c        si on arrive ici ca n'est pas bon cela signifie que l'on a pas iden
 124 : c        tifié l'inconnue dans MMATRI
 125 : c
 126 :          SEGSUP DNORMM,NCOOR
 127 :          SEGDES MINCPO,MIMIK,MHARK,MDNOR
 128 :          SEGDES IPT1,IPT2
 129 :          WRITE(IOIMP,*) 'Erreur 3 dans la routine SUPNRM'
 130 :          WRITE(IOIMP,*) 'On ne retrouve pas une inconnue dans matri'
 130 :          CALL ERREUR(5)
 131 :          RETURN
 132 : c
 133 :  200     CONTINUE
 134 : c
 135 : c     on va pouvoir modifier la matrice
 136 : c
 137 :          xMATRI = IRIGEL(4,1)
 138 : *         XMATRI = IMATTT(1)
 139 :          SEGACT XMATRI*MOD
 140 :   
 141 :          DO 400 I=1,NLIGRP 
 142 :             DO 300 J=1,NLIGRP   
 143 :                RE(I,J,1) = RE(I,J,1) / DNORMM(I) / DNORMM(J)
 144 :  300        CONTINUE
 145 :  400     CONTINUE
 146 : c
 147 : c       on desactive tout
 148 : c
 149 :         SEGSUP      NCOOR
 150 :         SEGDES ,MINCPO,MIMIK,MHARK,MDNOR
 151 :         SEGDES ,IPT1,IPT2
 152 :         SEGDES ,XMATRI
 153 : c
 154 :         RETURN
 155 :         END
 156 :                 
 157 :  
 158 :  
 159 :