Sources Esope | Cast3M

towa1
C TOWA1     SOURCE    CB215821  22/07/20    15:39:46     11411          
      SUBROUTINE TOWA1 (REDIR,NOCOPO,NOMDU1,IPINW,NOMPR1,
     &                  MPOVD1,MPOVC1,MPOVR1,MPOVL1,MPOVT1,
     &                  XDT1,DESCR,xMATRI,MCHPOI)
C
C***********************************************************************
C
C
C     Subroutine appelée par TOWA.
C     Création de la matrice élémentaire et du second membre associés
C     à l'opération de thermique 1D dans un mur.
C
C
C  ENTREES :
C  --------
C
C  REDIR   :  Segment des tableaux de correspondances
C  NOCOPO  :  Segment des tableaux de positions des noms de composantes
C  NOMDU1  :  Nom de l'inconnue duale définie sur les points de
C             tous les murs.
C  IPINW   :  Support géométrique associé au mur
C  NOMPR1  :  Nom de l'inconnue ou de la donnée flux de chaleur.
C  MPOVD1  :  Pointeur sur le segment MPOVAL des valeurs de l'inconnue
C             duale à l'itération précédente.
C  MPOVC1  :  Pointeur sur le segment MPOVAL des valeurs des chaleurs
C             spécifiques.
C  MPOVR1  :  Pointeur sur le segment MPOVAL des valeurs des masses
C             volumiques.
C  MPOVL1  :  Pointeur sur le segment MPOVAL des valeurs des
C             conductivités spécifiques.
C  MPOVT1  :  Pointeur sur le segment MPOVAL des valeurs des
C             épaisseurs.
C  XDT1    :  Valeur du pas de temps
C
C  SORTIE :
C  -------
C
C  DESCR   :  Pointeur sur le segment descriptif de la matrice
C             élémentaire.
C  IMATRI  :  Pointeur sur le segment contenant le pointeur de
C             la matrice élémentaire.
C  MCHPOI  :  Pointeur sur le champ second membre.
C
C
C AUTEUR, DATE DE CREATION:
C -------------------------
C
C     Laurent DADA      décembre 1996
C
C
C LANGAGE:
C --------
C
C     ESOPE + FORTRAN77
C
C***********************************************************************
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
      POINTEUR MPOVC1.MPOVAL,MPOVR1.MPOVAL,MPOVD1.MPOVAL
      POINTEUR MPOVL1.MPOVAL,MPOVT1.MPOVAL
-INC SMELEME
      POINTEUR IPINW.MELEME
-INC SMRIGID
-INC TMTRAV
C
      SEGMENT REDIR
        INTEGER IPOSC1(NNGOT)
        INTEGER IPOSR1(NNGOT)
        INTEGER IPOSL1(NNGOT)
        INTEGER IPOST1(NNGOT)
        INTEGER IPOSQ1(NNGOT)
        INTEGER IPOSD1(NNGOT)
      ENDSEGMENT
C
      SEGMENT NOCOPO
        INTEGER NOCOC1(2)
        INTEGER NOCOR1(2)
        INTEGER NOCOL1(2)
        INTEGER NOCOT1(2)
      ENDSEGMENT
C
      CHARACTER*8 NOMDU1,NOMPR1
      REAL*8      LGAU,LDRO
C
      SEGACT IPINW
      NBELW1 = IPINW.NUM(/2)
C
C Remplissage du descripteur de l'objet RIGIDITE
C
      NLIGRP = NBELW1
      NLIGRD = NBELW1
      SEGINI DESCR
C
      DO 20 I20=1,NBELW1
        NOELEP(I20) = I20
        LISINC(I20) = NOMDU1
        NOELED(I20) = I20
        LISDUA(I20) = NOMDU1
20    CONTINUE
C
      SEGDES DESCR
C
      NELRIG = 1
*      SEGINI IMATRI
      SEGINI XMATRI
C
*      IMATTT(1)   = XMATRI
*      SEGDES IMATRI
C
C Initialisation du segment de travail
C
      NNIN  = 1
      NNNOE = NBELW1
      SEGINI MTRAV
      INCO(1) = NOMDU1
      NHAR(1) = NIFOUR
C Boucle sur les points internes du mur
      SEGACT REDIR
      SEGACT NOCOPO
      SEGACT MPOVC1
      SEGACT MPOVR1
      SEGACT MPOVL1
      SEGACT MPOVT1
      SEGACT MPOVD1
