1 : C LAPLVF SOURCE CHAT 09/08/25 21:19:50 6466 2 : SUBROUTINE LAPLVF(PKIZX) 3 : C------------------------------------------------------------ 4 : C------------------------------------------------------------ 5 : C 6 : C-------------------------- 7 : C Paramètre Entrée/Sortie : 8 : C-------------------------- 9 : C E/ PDOMA : TABLE de sous-type DOMAINE 10 : C E/ PKIZX : TABLE de sous-type KIZX 11 : C E/ KIMPL : Indicateur précisant l'intégration en temps 12 : C 13 : C------------------------------------------------------------ 14 : IMPLICIT INTEGER(I-N) 15 : IMPLICIT REAL*8 (A-H,O-Z) 16 : C 17 : -INC CCOPTIO 18 : -INC SMLMOTS 19 : -INC SMLENTI 20 : -INC SMCHPOI 21 : -INC SMCHAML 22 : -INC SMELEME 23 : -INC SMMATRIK 24 : -INC SMTABLE 25 : C 26 : POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME 27 : POINTEUR MELEMA.MELEME, MELEMP.MELEME 28 : POINTEUR PKIZX.MTABLE , PINCO.TABLE , PDOMA.MTABLE, PEQEX.TABLE 29 : POINTEUR IPADC.MLENTI,IPADF.MLENTI 30 : CHARACTER*8 NOMI, NOMA, NOM 31 : CHARACTER*8 TYPE, TYPC 32 : DIMENSION IXV(3) 33 : C 34 : C- Récupération de la table EQEX 35 : C 35 : CALL LEKTAB(PKIZX,'EQEX',PEQEX) 36 : IF (PEQEX.EQ.0) THEN 37 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 38 : MOTERR( 1: 8) = ' EQEX ' 39 : MOTERR( 9:16) = ' EQEX ' 40 : MOTERR(17:24) = ' KIZX ' 40 : CALL ERREUR(786) 41 : RETURN 42 : ENDIF 43 : C 44 : C- Récupération de la table INCO 45 : C 45 : CALL LEKTAB(PEQEX,'INCO',PINCO) 46 : IF (PINCO.EQ.0) THEN 47 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 48 : MOTERR( 1: 8) = ' INCO ' 49 : MOTERR( 9:16) = ' INCO ' 50 : MOTERR(17:24) = ' KIZX ' 50 : CALL ERREUR(786) 51 : RETURN 52 : ENDIF 53 : C 54 : C- Récupération de la table DOMAINE 55 : C 55 : CALL LEKTAB(PKIZX,'DOMZ',PDOMA) 56 : IF(PDOMA.EQ.0) THEN 57 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 58 : MOTERR( 1: 8) = ' DOMZ ' 59 : MOTERR( 9:16) = ' DOMZ ' 60 : MOTERR(17:24) = ' KIZX ' 60 : CALL ERREUR(786) 61 : RETURN 62 : ENDIF 63 : C 64 : C- Récupération de la table KOPT 65 : C 65 : CALL LEKTAB(PKIZX,'KOPT',KOPTI) 66 : IF (KOPTI.EQ.0) THEN 67 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 68 : MOTERR( 1: 8) = ' EQEX ' 69 : MOTERR( 9:16) = ' EQEX ' 70 : MOTERR(17:24) = ' KIZX ' 70 : CALL ERREUR(786) 71 : RETURN 72 : ELSE 72 : CALL ACME(KOPTI,'KIMPL',KIMPL) 73 : IF (IERR.NE.0) RETURN 73 : CALL ACME(KOPTI,'KFORM',KFORM) 74 : IF (IERR.NE.0) RETURN 75 : ENDIF 76 : IF (KIMPL.NE.1) THEN 77 : C Tentative d'utilisation d'une option non implémentée 77 : CALL ERREUR(251) 78 : RETURN 79 : ENDIF 80 : C 81 : C- Récupérations des informations de la table DOMAINE 82 : C 82 : CALL LEKTAB(PDOMA,'CENTRE' ,MELEMC) 82 : CALL LEKTAB(PDOMA,'FACE' ,MELEMF) 82 : CALL LEKTAB(PDOMA,'XXSURFAC',MCHPO1) 82 : CALL LEKTAB(PDOMA,'XXNORMAF',MCHPO2) 82 : CALL LEKTAB(PDOMA,'FACEL' ,MELEFE) 82 : CALL LEKTAB(PDOMA,'ELTFA' ,MELEMA) 82 : CALL LEKTAB(PDOMA,'XXNORMAE',MCHEL1) 83 : IF (IERR.NE.0) RETURN 84 : C 85 : SEGACT MELEMA 86 : NBSOUS = MELEMA.LISOUS(/1) 87 : NBNN = MELEMA.NUM(/1) 88 : NBELEM = MELEMA.NUM(/2) 89 : NBREF = MELEMA.LISREF(/1) 90 : IF (NBSOUS.EQ.0) NBSOUS=1 91 : NBPART = NBSOUS 92 : C 93 : C- Lecture de la viscosité 94 : C 95 : IXV(1) = MELEMC 96 : IXV(2) = 1 97 : IXV(3) = 0 98 : IRET = 0 98 : CALL LEKCOF('OPERATEUR LAPN :', 99 : & PKIZX,PINCO,1,IXV,MCHPO3,MPOVA3,NPT3,NC3,IK3,IRET) 100 : IF (IRET.EQ.0) RETURN 101 : C 102 : C- Récupération du nom de l'inconnue 103 : C 104 : TYPE='LISTMOTS' 104 : CALL ACMO(PKIZX,'LISTINCO',TYPE,MLMOTS) 105 : SEGACT MLMOTS 106 : NBINC = MOTS(/2) 107 : NOMI = MOTS(1) 108 : NOMA = NOMI 109 : IF (NBINC.EQ.2) NOMA=MOTS(2) 110 : SEGDES MLMOTS 111 : C 112 : C- Récupération de l'inconnue duale 113 : C 114 : TYPE = ' ' 114 : CALL ACMO(PINCO,NOMA,TYPE,MCHPOI) 115 : IF (TYPE.NE.'CHPOINT ') THEN 116 : C Indice %m1:8 : ne contient pas un objet de type %m9:16 117 : MOTERR( 1: 8) = 'INC '//NOMA 118 : MOTERR( 9:16) = 'CHPOINT ' 118 : CALL ERREUR(800) 119 : RETURN 120 : ELSE 120 : CALL LICHT(MCHPOI,MPOVAL,TYPC,MELEME) 121 : NINKO = VPOCHA(/2) 122 : IF (NINKO.NE.1.AND.NINKO.NE.IDIM) THEN 123 : C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes 124 : MOTERR( 1: 8) = 'INC '//NOMA 125 : MOTERR( 9:16) = 'CHPOINT ' 125 : CALL ERREUR(784) 126 : RETURN 127 : ENDIF 128 : ENDIF 129 : C 130 : C- Vérification de la compatibilité des supports 131 : C 131 : CALL KRIPAD(MELEME,MLENT1) 131 : CALL VERPAD(MLENT1,MELEMC,IRET) 132 : IF (IRET.NE.0) THEN 133 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 134 : MOTERR( 1: 8) = 'INC '//NOMA 135 : MOTERR( 9:16) = 'CHPOINT ' 135 : CALL ERREUR(784) 136 : ENDIF 137 : SEGSUP MLENT1 138 : C 139 : C -------------------------------------------- 140 : C TRAITEMENT DU SEGMENT DE STOKAGE MATRIK 141 : C DE LA MATRICE ELEMENTAIRE. 142 : C -------------------------------------------- 143 : C 144 : NRIGE = 7 145 : NMATRI = 1 146 : NKID = 9 147 : NKMT = 7 148 : SEGINI MATRIK 149 : NBME = NINKO 150 : NBSOUS = NBPART 151 : SEGINI IMATRI 152 : IRIGEL(4,1) = IMATRI 153 : IRIGEL(7,1) = 0 154 : KSPGP = MELEMC 155 : KSPGD = MELEMC 156 : IF (NBME.EQ.1) THEN 157 : LISPRI(1)=NOMI(1:4)//' ' 158 : LISDUA(1)=NOMA(1:4)//' ' 159 : ELSE 160 : DO I=1,NBME 161 : WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7) 162 : LISPRI(I)=NOM(1:4)//' ' 163 : WRITE(NOM,FMT='(I1,A7)')I,NOMA(1:7) 164 : LISDUA(I)=NOM(1:4)//' ' 165 : ENDDO 166 : ENDIF 167 : C 168 : C- Création des connectivités entre inconnues primales 169 : C 170 : IF (NBPART.GT.1) THEN 171 : NBNN = 0 172 : NBELEM = 0 173 : NBSOUS = NBPART 174 : NBREF = 0 175 : ENDIF 176 : SEGINI MELEMP 177 : C 178 : C- Construction des matrices élémentaires associées à chaque LISOUS 179 : C 180 : C NUTOEL : Nombre d'éléments déjà traité 181 : C 182 : NUTOEL= 0 182 : CALL KRIPAD(MELEMF,IPADF) 182 : CALL KRIPAD(MELEMC,IPADC) 183 : SEGACT MELEMC,MELEMF,MELEFE,MELEMA 183 : CALL LICHT(MCHPO1,MPOVA1,TYPC,MELEME) 183 : CALL LICHT(MCHPO2,MPOVA2,TYPC,MELEME) 184 : SEGACT MCHEL1 185 : DO L=1,NBPART 186 : IPT1= MELEMA 187 : IF (NBSOUS.GT.1) THEN 188 : IPT1= MELEMA.LISOUS(L) 189 : ENDIF 190 : SEGACT IPT1 191 : NBEL = IPT1.NUM(/2) 192 : MCHAM1 = MCHEL1.ICHAML(L) 193 : SEGACT MCHAM1 194 : MELVA1 = MCHAM1.IELVAL(1) 195 : SEGACT MELVA1 195 : CALL LAPVF2(MPOVA1,MPOVA2,MPOVA3,IK3,MELEMC,MELEMF,MELEFE, 196 : & IPT1,MELVA1,IPADF,IPADC,L,NUTOEL, 197 : & MATRIK,IMATRI,MELEMP) 198 : SEGDES MELVA1 199 : SEGDES MCHAM1 200 : SEGDES IPT1 201 : NUTOEL = NUTOEL + NBEL 202 : ENDDO 203 : SEGDES MCHEL1 203 : CALL ECMO(PKIZX,'MATELM','MATRIK',MATRIK) 204 : C 205 : C- Ménage 206 : C 207 : SEGSUP IPADF,IPADC 208 : SEGDES MATRIK,IMATRI 209 : SEGDES MPOVA1,MPOVA2,MPOVA3 210 : SEGDES MELEMC,MELEMF,MELEFE 211 : IF (NBSOUS.EQ.1) SEGDES MELEMA 212 : C 213 : RETURN 214 : END 215 : 216 : 217 : 218 : 219 : 220 : 221 :
© Cast3M 2003 - All rights reserved.
Disclaimer