Esope source files

   1 : C CV2MA9    SOURCE    CHAT      09/10/09    21:16:48     6519           
   2 :       SUBROUTINE CV2MA9(MDISCP,NCVARP,MDISCD,NCVARD,
   3 :      $     IMTLS9,
   4 :      $     MYFALS,
   5 :      $     MATLS9,
   6 :      $     IMPR,IRET)
   7 :       IMPLICIT REAL*8 (A-H,O-Z)
   8 :       IMPLICIT INTEGER (I-N)
   9 : C***********************************************************************
  10 : C NOM         : CV2MA9
  11 : C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
  12 : C               représentant un ensemble de matrices élémentaires en
  13 : C               RIGIDITE...
  14 : C     
  15 : C LANGAGE     : ESOPE
  16 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17 : C               mél : gounand@semt2.smts.cea.fr
  18 : C***********************************************************************
  19 : C APPELES          : KEEF   (recherche de l'élément fini)
  20 : C APPELES (E/S)    : ECROBJ, PRLIST (écriture entier, objet,
  21 : C                    impression)
  22 : C APPELE PAR       : PRLS92
  23 : C***********************************************************************
  24 : C ENTREES            :
  25 : C ENTREES/SORTIES    : -
  26 : C SORTIES            :
  27 : C TRAVAIL            : * MYMEL (type MELEME) : maillage élémentaire.
  28 : C                      * JMTLS9 (type MCHEVA) : valeurs du champ IMTLS9
  29 : C                        sur le maillage élémentaire.
  30 : C                        Structure (cf.include SMCHAEL) :
  31 : C                        (nb. ddl dual, nb. ddl primal,
  32 : C                         nb. comp. duales, nb. comp. primales,
  33 : C                         1, nb. éléments)
  34 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  35 : C***********************************************************************
  36 : C VERSION    : v1, 26/09/03, version initiale
  37 : C HISTORIQUE : v1, 26/09/03, création
  38 : C HISTORIQUE :
  39 : C HISTORIQUE :
  40 : C***********************************************************************
  41 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  42 : C en cas de modification de ce sous-programme afin de faciliter
  43 : C la maintenance !
  44 : C***********************************************************************
  45 : -INC CCOPTIO
  46 : -INC SMLMOTS
  47 :       POINTEUR NCVARP.MLMOTS
  48 :       POINTEUR NCVARD.MLMOTS
  49 : -INC SMELEME
  50 :       POINTEUR MYMEL.MELEME
  51 :       POINTEUR RIGMEL.MELEME
  52 :       INTEGER NBNN,NBELEM,NBSOUS,NBREF
  53 : -INC SMLENTI
  54 :       POINTEUR LPOQUF.MLENTI
  55 :       POINTEUR KPOQUF.MLENTI
  56 :       INTEGER JG
  57 : -INC SMRIGID
  58 :       POINTEUR MATLS9.MRIGID
  59 :       POINTEUR MYDSCR.DESCR
  60 :       POINTEUR MYIMAT.IMATRI
  61 :       POINTEUR MYXMAT.XMATRI
  62 :       INTEGER NRIGE,NRIGEL,NELRIG,NLIGRP,NLIGRD
  63 : *     
  64 : * Includes persos
  65 : *     
  66 : CBEGININCLUDE SMCHAEL
  67 :       SEGMENT MCHAEL
  68 :       POINTEUR IMACHE(N1).MELEME
  69 :       POINTEUR ICHEVA(N1).MCHEVA
  70 :       ENDSEGMENT
  71 :       SEGMENT MCHEVA
  72 :       REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  73 :       ENDSEGMENT
  74 :       SEGMENT LCHEVA
  75 :       POINTEUR LISCHE(NBCHE).MCHEVA
  76 :       ENDSEGMENT
  77 : CENDINCLUDE SMCHAEL
  78 :       POINTEUR IMTLS9.MCHAEL
  79 :       POINTEUR JMTLS9.MCHEVA
  80 :       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  81 : CBEGININCLUDE SFALRF
  82 :       SEGMENT FALRF
  83 :       CHARACTER*(LNNFA) NOMFA
  84 :       INTEGER NUQUAF(NBLRF)
  85 :       POINTEUR ELEMF(NBLRF).ELREF
  86 :       ENDSEGMENT
  87 :       SEGMENT FALRFS
  88 :       POINTEUR LISFA(0).FALRF
  89 :       ENDSEGMENT
  90 : CENDINCLUDE SFALRF
  91 :       POINTEUR MYFALS.FALRFS
  92 : CBEGININCLUDE SELREF
  93 :       SEGMENT ELREF
  94 :       CHARACTER*(LNNOM)  NOMLRF
  95 :       CHARACTER*(LNFORM) FORME 
  96 :       CHARACTER*(LNTYPL) TYPEL 
  97 :       CHARACTER*(LNESP)  ESPACE
  98 :       INTEGER DEGRE
  99 :       REAL*8 XCONOD(NDIMEL,NBNOD)
 100 :       INTEGER NPQUAF(NBDDL)
 101 :       INTEGER NUMCMP(NBDDL)
 102 :       INTEGER QUENOD(NBDDL)
 103 :       INTEGER ORDDER(NDIMEL,NBDDL)
 104 :       POINTEUR MBPOLY.POLYNS
 105 :       ENDSEGMENT
 106 :       SEGMENT ELREFS
 107 :       POINTEUR LISEL(0).ELREF
 108 :       ENDSEGMENT
 109 : CENDINCLUDE SELREF
 110 :       POINTEUR LRFPRI.ELREF
 111 :       POINTEUR LRFDUA.ELREF
 112 : *     
 113 :       CHARACTER*4 MDISCP,MDISCD
 114 :       INTEGER IMPR,IRET
 115 : *     
 116 :       INTEGER IBNN,IBELEM
 117 :       INTEGER ITQUAF,NDDLPR,NDDLDU
 118 :       INTEGER        IDDLPR,IDDLDU
 119 :       INTEGER               NSOUS,NPOQUF
 120 :       INTEGER ISOUS
 121 :       INTEGER ILIGRP,ILIGRD,IELRIG,ICMPP,ICMPD
 122 : 
 123 : *     
 124 : * Executable statements
 125 : *     
 126 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2ma9'
 127 :       NRIGE=7
 128 :       NRIGEL=0
 129 :       SEGINI,MATLS9
 130 :       MATLS9.MTYMAT='LEASTSQU'
 131 : *     
 132 : *     Remplissage de MRIGID
 133 : *     
 134 :       SEGACT NCVARP
 135 :       SEGACT NCVARD
 136 :       SEGACT IMTLS9
 137 :       NSOUS=IMTLS9.IMACHE(/1)
 138 : C      SEGPRT,NCVARP
 139 : C      SEGPRT,NCVARD
 140 : C      SEGPRT,IMTLS9
 141 :       DO ISOUS=1,NSOUS
 142 :          JMTLS9=IMTLS9.ICHEVA(ISOUS)
 143 :          IF (JMTLS9.NE.0) THEN
 144 : C            SEGPRT,NCVARP
 145 : C            SEGPRT,NCVARD
 146 : C            SEGPRT,JMTLS9
 147 :             MYMEL =IMTLS9.IMACHE(ISOUS)
 148 :             SEGACT MYMEL
 149 :             ITQUAF=MYMEL.ITYPEL
 149 :             CALL KEEF(ITQUAF,MDISCP,MYFALS,
 150 :      $           LRFPRI,IMPR,IRET)
 151 :             IF (IRET.NE.0) GOTO 9999
 152 :             SEGACT LRFPRI
 153 :             NDDLPR=LRFPRI.NPQUAF(/1)
 153 :             CALL KEEF(ITQUAF,MDISCD,MYFALS,
 154 :      $           LRFDUA,IMPR,IRET)
 155 :             IF (IRET.NE.0) GOTO 9999
 156 :             SEGACT LRFDUA
 157 :             NDDLDU=LRFDUA.NPQUAF(/1)
 158 : *     
 159 : * remplissage du segment DISCR
 160 : *     
 161 : *  Construction de la liste des points du QUAF sur lesquels il y a des
 162 : *  ddl
 163 :             JG=0
 164 :             SEGINI LPOQUF
 165 :             DO IDDLPR=1,NDDLPR
 166 :                LPOQUF.LECT(**)=LRFPRI.NPQUAF(IDDLPR)
 167 :             ENDDO
 168 :             DO IDDLDU=1,NDDLDU
 169 :                LPOQUF.LECT(**)=LRFDUA.NPQUAF(IDDLDU)
 170 :             ENDDO
 171 : * Suppression des doublons
 171 :             CALL IUNIQ(LPOQUF.LECT,LPOQUF.LECT(/1),
 172 :      $           LPOQUF.LECT,NPOQUF,
 173 :      $           IMPR,IRET)
 174 :             IF (IRET.NE.0) GOTO 9999
 175 :             JG=NPOQUF
 176 :             SEGADJ,LPOQUF
 177 : * Segment de repérage dans cette liste
 178 :             JG=MYMEL.NUM(/1)
 179 :             SEGINI,KPOQUF
 179 :             CALL RSETXI(KPOQUF.LECT,LPOQUF.LECT,LPOQUF.LECT(/1))
 180 :             NLIGRP=NDDLPR
 181 :             NLIGRD=NDDLDU
 182 :             SEGINI MYDSCR
 183 :             DO ILIGRP=1,NLIGRP
 184 :                ICMPP=LRFPRI.NUMCMP(ILIGRP)
 185 :                MYDSCR.LISINC(ILIGRP)=NCVARP.MOTS(ICMPP)
 186 :                MYDSCR.NOELEP(ILIGRP)=
 187 :      $              KPOQUF.LECT(LRFPRI.NPQUAF(ILIGRP)) 
 188 :             ENDDO
 189 :             DO ILIGRD=1,NLIGRD
 190 :                ICMPD=LRFDUA.NUMCMP(ILIGRD)
 191 :                MYDSCR.LISDUA(ILIGRD)=NCVARD.MOTS(ICMPD)
 192 :                MYDSCR.NOELED(ILIGRD)=
 193 :      $              KPOQUF.LECT(LRFDUA.NPQUAF(ILIGRD))
 194 :             ENDDO
 195 :             SEGDES MYDSCR
 196 :             SEGDES LRFDUA
 197 :             SEGDES LRFPRI
 198 :             SEGSUP KPOQUF
 199 : *     
 200 : * remplissage du maillage pour la rigidité
 201 : *     
 202 :             NBNN=NPOQUF
 203 :             NBELEM=MYMEL.NUM(/2)
 204 :             NBSOUS=0
 205 :             NBREF=0
 206 :             SEGINI,RIGMEL
 207 : * Type 32 POLY
 208 :             RIGMEL.ITYPEL=32
 209 :             DO IBELEM=1,NBELEM
 210 :                DO IBNN=1,NBNN
 211 :                   RIGMEL.NUM(IBNN,IBELEM)=
 212 :      $                 MYMEL.NUM(LPOQUF.LECT(IBNN),IBELEM)
 213 :                ENDDO
 214 :             ENDDO
 215 :             SEGDES RIGMEL
 216 :             SEGSUP LPOQUF
 217 :             SEGDES MYMEL
 218 : *     
 219 : * remplissage des matrices élémentaires
 220 : *     
 221 :             SEGACT JMTLS9
 222 :             NBLIG=JMTLS9.VELCHE(/1)
 223 :             NBCOL=JMTLS9.VELCHE(/2)
 224 :             N2LIG=JMTLS9.VELCHE(/3)
 225 :             N2COL=JMTLS9.VELCHE(/4)
 226 :             NBPOI=JMTLS9.VELCHE(/5)
 227 :             NBELM=JMTLS9.VELCHE(/6)
 228 :             IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG.NE.1
 229 :      $           .OR.N2COL.NE.1.OR.NBPOI.NE.1) THEN
 230 :                WRITE(IOIMP,*) 'Erreur dims JMTLS9'
 231 :                GOTO 9999
 232 :             ENDIF
 233 :             NELRIG=NBELM
 234 :                         nligrp=nddlpr
 235 :                         nligrd=nddldu
 236 :             SEGINI MYxMAT
 237 :             DO IELRIG=1,NELRIG
 238 : *               NLIGRP=NDDLPR
 239 : *               NLIGRD=NDDLDU
 240 : *               SEGINI MYXMAT
 241 :                DO ILIGRP=1,NLIGRP
 242 :                   DO ILIGRD=1,NLIGRD
 243 :                      MYXMAT.RE(ILIGRD,ILIGRP,ielrig)=
 244 :      $                    JMTLS9.VELCHE(ILIGRD,ILIGRP,1,1,1,IELRIG)
 245 :                   ENDDO
 246 :                ENDDO
 247 : *               SEGDES MYXMAT
 248 : *               MYIMAT.IMATTT(IELRIG)=MYXMAT
 249 :             ENDDO
 250 :             SEGDES MYxMAT
 251 :             SEGDES JMTLS9
 252 : *     
 253 : * remplissage du chapeau
 254 : *     
 255 :             NRIGE=MATLS9.IRIGEL(/1)
 256 :             NRIGEL=MATLS9.IRIGEL(/2)+1
 257 :             SEGADJ,MATLS9
 258 :             MATLS9.COERIG(NRIGEL)=1.D0
 259 :             MATLS9.IRIGEL(1,NRIGEL)=RIGMEL
 260 :             MATLS9.IRIGEL(2,NRIGEL)=0
 261 :             MATLS9.IRIGEL(3,NRIGEL)=MYDSCR
 262 :             MATLS9.IRIGEL(4,NRIGEL)=MYxMAT
 263 :             MATLS9.IRIGEL(5,NRIGEL)=0
 264 :             MATLS9.IRIGEL(6,NRIGEL)=0
 265 : *     
 266 : * la matrice ne possède pas de symétries (a priori...)
 267 : *     
 268 :             MATLS9.IRIGEL(7,NRIGEL)=2
 269 :          ENDIF
 270 :       ENDDO
 271 :       SEGDES IMTLS9
 272 :       SEGDES NCVARD
 273 :       SEGDES NCVARP
 274 :       SEGDES MATLS9
 275 :       IF (IMPR.GT.3) THEN
 276 :          WRITE(IOIMP,*) 'On a créé MATLS9=',MATLS9
 276 :          CALL ECROBJ('RIGIDITE',MATLS9)
 276 :          CALL PRLIST
 277 :       ENDIF
 278 : *     
 279 : * Normal termination
 280 : *     
 281 :       IRET=0
 282 :       RETURN
 283 : *     
 284 : * Format handling
 285 : *     
 286 : *     
 287 : * Error handling
 288 : *     
 289 :  9999 CONTINUE
 290 :       IRET=1
 291 :       WRITE(IOIMP,*) 'An error was detected in subroutine cv2ma9'
 292 :       RETURN
 293 : *     
 294 : * End of subroutine CV2MA9
 295 : *     
 296 :       END
 297 : 
 298 :  
 299 :  
 300 :