Sources Esope | Cast3M

konjs1
C KONJS1    SOURCE    CB215821  20/11/25    13:32:32     10792          
      SUBROUTINE KONJS1(INDMET,ILINC,ISF,IUN,INORM,ICHPVO
     $     ,ICHPSU,MELEMC,MELEMF,MELEFE,IMAT)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KONJS1
C
C DESCRIPTION       :  Voir KONV15
C                      Calcul du jacobien du résidu
C                      Cas 2D/3D
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, SFME/LTMF
C
C************************************************************************
C
C
C APPELES (Outils
C          CASTEM)  :  KRIPAD, LICHT, ERREUR
C
C APPELES (Calcul)  :
C
C************************************************************************
C
C ENTREES
C
C     INDMET : type de Methode
C              1 UPWIND
C              2 CENTERED
C
C     ILINC  : liste des inconnues
C
C  1) Pointeurs des CHPOINT/CHAMELEM
C
C     IUN     : CHPOINT FACE  contenant la vitesse ;
C
C     ISF     : CHAMELEM 'FACEL' contenant les scalaires à transporter
C
C     INORM   : CHPOINT FACE    contenant les normales aux faces ;
C
C     ICHPVO  : CHPOINT VOLUME  contenant le volume
C
C     ICHPSU  : CHPOINT FACE    contenant la surface des faces
C
C
C  2) Pointeurs de MELEME de la table DOMAINE
C
C     MELEMC  : MELEME 'CENTRE' du SPG des CENTRES
C
C     MELEFE  : MELEME 'FACEL' du connectivité Faces -> Elts
C
C SORTIES
C
C     IMAT    : pointeur de la MATRIK du jacobien du residu
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE : Créée le 03.12.01
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
C
      IMPLICIT INTEGER(I-N)
      INTEGER ILINC, ISF ,IUN, INORM,ICHPVO,ICHPSU
     &        , IMAT, IGEOMC, IGEOMF
     &        , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID
     &        , NKMT, NBME, NBEL,  MP, NP
     &        , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD, NINC, IINC
     &        ,INDMET
      REAL*8 UNX, UNY, UNZ, UN, VOLG, VOLD
     &       , SURF, CNX, CNY, CNZ, FUNCEL
      CHARACTER*8 TYPE
C
C**** LES INCLUDES
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMMATRIK
-INC SMELEME
-INC SMLMOTS
-INC SMLENTI
      POINTEUR MPUN.MPOVAL,
     &         MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL
      POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME,
     &         MELEDU.MELEME
      POINTEUR MLENTC.MLENTI, MLENTF.MLENTI
      POINTEUR MATSS.IZAFM
      POINTEUR MLMINC.MLMOTS
C
C**** KRIPAD pour la correspondance global/local des centres
C
      CALL KRIPAD(MELEMC,MLENTC)
C
C     SEGACT MLENTC
      SEGACT MELEMC
C
      SEGACT MELEFE
C
      CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
      CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
      CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC)
C
C**** LICHT active les MPOVALs en *MOD
C
C     i.e.
C
C     SEGACT MPOVSU*MOD
C     SEGACT MPOVNO*MOD
C     SEGACT MPVOLU*MOD
C
      MELEMF = IGEOMF
      CALL KRIPAD(MELEMF,MLENTF)
C
C     SEGACT MLENTF
      SEGACT MELEMF
C
      CALL LICHT(IUN,MPUN,TYPE,IGEOMC)
C
C     SEGACT MPUN*MOD
C
      NFAC = MELEFE.NUM(/2)
C
C**** Maillage des inconnues primales
C
      NBSOUS = 0
      NBREF = 0
      NBELEM =  NFAC
      NBNN = 2
C
      SEGINI MELEDU
C     MELEPR = MELEDU
C
C**** MELEDU = 'SEG2'
C
      MELEDU.ITYPEL =  2
C
      NRIGE = 7
      NMATRI = 1
      NKID = 9
      NKMT = 7
C
      SEGINI MATRIK
      IMAT = MATRIK
      MATRIK.IRIGEL(1,1) = MELEDU
      MATRIK.IRIGEL(2,1) = MELEDU
C
C**** Matrice non symetrique
C
      MATRIK.IRIGEL(7,1) = 2
C
      MLMINC = ILINC
      SEGACT MLMINC
      NINC=MLMINC.MOTS(/2)
      NBME = NINC
      NBSOUS = 1
      SEGINI IMATRI
      MATRIK.IRIGEL(4,1) = IMATRI
C
      NBEL = NBELEM
      NBSOUS = 1
      NP = 2
      MP = 2
      DO IINC=1,NINC,1
         IMATRI.LISPRI(IINC) = MLMINC.MOTS(IINC)
         IMATRI.LISDUA(IINC) = MLMINC.MOTS(IINC)
         SEGINI MATSS
         IMATRI.LIZAFM(1,IINC) = MATSS
      ENDDO
