Sources Esope | Cast3M

supnrm
C SUPNRM    SOURCE    PV        20/09/26    21:20:02     10724          
      SUBROUTINE SUPNRM(IMMATRI,MRIGID,dnormm)
c=======================================================================
c       sous routine utilisée par l'opérateur super option 'rigidite'
c       appelée par supri
c
c       modifie la matrice condensée obtenue lorsque les inconnues
c       maitres ont été normalisées comme c'est le cas lorsqu'un
c       multiplicateur de Lagrange est maitre
c
c       en entrée
c         IMMATRI :  la triangulation modifiée de la matrice totale
c                    qui contient en particulier les coefficients
c                    de normalisation
c                    segment desactivé
c         MRIGID :   la matrice condensée résultante. On ne considère
c                    que la première sous zone qui contient la matrice
c                    condensée. Les autres sous zones contiennent
c                    des blocages n'agissant que sur des inconnues
c                    maitres
c                    segment encore actif
c
c       en sortie
c                    la matrice de la première sous zone est modifieé
c                    par le coefficient de normalisation
c
c       appelée par super
c
c=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMRIGID
-INC SMELEME
-INC SMMATRI
      SEGMENT ICPR(nbpts)
      SEGMENT NCOOR(NNO)
      SEGMENT DNORMM(NLIGRP)
c
c executable
c
      MMATRI = IMMATRI
      SEGACT MMATRI
c
c  on etablit la correspondance entre les noeuds du maillage de la
c  rigidité et les noeuds du maillage de MMATRI
c
      IPT1 = IRIGEL(1,1)
      IPT2 = IGEOMA
      SEGACT IPT1,IPT2
c
      IF ( IPT1.ITYPEL .NE. 28 .OR. IPT2.ITYPEL .NE. 1) THEN
         WRITE(IOIMP,*) 'Erreur 1 dans la routine SUPNRM'
         WRITE(IOIMP,*) 'Les types d élements ne sont pas les bons'
         CALL ERREUR(5)
      ENDIF
c   ncoor va contenir cette correspondance
      NNO = IPT1.NUM(/1)
      SEGINI NCOOR
      SEGINI ICPR
c on cree un tableau intermédiaire qui donne le numéro dans ipt2
c a partir du numéro global
      DO 100 I=1,IPT2.NUM(/2)
          ICPR(IPT2.NUM(1,I)) = I
 100  CONTINUE
c
      DO 110 I=1,NNO
          NCOOR(I) = ICPR(IPT1.NUM(I,1))
*          IF (NCOOR(I) .EQ. 0) WRITE(6,*) 'Correspondance foireuse'
*          write(6,*) 'Correspondance IPT1' , I , 'IPT2', NCOOR(I)
 110  CONTINUE
c
      SEGSUP ,ICPR
c
c on boucle maintenant sur chaque inconnue de la matrice condensée
c on récupère le numéro d'inconnue pour avoir le coefficient de
c normalisation que l'on met dans DNORMM
c
c  on active MMATRI
      MINCPO = IINCPO
      SEGACT ,MINCPO
c
      MIMIK = IIMIK
      SEGACT ,MIMIK
      MHARK = IHARK
      SEGACT ,MHARK
      MDNOR = IDNORM
      SEGACT ,MDNOR
c
      DESCR = IRIGEL(3,1)
c
      NLIGRP = LISINC(/2)
      NLIGRD = LISDUA(/2)
      IF (NLIGRP .NE. NLIGRD) THEN
           WRITE(IOIMP,*) 'Erreur 2 dans la routine SUPNRM'
           WRITE(IOIMP,*) 'La matrice condensée n est pas carrée'
           CALL ERREUR(5)
           RETURN
      ENDIF
      SEGINI , DNORMM
c
c  boucle sur les inconnues de DESCR
c
      DO 200 I=1,NLIGRP
         IPOI1 = NCOOR(NOELEP(I))
*      write(6,*) 'Pt',IPT1.NUM(NOELEP(I),1),' inc',LISINC(I),
*     &            'Four' , IRIGEL(5,1)
         DO 120 J=1,INCPO(/1)
           KK = INCPO(J,IPOI1)
           IF ( KK.NE.0) THEN
*      write(6,*) 'KK',kk,'Pt',IPT2.NUM(1,IPOI1),' inc',IMIK(J),
*     &            'Four' , IHAR(J)
            IF (IMIK(J).EQ.LISINC(I).AND.IHAR(J).EQ.IRIGEL(5,1))THEN
               DNORMM(I) = DNOR(KK)
               IF (IIMPI.EQ.9022) WRITE(IOIMP,910)(IPT2.NUM(1,IPOI1)),
     &             LISINC(I),DNORMM(I)
c
c                 boucle conditionnelle on saute la fin de la boucle
                  GOTO 200
            ENDIF
           ENDIF
 120     CONTINUE
 910    FORMAT ('Noeud ',I4,'  Composante ',A,'  Coef Norm ',E9.3)
c        si on arrive ici ca n'est pas bon cela signifie que l'on a pas iden
c        tifié l'inconnue dans MMATRI
c
         SEGSUP DNORMM,NCOOR
         SEGDES MINCPO,MIMIK,MHARK,MDNOR
         SEGDES IPT1,IPT2
         WRITE(IOIMP,*) 'Erreur 3 dans la routine SUPNRM'
         WRITE(IOIMP,*) 'On ne retrouve pas une inconnue dans matri'
         CALL ERREUR(5)
         RETURN
c
 200     CONTINUE
c
c     on va pouvoir modifier la matrice
c
         xMATRI = IRIGEL(4,1)
*         XMATRI = IMATTT(1)
         SEGACT XMATRI*MOD
 
         DO 400 I=1,NLIGRP
            DO 300 J=1,NLIGRP
               RE(I,J,1) = RE(I,J,1) / DNORMM(I) / DNORMM(J)
 300        CONTINUE
 400     CONTINUE
c
c       on desactive tout
c
        SEGSUP      NCOOR
        SEGDES ,MINCPO,MIMIK,MHARK,MDNOR
        SEGDES ,IPT1,IPT2
        SEGDES ,XMATRI
c
        RETURN
        END