Esope source files

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