C
      DO IFAC = 1, NFAC, 1
         NGCF = MELEFE.NUM(2,IFAC)
         NLCF = MLENTF.LECT(NGCF)
         IF(NLCF .NE. IFAC)THEN
            WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
            CALL ERREUR(5)
            GOTO 9999
         ENDIF
         NGCG = MELEFE.NUM(1,IFAC)
         NGCD = MELEFE.NUM(3,IFAC)
         SURF = MPOVSU.VPOCHA(NLCF,1)
         CNX = MPNORM.VPOCHA(NLCF,1)
         CNY = MPNORM.VPOCHA(NLCF,2)
         UNX = MPUN.VPOCHA(NLCF,1)
         UNY = MPUN.VPOCHA(NLCF,2)
         UN= (UNX*CNX) + (UNY*CNY)
         IF(IDIM .EQ. 3)THEN
            CNZ = MPNORM.VPOCHA(NLCF,3)
            UNZ = MPUN.VPOCHA(NLCF,3)
            UN=UN+(UNZ*CNZ)
         ENDIF
         IF(NGCG .NE. NGCD)THEN
C
C********** Les MELEMEs
C
            MELEDU.NUM(1,IFAC) = NGCG
            MELEDU.NUM(2,IFAC) = NGCD
C
C********** Les etats G et D
C
            NLCG = MLENTC.LECT(NGCG)
            NLCD = MLENTC.LECT(NGCD)
            VOLG = MPVOLU.VPOCHA(NLCG,1)
            VOLD = MPVOLU.VPOCHA(NLCD,1)
C
C********** MATSS.AM(IFAC,IPRIM,IDUAL)
C           IPRIM = 1, 2  -> G, D
C           IDUAL = 1, 2  -> G, D
C
C********** Dual RN
C
            IF(INDMET .EQ. 1)THEN
               FUNCEL = SURF * UN
               IF(UN .GT. 0)THEN
                  DO IINC=1,NINC,1
                     MATSS=IMATRI.LIZAFM(1,IINC)
                     MATSS.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
                     MATSS.AM(IFAC,1,2) = FUNCEL / VOLD
                     MATSS.AM(IFAC,2,1) = 0.0D0
                     MATSS.AM(IFAC,2,2) = 0.0D0
                  ENDDO
               ELSE
                  DO IINC=1,NINC,1
                     MATSS=IMATRI.LIZAFM(1,IINC)
                     MATSS.AM(IFAC,2,2) = FUNCEL / VOLD
                     MATSS.AM(IFAC,2,1) = -1.0D0 * FUNCEL / VOLG
                     MATSS.AM(IFAC,1,1) = 0.0D0
                     MATSS.AM(IFAC,1,2) = 0.0D0
                  ENDDO
               ENDIF
            ELSEIF(INDMET .EQ.2)THEN
               FUNCEL = SURF * UN * 0.5D0
               DO IINC=1,NINC,1
                  MATSS=IMATRI.LIZAFM(1,IINC)
                  MATSS.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
                  MATSS.AM(IFAC,1,2) = FUNCEL / VOLD
                  MATSS.AM(IFAC,2,1) = -1.0D0 * FUNCEL /VOLG
                  MATSS.AM(IFAC,2,2) = FUNCEL / VOLD
               ENDDO
            ELSE
               CALL ERREUR(251)
               GOTO 9999
            ENDIF
         ELSE
C
C********** Murs (NGCG = NGCD)
C
C
C********** Les MELEMEs
C
            MELEDU.NUM(1,IFAC) = NGCG
            MELEDU.NUM(2,IFAC) = NGCD
            NLCG = MLENTC.LECT(NGCG)
            VOLG = MPVOLU.VPOCHA(NLCG,1)
C
            IF((INDMET .EQ. 1).OR.(INDMET .EQ. 2))THEN
               FUNCEL = SURF * UN
               DO IINC=1,NINC,1
                  MATSS=IMATRI.LIZAFM(1,IINC)
                  MATSS.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
                  MATSS.AM(IFAC,1,2) = 0.0D0
                  MATSS.AM(IFAC,2,1) = 0.0D0
                  MATSS.AM(IFAC,2,2) = 0.0D0
               ENDDO
            ELSE
               CALL ERREUR(251)
               GOTO 9999
            ENDIF
         ENDIF
      ENDDO
C
      SEGDES MELEMC
      SEGDES MELEFE
      SEGDES MELEMF
C
      SEGDES MPOVSU
      SEGDES MPVOLU
      SEGDES MPNORM
C
      SEGDES MPUN
C
      SEGDES MELEDU
      SEGDES MATRIK
      DO IINC=1,NINC,1
         MATSS=IMATRI.LIZAFM(1,IINC)
         SEGDES MATSS
      ENDDO
      SEGDES IMATRI
C
      SEGSUP MLENTC
      SEGSUP MLENTF
      SEGDES MLMINC
 
 9999 CONTINUE
      RETURN
      END