Esope source files

   1 : C QZADRG    SOURCE    BP208322  12/10/03    21:15:15     7517           
   2 :       SUBROUTINE QZADRG (RI1, RI2)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : *
   6 : ************************************************************************
   7 : *             ADDITION DES RIGIDITES ELEMENTAIRES DE RI1               *
   8 : *       (RI1 ETANT UNE RIGIDITE PROJETEE SUR UNE BASE MODALE)          *
   9 : *           POUR GENERER UNE SEULE RIGIDITE ELEMENTAIRE RI2            *
  10 : *  (EQUIVALENT DE L'ASSEMBLAGE LORSQUE RI1 EST PORTEE PAR UN MAILLAGE  *
  11 : *   PHYSIQUE)                                                          *
  12 : * _____________________________________________________________________*
  13 : *                                                                      *
  14 : *     DATE : le 9 Mars 1995                                            *
  15 : *     AUTEUR : Nicolas BENECH                                          *
  16 : * _____________________________________________________________________*
  17 : *                                                                      *
  18 : *     MODULE(S) APPELANT(S) : VIBRAC                                   *
  19 : *                                                                      *
  20 : *     MODULE(S) APPELE(S) : POSPT                                      *
  21 : * _____________________________________________________________________*
  22 : *                                                                      *
  23 : *     EN ENTREE :                                                      *
  24 : *           RI1 : matrice rigidite a "assembler"                       *
  25 : *                                                                      *
  26 : *     EN SORTIE :                                                      *
  27 : *           RI2 : matrice rigidite elementaire                         *
  28 : *                                                                      *
  29 : ************************************************************************
  30 : *
  31 : -INC CCOPTIO
  32 : -INC SMELEME
  33 : -INC SMRIGID
  34 : 
  35 :       INTEGER I, J, IP, ID, IPP, IDP, LONG, NUMAFF
  36 :       LOGICAL AFFICH
  37 :       CHARACTER*8 LETYP1
  38 : *
  39 : * Affichage des messages pour verification
  40 : *
  41 :       NUMAFF = 20
  42 :       AFFICH = ((MOD(IIMPI,NUMAFF) .EQ. 0) .AND. (IIMPI .NE. 0))
  43 : *
  44 :       SEGACT, RI1
  45 :         LETYP1=RI1.MTYMAT
  46 :         NRIGEL=RI1.COERIG(/1)
  47 : *        IPT1=RI1.IRIGEL(1,1)
  48 : c       SEGDES, RI1
  49 : *
  50 :       NBNN=0
  51 :       NBELEM=1
  52 :       NBSOUS=0
  53 :       NBREF=0
  54 :       SEGINI, MELEME
  55 : c       SEGDES, MELEME
  56 : *
  57 : *  Construction de XMATRI
  58 : *
  59 :       NLIGRD=0
  60 :       NLIGRP=0
  61 :       nelrig=1
  62 :       SEGINI, XMATRI
  63 : *
  64 : * On parcourt les sous-rigidités ...
  65 : *
  66 :         IF (AFFICH) WRITE (*,*) 'Debut de l assemblage ...'
  67 : c         SEGACT, RI1
  68 :         
  69 :           DO 20, I=1, NRIGEL
  70 :             IPT2 = RI1.IRIGEL(1,I)
  71 :             xMATR2 = RI1.IRIGEL(4,I)
  72 : *
  73 :             SEGACT, IPT2
  74 :               LONG = IPT2.NUM(/1)
  75 : c             SEGDES, IPT2
  76 : *
  77 : *            SEGACT, IMATR2
  78 : *              XMATR2=IMATR2.IMATTT(1)
  79 : *            SEGDES, IMATR2
  80 : *
  81 :             IF (AFFICH) THEN
  82 :               WRITE (*,*) 'Rigidite elementaire ',I
  83 :               WRITE (*,*) 'IPT2 = ',IPT2
  84 : *              WRITE (*,*) 'IMATR2 = ', IMATR2
  85 :               WRITE (*,*) 'XMATR2 = ',XMATR2
  86 :               WRITE (*,*) 'Contribution : '
  87 :             ENDIF
  88 : *
  89 : * Calcul de la contribution de la sous-rigidite
  90 : *
  91 :             SEGACT, XMATR2
  92 :             
  93 :               DO 30, ID=1, LONG      
  93 :                 CALL POSPT (IPT2, ID, MELEME, IDP)
  94 : * si IDP = 0 le noeud n'a pas ete trouve ...on le rajoute
  95 :                 IF (IDP.EQ.0) THEN
  96 :                   NBNN=NBNN+1
  97 :                   SEGADJ, MELEME
  98 : c                     SEGACT, IPT2
  99 :                       MELEME.NUM(NBNN,1)=IPT2.NUM(ID,1)
 100 : c                     SEGDES, IPT2
 101 : c                   SEGDES, MELEME
 102 :                   IDP = NBNN
 103 :                   nelrig=1
 104 :                   NLIGRD = NLIGRD+1
 105 :                   NLIGRP = NLIGRP+1
 106 :                   SEGADJ, XMATRI
 107 :                 ENDIF
 108 :                 
 109 :                 DO 40, IP=1, LONG
 109 :                   CALL POSPT (IPT2, IP, MELEME, IPP)
 110 : * si IPP = 0 le noeud n'a pas ete trouve ... on le rajoute
 111 :                   IF (IPP.EQ.0) THEN
 112 :                     NBNN=NBNN+1
 113 :                     SEGADJ, MELEME
 114 : c                       SEGACT, IPT2
 115 :                         MELEME.NUM(NBNN,1)=IPT2.NUM(IP,1)
 116 : c                       SEGDES, IPT2
 117 : c                     SEGDES, MELEME
 118 :                     IPP = NBNN
 119 :                     NLIGRD = NLIGRD+1
 120 :                     NLIGRP = NLIGRP+1
 121 :                     SEGADJ, XMATRI
 122 :                   ENDIF
 123 :                   XMATRI.RE(IDP,IPP,1)=XMATRI.RE(IDP,IPP,1)
 124 :      &                      +RI1.COERIG(I)*XMATR2.RE(ID,IP,1)
 125 :  40             CONTINUE
 126 :  
 127 :  30           CONTINUE
 128 :  
 129 :             SEGDES,XMATR2,IPT2
 130 :             IF (AFFICH) WRITE (*,*) 'Ok !'
 131 :             
 132 :  20       CONTINUE
 133 :  
 134 : c       on desactive
 135 :         SEGDES,RI1,MELEME,XMATRI
 136 : *
 137 : * Sauvegarde de XMATRI dans IMATRI
 138 : *
 139 :        NELRIG = 1
 140 : *      SEGINI, IMATRI
 141 : *        IMATRI.IMATTT(1) = XMATRI
 142 : *      SEGDES, IMATRI
 143 : *
 144 : * Description des inconnues et duales
 145 : *
 146 :       SEGINI, DESCR
 147 :         DO 3, I=1, NLIGRP
 148 :             DESCR.LISINC(I) = 'ALFA'
 149 :             DESCR.NOELEP(I) = I
 150 :  3        CONTINUE
 151 :           DO 4, I=1, NLIGRD
 152 :             DESCR.LISDUA(I) = 'FALF'
 153 :             DESCR.NOELED(I) = I
 154 :  4        CONTINUE
 155 :       SEGDES, DESCR
 156 : *
 157 : * Construction de la rigidite finale
 158 : *
 159 :       NRIGE=7
 160 :       NRIGEL=1
 161 :       SEGINI, RI2
 162 :         RI2.MTYMAT = LETYP1
 163 :         RI2.IFORIG = IFOMOD
 164 :         RI2.IMGEO1 = 0
 165 :         RI2.IMGEO2 = 0
 166 :         RI2.COERIG = 1.D0
 167 :         RI2.IRIGEL(1,1) = MELEME
 168 :         RI2.IRIGEL(2,1) = 0
 169 :         RI2.IRIGEL(3,1) = DESCR
 170 :         RI2.IRIGEL(4,1) = xMATRI
 171 :         RI2.IRIGEL(5,1) = NIFOUR
 172 :         RI2.IRIGEL(6,1) = 0
 173 :         RI2.IRIGEL(7,1) = 2
 174 :       SEGDES, RI2
 175 : *
 176 :       RETURN
 177 :       END
 178 :  
 179 :  
 180 :