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