1 : C PRMCP2 SOURCE MAGN 09/07/30 21:20:38 6458 2 : SUBROUTINE PRMCP2(MMLPRI,MMLDUA,MMATEL,MSOPRI, 3 : $ MSODUA, 4 : $ IMPR,IRET) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C*********************************************************************** 8 : C NOM : PRMCP2 9 : C DESCRIPTION : Produit matrices élémentaires * msoupo primal 10 : C -> msoupo dual. 11 : C 12 : C 13 : C LANGAGE : ESOPE 14 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 15 : C mél : gounand@semt2.smts.cea.fr 16 : C*********************************************************************** 17 : C APPELES : PRMCP3, PRMCP4, PRMCP5, KRIPEE, KRIPME, 18 : C RPENEN, EXENEN, IUNIQ, MLUNIQ 19 : C APPELE PAR : PRDMCP 20 : C*********************************************************************** 21 : C ENTREES : MMLPRI, MMLDUA, MMATEL, MSOPRI 22 : C ENTREES/SORTIES : - 23 : C SORTIES : MSODUA 24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 25 : C*********************************************************************** 26 : C VERSION : v1, 18/04/2000, version initiale 27 : C HISTORIQUE : v1, 18/04/2000, création 28 : C HISTORIQUE : 29 : C HISTORIQUE : 30 : C*********************************************************************** 31 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 32 : C en cas de modification de ce sous-programme afin de faciliter 33 : C la maintenance ! 34 : C*********************************************************************** 35 : -INC CCOPTIO 36 : -INC SMCOORD 37 : -INC SMELEME 38 : POINTEUR MMLPRI.MELEME 39 : POINTEUR MMLDUA.MELEME 40 : POINTEUR MLCPRI.MELEME 41 : POINTEUR MLCDUA.MELEME 42 : -INC SMMATRIK 43 : POINTEUR MMATEL.IMATRI 44 : -INC SMCHPOI 45 : POINTEUR MSOPRI.MSOUPO 46 : POINTEUR MSODUA.MSOUPO 47 : INTEGER N,NC 48 : POINTEUR MPOPRI.MPOVAL 49 : POINTEUR MPODUA.MPOVAL 50 : -INC SMLMOTS 51 : POINTEUR ICOGLO.MLMOTS 52 : -INC SMLENTI 53 : INTEGER JG 54 : POINTEUR ICMPRI.MLENTI 55 : POINTEUR ICMDUA.MLENTI 56 : POINTEUR ICCPRI.MLENTI 57 : POINTEUR ICCDUA.MLENTI 58 : POINTEUR ICOPRI.MLENTI 59 : POINTEUR KRIPRI.MLENTI 60 : POINTEUR KICPRI.MLENTI 61 : POINTEUR KICDUA.MLENTI 62 : POINTEUR KMCPRI.MLENTI 63 : POINTEUR KMCDUA.MLENTI 64 : POINTEUR LNBME.MLENTI 65 : * 66 : * Includes persos 67 : * 68 : INTEGER NBMEL 69 : SEGMENT MELS 70 : POINTEUR LISMEL(NBMEL).MELEME 71 : ENDSEGMENT 72 : POINTEUR GPMELS.MELS 73 : * 74 : INTEGER ICDUA 75 : INTEGER NCDUA 76 : INTEGER NBDUAL,NBDUA2,NIPRI,NIUNIQ,NTOTPO,NPODUA 77 : INTEGER IMPR,IRET 78 : * 79 : * Executable statements 80 : * 81 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp2.eso' 82 : * 83 : * On s'occupe d'abord des inconnues 84 : * 85 : * Repérage global des inconnues : ICOGLO (LISTMOTS) 86 : * Numéros des inconnues primales et duales de la matrice exprimées 87 : * dans ce repérage : ICMPRI, ICMDUA 88 : * Numéros des inconnues du chpoint primal : ICCPRI 89 : * i.e. 90 : * ICOGLO: MLMOTS qui contient les inconnues primales, 91 : * duales et les composantes du CHPOINT 92 : * que un seul fois 93 : * ICMPRI.LECT(i) = position de l'inconnue MMATEL.LISPRI(i) 94 : * dans ICOGLO 95 : * ICMDUA.LECT(i) = position de l'inconnue MMATEL.LISDUA(i) 96 : * dans ICOGLO 97 : * ICCPRI.LECT(i) = position de l'inconnue MSOPRI.COMP(i) 98 : * dans ICCPRI 99 : * 100 : * In PRMCP3 : SEGINI ICOGLO 101 : * In PRMCP3 : SEGINI ICMPRI 102 : * In PRMCP3 : SEGINI ICMDUA 103 : * In PRMCP3 : SEGINI ICCPRI 103 : CALL PRMCP3(MMATEL,MSOPRI, 104 : $ ICOGLO,ICMPRI,ICMDUA,ICCPRI, 105 : $ IMPR,IRET) 106 : 107 : IF (IRET.NE.0) GOTO 9999 108 : SEGACT ICOGLO 109 : NIUNIQ=ICOGLO.MOTS(/2) 110 : SEGDES ICOGLO 111 : * 112 : * Construction de ICOPRI (LISTENTI), liste des inconnues 113 : * appartenant à la fois à ICMPRI et ICCPRI 114 : * i.e. 115 : * ICOPRI.LECT(/1) = nombre d'inconnues communes 116 : * ICOGLO.MOTS(ICOPRI.LECT(i)) = les inconnues communes 117 : * 118 : * In PRCMP4 : SEGINI ICOPRI 118 : CALL PRMCP4(ICMPRI,ICCPRI,NIUNIQ, 119 : $ ICOPRI, 120 : $ IMPR,IRET) 121 : IF (IRET.NE.0) GOTO 9999 122 : * Bien sur, si ICOPRI est vide, il n'y a pas d'inconnues 123 : * communes; donc on sort prématurément 124 : SEGACT ICOPRI 125 : NIPRI=ICOPRI.LECT(/1) 126 : SEGDES ICOPRI 127 : IF (NIPRI.EQ.0) THEN 128 : * SEGINI ICOPRI 129 : * SEGINI ICCPRI 130 : * SEGINI ICMDUA 131 : * SEGINI ICMPRI 132 : * SEGINI ICOGLO 133 : SEGSUP ICOPRI 134 : SEGSUP ICCPRI 135 : SEGSUP ICMDUA 136 : SEGSUP ICMPRI 137 : SEGSUP ICOGLO 138 : GOTO 9998 139 : ENDIF 140 : * Sinon, on construit KRIPRI où on a repéré les inconnues de ICOPRI 141 : * dans le segment des inconnues globales 142 : * i.e. 143 : * KRIPRI.LECT(j) = 0 si ICOGLO.MOTS(j) n'est pas une inconnue 144 : * commune; sinon 145 : * KRIPRI.LECT(ICOPRI.LECT(i)) = i 146 : * 147 : * In KRIPEE : SEGINI KRIPRI 147 : CALL KRIPEE(ICOPRI,NIUNIQ, 148 : $ KRIPRI, 149 : $ IMPR,IRET) 150 : IF (IRET.NE.0) GOTO 9999 151 : SEGSUP ICOPRI 152 : * On repère les inconnues de ICMPRI qui sont dans ICOPRI 153 : * i.e. 154 : * LNBME.LECT(/1) = nombre d'inconnues de MMATEL.LISPRI 155 : * qui sont dedans ICOGLO 156 : * LNBME.LECT(i) = inconnues de MMATEL.LISPRI en ICOGLO 157 : * 158 : * In RPENEN : SEGINI LNBME 158 : CALL RPENEN(ICMPRI,KRIPRI, 159 : $ LNBME, 160 : $ IMPR,IRET) 161 : IF (IRET.NE.0) GOTO 9999 162 : 163 : SEGSUP KRIPRI 164 : * 165 : * Ceci permet de construire les inconnues du chpo. dual 166 : * 167 : * ICCDUA.LECT(/1) = LNBME.LECT(/1) 168 : * ICCDUA.LECT(i) = les inconnues duales qui correspondent 169 : * aux inconnues primales en ICOGLO 170 : * Donc on extrait de ICCDUA (i.e. de MMATEL.LISDUA) 171 : * les seules composantes qui interviennent dans la 172 : * multiplication. 173 : * 174 : * In EXENEN : SEGINI ICCDUA 175 : * 175 : CALL EXENEN(ICMDUA,LNBME, 176 : $ ICCDUA, 177 : $ IMPR,IRET) 178 : IF (IRET.NE.0) GOTO 9999 179 : * On y supprimme le doublons en ICCDUA 180 : SEGACT ICCDUA*MOD 181 : NBDUA2=ICCDUA.LECT(/1) 181 : CALL IUNIQ(ICCDUA.LECT,NBDUA2, 182 : $ ICCDUA.LECT,NBDUAL,IMPR,IRET) 183 : IF (IRET.NE.0) GOTO 9999 184 : JG=NBDUAL 185 : SEGADJ ICCDUA 186 : SEGDES ICCDUA 187 : * On construit KICPRI où on a repéré les inconnues de ICCPRI 188 : * dans le segment des inconnues globales 189 : * In KRIPEE : SEGINI KICPRI 189 : CALL KRIPEE(ICCPRI,NIUNIQ, 190 : $ KICPRI, 191 : $ IMPR,IRET) 192 : IF (IRET.NE.0) GOTO 9999 193 : SEGSUP ICCPRI 194 : * On construit KICDUA où on a repéré les inconnues de ICCDUA 195 : * dans le segment des inconnues globales 196 : * In KRIPEE : SEGINI KICDUA 196 : CALL KRIPEE(ICCDUA,NIUNIQ, 197 : $ KICDUA, 198 : $ IMPR,IRET) 199 : IF (IRET.NE.0) GOTO 9999 200 : * 201 : * On s'occupe des maillages 202 : * 203 : NTOTPO=XCOOR(/1)/(IDIM+1) 204 : * Le support géométrique de MSODUA sera le maillage des points 205 : * de MMLDUA 206 : NBMEL=1 207 : SEGINI GPMELS 208 : GPMELS.LISMEL(1)=MMLDUA 208 : CALL MLUNIQ(GPMELS,MLCDUA,IMPR,IRET) 209 : IF (IRET.NE.0) GOTO 9999 210 : SEGSUP GPMELS 211 : SEGACT MSOPRI 212 : MLCPRI=MSOPRI.IGEOC 213 : MPOPRI=MSOPRI.IPOVAL 214 : SEGDES MSOPRI 215 : * On construit KMCPRI où on a repéré les points de MLCPRI 216 : * dans le segment des points globaux 217 : * In KRIPME : SEGINI KMCPRI 217 : CALL KRIPME(MLCPRI,NTOTPO, 218 : $ KMCPRI, 219 : $ IMPR,IRET) 220 : IF (IRET.NE.0) GOTO 9999 221 : * On construit KMCDUA où on a repéré les points de MLCDUA 222 : * dans le segment des points globaux 223 : * In KRIPME : SEGINI KMCDUA 223 : CALL KRIPME(MLCDUA,NTOTPO, 224 : $ KMCDUA, 225 : $ IMPR,IRET) 226 : IF (IRET.NE.0) GOTO 9999 227 : * On initialise le chpoint dual 228 : * Inconnues 229 : SEGACT ICOGLO 230 : SEGACT ICCDUA 231 : NCDUA=ICCDUA.LECT(/1) 232 : NC=NCDUA 233 : SEGINI MSODUA 234 : DO 3 ICDUA=1,NCDUA 235 : MSODUA.NOCOMP(ICDUA)=ICOGLO.MOTS(ICCDUA.LECT(ICDUA))(1:4) 236 : 3 CONTINUE 237 : * SEGDES ICCDUA 238 : SEGSUP ICCDUA 239 : * SEGDES ICOGLO 240 : SEGSUP ICOGLO 241 : * Maillage 242 : SEGACT MLCDUA 243 : NPODUA=MLCDUA.NUM(/2) 244 : SEGDES MLCDUA 245 : MSODUA.IGEOC=MLCDUA 246 : NC=NCDUA 247 : N=NPODUA 248 : SEGINI MPODUA 249 : SEGDES MPODUA 250 : MSODUA.IPOVAL=MPODUA 251 : SEGDES MSODUA 252 : * 253 : * On effectue le produit (remplissage de MPODUA) 254 : * 254 : CALL PRMCP5(MMLPRI,MMLDUA,MMATEL,ICMPRI,ICMDUA,LNBME, 255 : $ MPOPRI,KICPRI,KMCPRI, 256 : $ KICDUA,KMCDUA, 257 : $ MPODUA, 258 : $ IMPR,IRET) 259 : IF (IRET.NE.0) GOTO 9999 260 : SEGSUP KMCDUA 261 : SEGSUP KMCPRI 262 : SEGSUP KICDUA 263 : SEGSUP KICPRI 264 : SEGSUP LNBME 265 : SEGSUP ICMPRI 266 : SEGSUP ICMDUA 267 : * 268 : * Normal termination 269 : * 270 : IRET=0 271 : RETURN 272 : * 273 : * Format handling 274 : * 275 : * 276 : * Error handling 277 : * 278 : * Pas une erreur proprement dite, mais il n'y avait pas de composantes communes 279 : 9998 CONTINUE 280 : MSODUA=0 281 : IRET=0 282 : RETURN 283 : 9999 CONTINUE 284 : IRET=1 285 : WRITE(IOIMP,*) 'An error was detected in subroutine prmcp2' 286 : RETURN 287 : * 288 : * End of subroutine PRMCP2 289 : * 290 : END 291 : 292 : 293 : 294 : 295 :
© Cast3M 2003 - All rights reserved.
Disclaimer