Sources Esope | Cast3M

fimvf3
C FIMVF3    SOURCE    CB215821  20/11/25    13:28:56     10792          
      SUBROUTINE FIMVF3(ILIINC,ICEN,IGRAV,IJAC)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  FIMVF3
C
C DESCRIPTION       :  VOIR FIMVF1
C
C                      Gaz ideal mono-espece:
C                      jacobienne lié à la gravité.
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DEN/DM2S/SFME/LTMF
C
C************************************************************************
C
C ENTREES  :
C
C            ILIINC  : LISTMOTS, noms des inconnues
C
C            ICEN    : SPG geometrique
C
C            IGRAV   : CHPOINT  gravité
C
C
C SORTIES  : IJAC    : MATRIK jacobienne
C
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créée le 24.1.03
C
C************************************************************************
C
C
C**** Variables de COOPTIO
C
C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
C     &        ,IECHO,   IIMPI,  IOSPI
C     &        ,IDIM
C     &        ,MCOORD
C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR, LTEXLU
C     &        ,NORINC, NORVAL, NORIND, NORVAD
C     &        ,NUCROU, IPSAUV, IFICLE, IPREFI
C
C**** Les variables
C
      IMPLICIT INTEGER(I-N)
      INTEGER ILIINC,ICEN,IGRAV,IJAC,N1,NLCE
     &     ,IGEOM
     &     ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
      CHARACTER*8 TYPE
      REAL*8 GX, GY, GZ
C
C**** Les includes
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
-INC SMELEME
-INC SMCHPOI
-INC SMMATRIK
C
C**** Dual = ux (composante de la qdm)
C     Primal = rho
C     Matrice elementaire = UXR
C
      POINTEUR UXR.IZAFM, UYR.IZAFM, UZR.IZAFM,
     &         RETUX.IZAFM, RETUY.IZAFM, RETUZ.IZAFM
C
C**** Let's start programming!!!
C
      IPT1 = ICEN
      SEGACT IPT1
      N1 = IPT1.NUM(/2)
      SEGDES IPT1
C
C**** Lecture de MPOVALs
C
      CALL LICHT(IGRAV,MPOVA3,TYPE,IGEOM)
C
C**** LICHT active les MPOVALs en *MOD
C
C     i.e.
C
C     SEGACT MPOVA3*MOD
C
C
C**** Objet MATRIK
C
      NRIGE = 7
      NMATRI = 1
      NKID = 9
      NKMT = 7
C
      SEGINI MATRIK
      IJAC = MATRIK
      MATRIK.IRIGEL(1,1) = ICEN
      MATRIK.IRIGEL(2,1) = ICEN
C
C**** Matrice non symetrique
C
      MATRIK.IRIGEL(7,1) = 2
C
      MLMOTS=ILIINC
      SEGACT MLMOTS
      NBSOUS = 1
      IF(IDIM.EQ.2)THEN
         NBME = 4
         SEGINI IMATRI
         MATRIK.IRIGEL(4,1) = IMATRI
C
         IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
         IMATRI.LISPRI(2) = MLMOTS.MOTS(1)
         IMATRI.LISPRI(3) = MLMOTS.MOTS(2)
         IMATRI.LISPRI(4) = MLMOTS.MOTS(3)
C
         IMATRI.LISDUA(1) = MLMOTS.MOTS(2)
         IMATRI.LISDUA(2) = MLMOTS.MOTS(3)
         IMATRI.LISDUA(3) = MLMOTS.MOTS(4)
         IMATRI.LISDUA(4) = MLMOTS.MOTS(4)
      ELSEIF(IDIM.EQ.3)THEN
C
         NBME = 6
         SEGINI IMATRI
         MATRIK.IRIGEL(4,1) = IMATRI
C
         IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
         IMATRI.LISPRI(2) = MLMOTS.MOTS(1)
         IMATRI.LISPRI(3) = MLMOTS.MOTS(1)
         IMATRI.LISPRI(4) = MLMOTS.MOTS(2)
         IMATRI.LISPRI(5) = MLMOTS.MOTS(3)
         IMATRI.LISPRI(6) = MLMOTS.MOTS(4)
C
         IMATRI.LISDUA(1) = MLMOTS.MOTS(2)
         IMATRI.LISDUA(2) = MLMOTS.MOTS(3)
         IMATRI.LISDUA(3) = MLMOTS.MOTS(4)
         IMATRI.LISDUA(4) = MLMOTS.MOTS(5)
         IMATRI.LISDUA(5) = MLMOTS.MOTS(5)
         IMATRI.LISDUA(6) = MLMOTS.MOTS(5)
      ENDIF
C
      SEGDES MLMOTS
      NBEL = N1
      NBSOUS = 1
      NP = 1
      MP = 1
C
      IF(IDIM .EQ. 2)THEN
         SEGINI UXR, UYR, RETUX, RETUY
         IMATRI.LIZAFM(1,1) = UXR
         IMATRI.LIZAFM(1,2) = UYR
         IMATRI.LIZAFM(1,3) = RETUX
         IMATRI.LIZAFM(1,4) = RETUY
      ELSEIF(IDIM.EQ.3)THEN
         SEGINI  UXR, UYR, UZR, RETUX, RETUY, RETUZ
         IMATRI.LIZAFM(1,1) = UXR
         IMATRI.LIZAFM(1,2) = UYR
         IMATRI.LIZAFM(1,3) = UZR
         IMATRI.LIZAFM(1,4) = RETUX
         IMATRI.LIZAFM(1,5) = RETUY
         IMATRI.LIZAFM(1,6) = RETUZ
      ENDIF
C
      SEGDES MATRIK
      SEGDES IMATRI
C      SEGDES IMATRI
C
C**** Fin definition MATRIK
C
      GZ = 0.0D0
      DO NLCE = 1, N1, 1
C
C******* Les differents variables a chaque centre
C
         GX = MPOVA3.VPOCHA(NLCE,1)
         GY = MPOVA3.VPOCHA(NLCE,2)
         IF(IDIM .EQ. 3)THEN
            GZ = MPOVA3.VPOCHA(NLCE,3)
         ENDIF
C
         UXR.AM(NLCE,1,1)=GX
         UYR.AM(NLCE,1,1)=GY
         RETUX.AM(NLCE,1,1)=GX
         RETUY.AM(NLCE,1,1)=GY
         IF(IDIM.EQ.3)THEN
            UZR.AM(NLCE,1,1)=GZ
            RETUZ.AM(NLCE,1,1)=GZ
         ENDIF
      ENDDO
C
      SEGDES MPOVA3
      IF(IDIM .EQ. 2)THEN
         SEGDES  UXR, UYR, RETUX, RETUY
      ELSEIF(IDIM.EQ.3)THEN
         SEGDES   UXR, UYR, UZR, RETUX, RETUY, RETUZ
      ENDIF
      RETURN
      END