Sources Esope | Cast3M

tconve
C TCONVE    SOURCE    OF166741  25/02/21    21:18:48     12166          
 
C=======================================================================
C=                            T C O N V E                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=  Calcul de la matrice de CONDUCTIVITE de sous-type CONVECTION       =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=  IPMODE  (E)  Segment IMODEL (modele elementaire)           (ACTIF) =
C=  IPCHEL  (E)  Segment MCHELM de CARACTERISTIQUES            (?)     =
C=  ISUPMA  (E)  Support du champ de caracteristiques materiau         =
C=  IPRIGI (E/S) Segment MRIGID CONVECTION                     (ACTIF) =
C=======================================================================
 
      SUBROUTINE TCONVE(IPMODE,IPCHEL,ISUPMA, IPRIGI)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
 
-INC SMCHAML
-INC SMCOORD
-INC SMELEME
-INC SMINTE
-INC SMMODEL
-INC SMRIGID
 
-INC TMPTVAL
 
      INTEGER OOOVAL
 
      SEGMENT NOTYPE
        CHARACTER*16 TYPE(NBTYPE)
      ENDSEGMENT
 
      PARAMETER ( NINF=3 )
      DIMENSION INFOS(NINF)
 
      CHARACTER*(8) CMATE
      CHARACTER*(LCONMO) CONM
      CHARACTER*16 PEAU
 
C=  LEFCON   Liste des numeros d'elements finis supportant la CONVECTION
C=  NEFCON   Longueur de cette liste                                   =
C=  LEFCOQ   Liste des numeros d'elements finis COQUEs
C=  NEFCOQ   Longueur de cette liste                                   =
      PARAMETER ( NEFCON = 13 , NEFCOQ=5 )
      DIMENSION LEFCON(NEFCON), LEFCOQ(NEFCOQ)
C ============
C  Elements         SEG2 SEG3 TRI3 TRI6 QUA4 QUA8 RAC2 RAC3 LIA3 LIA6
C  CONVECTION       LIA4 LIA8 POI1
      DATA LEFCON /    2,   3,   4,   6,   8,  10,  12,  13,  18,  19,
     &                20,  21,   1 /
C ============
C  Elements COQUEs  COQ2 COQ3 COQ6 COQ4 COQ8
      DATA LEFCOQ /   44,  27,  56,  49,  41 /
 
C  1 - INITIALISATIONS ET VERIFICATIONS
C ======================================
C 1.0 - Matrice de CONDUCTIVITE
C ===
      MRIGID = IPRIGI
c*      SEGACT,MRIGID
      NRIGE0 = IRIGEL(/2)
 
C 1.1 - Recuperation du sous-modele et de la zone elementaire associee
C ===
      IMODEL=IPMODE
c*      SEGACT,IMODEL
c
      CMATE = CMATEE
      MATE  = IMATEE
c
      CONM = CONMOD
      NEF  = NEFMOD
 
c Element fini de type COQUE ?
      CALL PLACE2(LEFCOQ,NEFCOQ,ICOQ,NEF)
 
      NLG = NUMGEO(NEF)
 
      IF ((IDIM.EQ.1).AND.(NEF.EQ.2)) NLG = 1
C ERREUR : Element fini non implemente
      CALL PLACE2(LEFCON,NEFCON,ICON,NLG)
      IF (ICON.EQ.0) THEN
        CALL ERREUR(19)
        RETURN
      ENDIF
c
      IPT1 = IMAMOD
      SEGACT,IPT1
      NBNOE1 = IPT1.NUM(/1)
      NBELE1 = IPT1.NUM(/2)
 
      IPINTE = 0
      IVAMAT = 0
      MOMATE = 0
      MOTYPE = 0
      MMAT1  = 0
 
C 1.2 - Remplissage du tableau INFOS
C ===
      IRET = 1
      CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET)
      IF (IRET.EQ.0) GOTO 9990
 
C 1.3 - Recuperation d'informations sur l'element fini
C ===
      IF(NEF .NE. 45)THEN
        CALL TSHAPE(NLG,'GAUSS',IPINTE)
        IF (IERR.NE.0) GOTO 9990
      ENDIF
 
C 1.4 - Recuperation des caracteristiques materielles (obligatoires)
C ===
      nbrobl    = 1
      nbrfac    = 0
      SEGINI,nomid
      lesobl(1) = 'H   '
      NMATO     = nbrobl
      NMATF     = nbrfac
      NMATT     = NMATO + NMATF
      MOMATE    = nomid
C
      NBTYPE  = 1
      SEGINI,notype
      TYPE(1) = 'REAL*8'
      MOTYPE  = notype
 
