C LAPLVF SOURCE CHAT 09/08/25 21:19:50 6466 SUBROUTINE LAPLVF(PKIZX) C------------------------------------------------------------ C------------------------------------------------------------ C C-------------------------- C Paramètre Entrée/Sortie : C-------------------------- C E/ PDOMA : TABLE de sous-type DOMAINE C E/ PKIZX : TABLE de sous-type KIZX C E/ KIMPL : Indicateur précisant l'intégration en temps C C------------------------------------------------------------ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C -INC CCOPTIO -INC SMLMOTS -INC SMLENTI -INC SMCHPOI -INC SMCHAML -INC SMELEME -INC SMMATRIK -INC SMTABLE C POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME POINTEUR MELEMA.MELEME, MELEMP.MELEME POINTEUR PKIZX.MTABLE , PINCO.TABLE , PDOMA.MTABLE, PEQEX.TABLE POINTEUR IPADC.MLENTI,IPADF.MLENTI CHARACTER*8 NOMI, NOMA, NOM CHARACTER*8 TYPE, TYPC DIMENSION IXV(3) C C- Récupération de la table EQEX C CALL LEKTAB(PKIZX,'EQEX',PEQEX) IF (PEQEX.EQ.0) THEN C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 MOTERR( 1: 8) = ' EQEX ' MOTERR( 9:16) = ' EQEX ' MOTERR(17:24) = ' KIZX ' CALL ERREUR(786) RETURN ENDIF C C- Récupération de la table INCO C CALL LEKTAB(PEQEX,'INCO',PINCO) IF (PINCO.EQ.0) THEN C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 MOTERR( 1: 8) = ' INCO ' MOTERR( 9:16) = ' INCO ' MOTERR(17:24) = ' KIZX ' CALL ERREUR(786) RETURN ENDIF C C- Récupération de la table DOMAINE C CALL LEKTAB(PKIZX,'DOMZ',PDOMA) IF(PDOMA.EQ.0) THEN C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 MOTERR( 1: 8) = ' DOMZ ' MOTERR( 9:16) = ' DOMZ ' MOTERR(17:24) = ' KIZX ' CALL ERREUR(786) RETURN ENDIF C C- Récupération de la table KOPT C CALL LEKTAB(PKIZX,'KOPT',KOPTI) IF (KOPTI.EQ.0) THEN C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 MOTERR( 1: 8) = ' EQEX ' MOTERR( 9:16) = ' EQEX ' MOTERR(17:24) = ' KIZX ' CALL ERREUR(786) RETURN ELSE CALL ACME(KOPTI,'KIMPL',KIMPL) IF (IERR.NE.0) RETURN CALL ACME(KOPTI,'KFORM',KFORM) IF (IERR.NE.0) RETURN ENDIF IF (KIMPL.NE.1) THEN C Tentative d'utilisation d'une option non implémentée CALL ERREUR(251) RETURN ENDIF C C- Récupérations des informations de la table DOMAINE C CALL LEKTAB(PDOMA,'CENTRE' ,MELEMC) CALL LEKTAB(PDOMA,'FACE' ,MELEMF) CALL LEKTAB(PDOMA,'XXSURFAC',MCHPO1) CALL LEKTAB(PDOMA,'XXNORMAF',MCHPO2) CALL LEKTAB(PDOMA,'FACEL' ,MELEFE) CALL LEKTAB(PDOMA,'ELTFA' ,MELEMA) CALL LEKTAB(PDOMA,'XXNORMAE',MCHEL1) IF (IERR.NE.0) RETURN C SEGACT MELEMA NBSOUS = MELEMA.LISOUS(/1) NBNN = MELEMA.NUM(/1) NBELEM = MELEMA.NUM(/2) NBREF = MELEMA.LISREF(/1) IF (NBSOUS.EQ.0) NBSOUS=1 NBPART = NBSOUS C C- Lecture de la viscosité C IXV(1) = MELEMC IXV(2) = 1 IXV(3) = 0 IRET = 0 CALL LEKCOF('OPERATEUR LAPN :', & PKIZX,PINCO,1,IXV,MCHPO3,MPOVA3,NPT3,NC3,IK3,IRET) IF (IRET.EQ.0) RETURN C C- Récupération du nom de l'inconnue C TYPE='LISTMOTS' CALL ACMO(PKIZX,'LISTINCO',TYPE,MLMOTS) SEGACT MLMOTS NBINC = MOTS(/2) NOMI = MOTS(1) NOMA = NOMI IF (NBINC.EQ.2) NOMA=MOTS(2) SEGDES MLMOTS C C- Récupération de l'inconnue duale C TYPE = ' ' CALL ACMO(PINCO,NOMA,TYPE,MCHPOI) IF (TYPE.NE.'CHPOINT ') THEN C Indice %m1:8 : ne contient pas un objet de type %m9:16 MOTERR( 1: 8) = 'INC '//NOMA MOTERR( 9:16) = 'CHPOINT ' CALL ERREUR(800) RETURN ELSE CALL LICHT(MCHPOI,MPOVAL,TYPC,MELEME) NINKO = VPOCHA(/2) IF (NINKO.NE.1.AND.NINKO.NE.IDIM) THEN C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes MOTERR( 1: 8) = 'INC '//NOMA MOTERR( 9:16) = 'CHPOINT ' CALL ERREUR(784) RETURN ENDIF ENDIF C C- Vérification de la compatibilité des supports C CALL KRIPAD(MELEME,MLENT1) CALL VERPAD(MLENT1,MELEMC,IRET) IF (IRET.NE.0) THEN C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR( 1: 8) = 'INC '//NOMA MOTERR( 9:16) = 'CHPOINT ' CALL ERREUR(784) ENDIF SEGSUP MLENT1 C C -------------------------------------------- C TRAITEMENT DU SEGMENT DE STOKAGE MATRIK C DE LA MATRICE ELEMENTAIRE. C -------------------------------------------- C NRIGE = 7 NMATRI = 1 NKID = 9 NKMT = 7 SEGINI MATRIK NBME = NINKO NBSOUS = NBPART SEGINI IMATRI IRIGEL(4,1) = IMATRI IRIGEL(7,1) = 0 KSPGP = MELEMC KSPGD = MELEMC IF (NBME.EQ.1) THEN LISPRI(1)=NOMI(1:4)//' ' LISDUA(1)=NOMA(1:4)//' ' ELSE DO I=1,NBME WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7) LISPRI(I)=NOM(1:4)//' ' WRITE(NOM,FMT='(I1,A7)')I,NOMA(1:7) LISDUA(I)=NOM(1:4)//' ' ENDDO ENDIF C C- Création des connectivités entre inconnues primales C IF (NBPART.GT.1) THEN NBNN = 0 NBELEM = 0 NBSOUS = NBPART NBREF = 0 ENDIF SEGINI MELEMP C C- Construction des matrices élémentaires associées à chaque LISOUS C C NUTOEL : Nombre d'éléments déjà traité C NUTOEL= 0 CALL KRIPAD(MELEMF,IPADF) CALL KRIPAD(MELEMC,IPADC) SEGACT MELEMC,MELEMF,MELEFE,MELEMA CALL LICHT(MCHPO1,MPOVA1,TYPC,MELEME) CALL LICHT(MCHPO2,MPOVA2,TYPC,MELEME) SEGACT MCHEL1 DO L=1,NBPART IPT1= MELEMA IF (NBSOUS.GT.1) THEN IPT1= MELEMA.LISOUS(L) ENDIF SEGACT IPT1 NBEL = IPT1.NUM(/2) MCHAM1 = MCHEL1.ICHAML(L) SEGACT MCHAM1 MELVA1 = MCHAM1.IELVAL(1) SEGACT MELVA1 CALL LAPVF2(MPOVA1,MPOVA2,MPOVA3,IK3,MELEMC,MELEMF,MELEFE, & IPT1,MELVA1,IPADF,IPADC,L,NUTOEL, & MATRIK,IMATRI,MELEMP) SEGDES MELVA1 SEGDES MCHAM1 SEGDES IPT1 NUTOEL = NUTOEL + NBEL ENDDO SEGDES MCHEL1 CALL ECMO(PKIZX,'MATELM','MATRIK',MATRIK) C C- Ménage C SEGSUP IPADF,IPADC SEGDES MATRIK,IMATRI SEGDES MPOVA1,MPOVA2,MPOVA3 SEGDES MELEMC,MELEMF,MELEFE IF (NBSOUS.EQ.1) SEGDES MELEMA C RETURN END