C
      DO 40 I40=2,(NBELW1-1)
        NUMW1  = IPINW.NUM(1,I40)
        IGEO(I40)   = NUMW1
        IBIN(1,I40) = 1
        JPOSC1 = IPOSC1(NUMW1)
        JPOSR1 = IPOSR1(NUMW1)
        JPOSL1 = IPOSL1(NUMW1)
        JPOST1 = IPOST1(NUMW1)
        JPOSD1 = IPOSD1(NUMW1)
        CGAU = MPOVC1.VPOCHA(JPOSC1,NOCOC1(1))
        RGAU = MPOVR1.VPOCHA(JPOSR1,NOCOR1(1))
        LGAU = MPOVL1.VPOCHA(JPOSL1,NOCOL1(1))
        TGAU = MPOVT1.VPOCHA(JPOST1,NOCOT1(1))
        CDRO = MPOVC1.VPOCHA(JPOSC1,NOCOC1(2))
        RDRO = MPOVR1.VPOCHA(JPOSR1,NOCOR1(2))
        LDRO = MPOVL1.VPOCHA(JPOSL1,NOCOL1(2))
        TDRO = MPOVT1.VPOCHA(JPOST1,NOCOT1(2))
        AI = - LGAU / TGAU
        BI = (0.5D0*TGAU*RGAU*CGAU+0.5D0*TDRO*RDRO*CDRO) / XDT1
     &     +  LGAU / TGAU + LDRO / TDRO
        CI = - LDRO / TDRO
        DI = ((0.5D0*TGAU*RGAU*CGAU+0.5D0*TDRO*RDRO*CDRO) / XDT1)
     &      * (MPOVD1.VPOCHA(JPOSD1,1))
        RE(I40,I40-1,1) = AI
        RE(I40,I40,1)   = BI
        RE(I40,I40+1,1) = CI
        BB(1,I40)     = DI
40    CONTINUE
C Le premier point du mur
      NUMW1     = IPINW.NUM(1,1)
      IGEO(1)   = NUMW1
      IBIN(1,1) = 1
      JPOSC1 = IPOSC1(NUMW1)
      JPOSR1 = IPOSR1(NUMW1)
      JPOSL1 = IPOSL1(NUMW1)
      JPOST1 = IPOST1(NUMW1)
      JPOSD1 = IPOSD1(NUMW1)
      CDRO = MPOVC1.VPOCHA(JPOSC1,NOCOC1(2))
      RDRO = MPOVR1.VPOCHA(JPOSR1,NOCOR1(2))
      LDRO = MPOVL1.VPOCHA(JPOSL1,NOCOL1(2))
      TDRO = MPOVT1.VPOCHA(JPOST1,NOCOT1(2))
      BI = 0.5D0*TDRO*RDRO*CDRO / XDT1 + LDRO / TDRO
      CI = - LDRO / TDRO
      DI = (0.5D0*TDRO*RDRO*CDRO / XDT1) * (MPOVD1.VPOCHA(JPOSD1,1))
      RE(1,1,1) = BI
      RE(1,2,1) = CI
      BB(1,1) = DI
C Le dernier point du mur
      NUMW1          = IPINW.NUM(1,NBELW1)
      IGEO(NBELW1)   = NUMW1
      IBIN(1,NBELW1) = 1
      JPOSC1 = IPOSC1(NUMW1)
      JPOSR1 = IPOSR1(NUMW1)
      JPOSL1 = IPOSL1(NUMW1)
      JPOST1 = IPOST1(NUMW1)
      JPOSD1 = IPOSD1(NUMW1)
      CGAU = MPOVC1.VPOCHA(JPOSC1,NOCOC1(1))
      RGAU = MPOVR1.VPOCHA(JPOSR1,NOCOR1(1))
      LGAU = MPOVL1.VPOCHA(JPOSL1,NOCOL1(1))
      TGAU = MPOVT1.VPOCHA(JPOST1,NOCOT1(1))
      AI = - LGAU / TGAU
      BI = 0.5D0*TGAU*RGAU*CGAU / XDT1 +  LGAU / TGAU
      DI = (0.5D0*TGAU*RGAU*CGAU / XDT1) * (MPOVD1.VPOCHA(JPOSD1,1))
      RE(NBELW1,NBELW1-1,1) = AI
      RE(NBELW1,NBELW1,1)   = BI
      BB(1,NBELW1) = DI
C
C Création du second membre
C
      CALL CRECHP (MTRAV,MCHPOI)
C
      SEGDES MPOVD1
      SEGDES IPINW
      SEGDES XMATRI
      SEGDES MPOVC1
      SEGDES MPOVR1
      SEGDES MPOVL1
      SEGDES MPOVT1
C
      SEGDES REDIR
      SEGDES NOCOPO
      SEGSUP MTRAV
C
C
      END