C 1.5 - Definition du descripteur IDESCR
C ===
      IF (ICOQ .NE. 0) THEN
        PEAU  = MATMOD(3)
      ElSE
        PEAU  = '                '
      ENDIF
      CALL TCONV2(ICOQ,PEAU,NBNOE1,IDESCR)
      IF (IERR .NE. 0) RETURN
      descr = IDESCR
      SEGACT,descr
      NLIGRP = LISINC(/2)
      NLIGRD = LISDUA(/2)
      SEGDES,descr
 
C 1.8 - Partitionnement si necessaire de la matrice de conductivite
C       determinant ainsi le nombre d'objets elementaires de MRIGID
C ===
      LRE  = NLIGRD
      LTRK = oooval(1,4)
      IF (LTRK.EQ.0) LTRK = oooval(1,1)
      LTRK=MAX(LTRK,2**24)
* Ajout a la taille en mots de la matrice des infos du segment
      LSEG = LRE*LRE*NBELE1 + 16
      NBLPRT = (LSEG-1)/LTRK + 1
      NBLMAX = (NBELE1-1)/NBLPRT + 1
      NBLPRT = (NBELE1-1)/NBLMAX + 1
*      write(ioimp,*) ' tconve : nblprt nblmax = ',nblprt,nblmax,nbele1
 
C 2 - Ajout de la matrice de CONVECTION a la matrice globale
C ==========================================================
      NRIGEL = NRIGE0 + NBLPRT
      SEGADJ,MRIGID
 
      meleme = IPT1
      nbnn   = NBNOE1
      nbelem = NBELE1
      nbsous = 0
      nbref  = 0
 
C 3 - Boucle sur les PARTITIONS elementaires de la matrice
C=========================================================
      DO irige = 1, NBLPRT
        IF (NBLPRT.GT.1) THEN
C         Partitionnement du maillage support de la matrice elementaire
          SEGACT,IPT1
          ielem  = (irige-1)*NBLMAX
          nbelem = MIN(NBLMAX,NBELE1-ielem)
*          write(ioimp,*) ' creation segment ',nbnn,nbelem
          SEGINI,meleme
          itypel = IPT1.itypel
          DO ielt = 1, nbelem
            jelt = ielt + ielem
            DO inoe = 1, nbnn
              num(inoe,ielt) = IPT1.NUM(inoe,jelt)
            ENDDO
            icolor(ielt) = IPT1.ICOLOR(jelt)
          ENDDO
        ENDIF
        ipmail = meleme
 
C  Initialisation de la matrice de rigidite elementaire (xmatri)
        NELRIG = nbelem
        SEGINI,xmatri
        ipmatr = xmatri
 
        CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT)
        IF (IERR.NE.0) GOTO 9991
        IF (ISUPMA.EQ.1) THEN
          CALL VALCHE(IVAMAT,NMATT,IPINTE,0,MOMATE,NEF)
          IF (IERR.NE.0) THEN
            ISUPMA = 0
            GOTO 9991
          ENDIF
        ENDIF
 
C- Calcul de la matrice elementaire pour la paritition elementaire et
C  Remplissage de la matrice globale (IPRIGI)
        IF(NEF .EQ. 45)THEN
C         Elements POI1 sans integration
          CALL TCONP1(IPMAIL,IVAMAT,IPMATR)
 
        ELSE
C         Elements a integration NUMERIQUE
          CALL TCONV1(ipmail,IPINTE,IVAMAT,ipmatr,LRE,NLG,NEF)
          IF(IERR.NE.0)RETURN
        ENDIF
 
 9991   CONTINUE
        IF (ISUPMA.EQ.1 .OR. NBLPRT.NE.1) THEN
          CALL DTMVAL(IVAMAT,3)
        ELSE
          CALL DTMVAL(IVAMAT,1)
        ENDIF
        IF (IERR.NE.0) GOTO 9990
 
        xmatri = ipmatr
        SEGDES,xmatri
 
        jrige = NRIGE0 + irige
        COERIG(jrige)   = 1.
        IRIGEL(1,jrige) = ipmail
        IRIGEL(2,jrige) = 0
        IRIGEL(3,jrige) = IDESCR
        IRIGEL(4,jrige) = ipmatr
        IRIGEL(5,jrige) = NIFOUR
        IRIGEL(6,jrige) = 0
        IRIGEL(7,jrige) = 0
        IRIGEL(8,jrige) = 0
 
      ENDDO
 
      IPRIGI = MRIGID
 
C MENAGE : desactivation/destruction de segments
C ==============================================
 9990 CONTINUE
      IF (MOMATE.NE.0) THEN
        nomid = MOMATE
        SEGSUP,nomid
      ENDIF
      IF (MOTYPE.NE.0) THEN
        notype = MOTYPE
        SEGSUP,notype
      ENDIF
 
      RETURN
      END