Esope source files

   1 : C THCOND    SOURCE    FANDEUR   11/07/19    21:17:47     7042           
   2 : 
   3 : C=======================================================================
   4 : C=                            T H C O N D                              =
   5 : C=                            -----------                              =
   6 : C=                      (TCONDU dans le cas de la thermique)           =
   7 : C=  Fonction :                                                         =
   8 : C=  ----------                                                         =
   9 : C=  Creation de la matrice de CONDUCTIVITE THERMIQUE (type RIGIDITE).  =
  10 : C=                                                                     =
  11 : C=  Parametres :  (E)=Entree   (S)=Sortie                              =
  12 : C=  ------------                                                       =
  13 : C=   IPMODE   (E)   Segment IMODEL pour un modele elementaire  (ACTIF) =
  14 : C=   IPCHEL   (E)   Segment MCHELM de CARACTERISTIQUES         (?)     =
  15 : C=   ISUPMA   (E)   Support du champ de caracteristiques materiau      =
  16 : C=   IPRIGI  (E/S)  Segment MRIGID : CONDUCTIVITE              (ACTIF) =
  17 : C=                                                                     =
  18 : C=   Zakaria HABIBI le 30 juin 2008.                                   =
  19 : C=======================================================================
  20 : 
  21 :       SUBROUTINE THCOND (IPMODE,IPCHEL,ISUPMA, IPRIGI)
  22 : 
  23 :       IMPLICIT INTEGER(I-N)
  24 :       IMPLICIT REAL*8(A-H,O-Z)
  25 : 
  26 : -INC CCOPTIO
  27 : -INC CCHAMP
  28 : -INC CCGEOME
  29 : 
  30 : -INC SMELEME
  31 : -INC SMINTE
  32 : -INC SMMODEL
  33 : -INC SMRIGID
  34 : 
  35 :       INTEGER OOOVAL
  36 : 
  37 :       SEGMENT NOTYPE
  38 :         CHARACTER*16 TYPE(NBTYPE)
  39 :       ENDSEGMENT
  40 : 
  41 :       SEGMENT MPTVAL
  42 :         INTEGER IPOS(NS),NSOF(NS), IVAL(NCOSOU)
  43 :         CHARACTER*16 TYVAL(NCOSOU)
  44 :       ENDSEGMENT
  45 : 
  46 :       CHARACTER*8 CMATE
  47 :       CHARACTER*(LCONMO) CONM
  48 : 
  49 :       PARAMETER ( NINF=3 )
  50 :       DIMENSION INFOS(NINF)
  51 : 
  52 : C=  LEFMAS   Liste des numeros d'elements finis MASSIFs supportant la  =
  53 : C            la formulation thermohydrique                             =
  54 : C=  NEFMAS   Longueur de cette liste                                   =
  55 :       PARAMETER ( NEFMAS = 14 )
  56 :       DIMENSION LEFMAS(NEFMAS)
  57 : 
  58 : C ==========
  59 : C  Elements        TRI3 TRI6 QUA4 QUA8 CUB8 CU20 PRI6 PR15 TET4 TE10
  60 : C  MASSIFs         PYR5 PY13 T1D2 T1D3
  61 : C ==========
  62 :       DATA LEFMAS /   4,   6,   8,  10,  14,  15,  16,  17,  23,  24,
  63 :      &               25,  26, 191, 192 /
  64 : 
  65 :       IPINTE = 0
  66 :       IPINT1 = 0
  67 :       MOMATE = 0
  68 :       MOTYPE = 0
  69 : 
  70 : C- Matrice de CONDUCTIVITE
  71 :       MRIGID = IPRIGI
  72 : c*      SEGACT,MRIGID
  73 :       NRIGE0 = IRIGEL(/2)
  74 : 
  75 : C- Recuperation du sous-modele et de la zone elementaire associee
  76 :       IMODEL = IPMODE
  77 : c*      SEGACT,IMODEL
  78 : 
  79 :       NEF  = NEFMOD
  80 : C Test sur l'element fini
  81 :       IMAS = 0
  81 :       CALL PLACE2(LEFMAS,NEFMAS,IMAS,NEF)
  82 : C ERREUR : Element fini non implemente actuellement
  83 :       IF (NEF.EQ.22 .OR. IMAS.EQ.0) THEN
  83 :         CALL ERREUR(19)
  84 :         GOTO 9990
  85 :       ENDIF
  86 : 
  87 : C- Recuperation d'informations sur le maillage elementaire
  88 :       IPT1 = IMAMOD
  89 :       SEGACT,IPT1
  90 :       NBNOE1 = IPT1.NUM(/1)
  91 :       NBELE1 = IPT1.NUM(/2)
  92 : 
  93 : C- Quelques informations sur le modele
  94 :       CONM  = CONMOD
  95 :       CMATE = CMATEE
  96 :       MATE  = IMATEE
  97 : 
  98 :       IRET = 1
  98 :       CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET)
  99 :       IF (IRET.EQ.0) GOTO 9990
 100 : 
 101 : C- Recuperation d'informations sur l'element fini
 101 :       CALL TSHAPE(NEF,'GAUSS',IPINTE)
 102 :       IF (IERR.NE.0) GOTO 9990
 103 :       MINTE = IPINTE
 104 :       SEGACT,MINTE
 105 : 
 106 :       IF (MATE.EQ.2 .OR. MATE.EQ.3) THEN
 107 :         NLG = NUMGEO(NEF)
 107 :         CALL RESHPT(1,NBNOE1,NLG,NEF,0,IPINT1,IOK)
 108 :         IF (IOK.EQ.0) GOTO 9990
 109 :         MINTE1 = IPINT1
 110 :         SEGACT,MINTE1
 111 :       ENDIF
 112 : 
 113 : C- Recuperation des caracteristiques materielles
 114 :       nomid = LNOMID(6)
 115 :       SEGACT,nomid
 116 :       NMATO = lesobl(/2)
 117 :       NMATF = lesfac(/2)
 118 :       NMATT = NMATO + NMATF
 119 :       MOMATE = nomid
 120 : 
 121 :       nbtype = 1
 122 :       SEGINI,notype
 123 :       TYPE(1) = 'REAL*8'
 124 :       MOTYPE = notype
 125 : 
 126 : C- Definition du descripteur IDESCR
 127 :       IDESCR = 0
 127 :       CALL THCOND2(NBNOE1,IDESCR)
 128 :       descr = IDESCR
 129 :       SEGACT,descr
 130 :       NLIGRD = lisdua(/2)
 131 :       NLIGRP = lisinc(/2)
 132 :       SEGDES,descr
 133 :       LRE = NLIGRD
 134 : 
 135 : C- Partionnement si necessaire de la matrice thermohydrique
 136 : C- determinant ainsi le nombre d'objets elementaires de MRIGID
 137 :       LTRK = oooval(1,4)
 138 :       IF (LTRK.EQ.0) LTRK = oooval(1,1)
 139 : * Ajout a la taille en mots de la matrice des infos du segment
 140 :       LSEG = LRE*LRE*NBELE1 + 16
 141 :       NBLPRT = (LSEG-1)/LTRK + 1
 142 :       NBLMAX = (NBELE1-1)/NBLPRT + 1
 143 :       NBLPRT = (NBELE1-1)/NBLMAX + 1
 144 : *      write(ioimp,*) ' thcond1 : nblprt nblmax = ',nblprt,nblmax,nbele1
 145 : 
 146 : C Ajout de la matrice de CONDUCTVITE THERMOHYDRIQUE a la matrice globale
 147 : C ======================================================================
 148 :       NRIGEL = NRIGE0 + NBLPRT
 149 :       SEGADJ,MRIGID
 150 : 
 151 :       descr  = IDESCR
 152 :       meleme = IPT1
 153 :       nbnn   = NBNOE1
 154 :       nbelem = NBELE1
 155 :       nbsous = 0
 156 :       nbref  = 0
 157 : 
 158 : C  Boucle sur les PARTITIONS elementaires de la matrice
 159 : C=======================================================
 160 :       DO irige = 1, NBLPRT
 161 : 
 162 :         IF (NBLPRT.GT.1) THEN
 163 : C  Partitionnement du maillage support de la matrice elementaire
 164 :           SEGACT,IPT1
 165 :           ielem = (irige-1)*NBLMAX
 166 :           nbelem = MIN(NBLMAX,NBELE1-ielem)
 167 : *          write(ioimp,*) ' creation segment ',nbnn,nbelem
 168 :           SEGINI,meleme
 169 :           itypel = IPT1.itypel
 170 :           DO ielt = 1, nbelem
 171 :             jelt = ielt + ielem
 172 :             DO inoe = 1, nbnn
 173 :               num(inoe,ielt) = IPT1.NUM(inoe,jelt)
 174 :             ENDDO
 175 :             icolor(ielt) = IPT1.ICOLOR(jelt)
 176 :           ENDDO
 177 : C  Recopie du descripteur
 178 :           des1 = IDESCR
 179 :           SEGINI,descr=des1
 180 :           SEGDES,descr
 181 :         ENDIF
 182 :         ipmail = meleme
 183 :         ipdesc = descr
 184 : 
 185 : C  Initialisation de la matrice de rigidite elementaire (xmatri)
 186 :         NELRIG = nbelem
 187 :         SEGINI,xmatri
 188 :         ipmatr = xmatri
 189 : 
 190 :         IVAMAT = 0
 190 :         CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT)
 191 :         IF (IERR.NE.0) GOTO 9991
 192 :         IF (ISUPMA.EQ.1) THEN
 192 :           CALL VALCHE(IVAMAT,NMATT,IPINTE,0)
 193 :           IF (IERR.NE.0) THEN
 194 :             ISUPMA = 0
 195 :             GOTO 9991
 196 :           ENDIF
 197 :         ENDIF
 198 : C===
 199 : C- Calcul de la matrice elementaire pour 
 200 : C        remplissage de la matrice globale (ipmatr)
 201 : C =====
 202 : C-- Elements MASSIFs a integration NUMERIQUE
 203 :         IF (IMAS.NE.0) THEN
 203 :           CALL THNUMAC(NEF,ipmail,ipinte,ipint1,IVAMAT,NMATT,ipmatr,LRE)
 204 :         ELSE
 204 :           CALL ERREUR(5)
 205 :         ENDIF
 206 : 
 207 : C- Un peu de menage
 208 :  9991   CONTINUE
 209 :         IF (ISUPMA.EQ.1 .OR. NBLPRT.GT.1) THEN
 209 :           CALL DTMVAL(IVAMAT,3)
 210 :         ELSE
 210 :           CALL DTMVAL(IVAMAT,1)
 211 :         ENDIF
 212 :         IF (IERR.NE.0) GOTO 9990
 213 : 
 214 :         xmatri = ipmatr
 215 :         SEGDES,xmatri
 216 :         IF (NBLPRT.GT.1) THEN
 217 :           meleme = ipmail
 218 :           SEGDES,meleme
 219 :         ENDIF
 220 : 
 221 : C- Remplissage de la 
 222 :         jrige = NRIGE0 + irige
 223 :         COERIG(jrige)   = 1.
 224 :         IRIGEL(1,jrige) = ipmail
 225 :         IRIGEL(2,jrige) = 0
 226 :         IRIGEL(3,jrige) = ipdesc
 227 :         IRIGEL(4,jrige) = ipmatr
 228 :         IRIGEL(5,jrige) = NIFOUR
 229 :         IRIGEL(6,jrige) = 0
 230 :         IRIGEL(7,jrige) = 2
 231 :         IRIGEL(8,jrige) = 0
 232 : 
 233 :       ENDDO
 234 : 
 235 : C  4 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
 236 : C ====================================================
 237 :  9990 CONTINUE
 238 : c*      SEGDES,MRIGID
 239 : c*      SEGDES,IMODEL
 240 :       SEGDES,IPT1
 241 :       IF (IPINTE.GT.0) THEN
 242 :         MINTE = IPINTE
 243 :         SEGDES,MINTE
 244 :       ENDIF
 245 :       IF (IPINT1.GT.0) THEN
 246 :         MINTE = IPINT1
 247 :         SEGDES,MINTE
 248 :       ENDIF
 249 :       IF (MOMATE.NE.0) THEN
 250 :         nomid = MOMATE
 251 :         SEGDES,nomid
 252 :       ENDIF
 253 :       IF (MOTYPE.NE.0) THEN
 254 :         notype = MOTYPE
 255 :         SEGSUP,notype
 256 :       ENDIF
 257 : 
 258 :       RETURN
 259 :       END
 260 : 
 261 :