1 : C MKIZA SOURCE MAGN 09/07/30 21:19:28 6458 2 : SUBROUTINE MKIZA(MELDUA,MELPRI,IMATEL, 3 : $ KRINCD,KRINCP,KMINCT,KRSPGT, 4 : $ PMTOT, 5 : $ IZATOT, 6 : $ IMPR,IRET) 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8 (A-H,O-Z) 9 : C*********************************************************************** 10 : C NOM : MKIZA 11 : C DESCRIPTION : Matrice élémentaire + Profil Morse de la matrice 12 : C assemblée => ajout de la contribution de la matrice 13 : C élémentaire aux valeurs de la matrice Morse assemblée. 14 : C 15 : C Le profil Morse est supposé avoir ses colonnes 16 : C ordonnées. 17 : C 18 : C LANGAGE : ESOPE 19 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 20 : C mél : gounand@semt2.smts.cea.fr 21 : C*********************************************************************** 22 : C APPELES : REGMAI, IFIDIC, INIRPM 23 : C APPELE PAR : PRASEM 24 : C*********************************************************************** 25 : C ENTREES : MELDUA, MELPRI, IMATEL, KRINCD, KRINCP, KMINCT, 26 : C KRSPGT, PMTOT 27 : C ENTREES/SORTIES : IZATOT 28 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 29 : C*********************************************************************** 30 : C VERSION : v2, 13/12/99 31 : C HISTORIQUE : v1, 08/10/99, création 32 : C HISTORIQUE : v2, remaniement (on assemble les profils Morse, puis 33 : C la matrice totale) 34 : C HISTORIQUE : 05/01/00 : On ne suppose plus les maillages duaux et 35 : C primaux partitionnés de la même façon que les matrices 36 : C élémentaires. 37 : C HISTORIQUE : 38 : C*********************************************************************** 39 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 40 : C en cas de modification de ce sous-programme afin de faciliter 41 : C la maintenance ! 42 : C*********************************************************************** 43 : * 44 : * 45 : * On peut optimiser les boucles en sortant les NPOS 46 : * On a supposé la chose logique (pas pour tout le monde) 47 : * que le NBSOUS est le même pour MELDUA, MELPRI, IMATEL 48 : * 49 : * Ce serait bien de sortir les REGMAI pour mettre dans prasem 50 : * et supprimmer du source tous les if (NBSOUS.EQ.0) 51 : * 52 : * Le stockage des matrices élémentaires est fait à l'envers 53 : * (NBEL est le premier indice), par contre, les boucles sont 54 : * dans l'ordre logique => perte de performances 55 : * 56 : -INC CCOPTIO 57 : -INC SMELEME 58 : POINTEUR MELDUA.MELEME 59 : POINTEUR ML2DUA.MELEME 60 : POINTEUR SMLDUA.MELEME 61 : POINTEUR MELPRI.MELEME 62 : POINTEUR ML2PRI.MELEME 63 : POINTEUR SMLPRI.MELEME 64 : -INC SMMATRIK 65 : POINTEUR IMATEL.IMATRI 66 : POINTEUR VMATEL.IZAFM 67 : POINTEUR KMINCT.MINC 68 : POINTEUR PMTOT.PMORS 69 : POINTEUR IZATOT.IZA 70 : -INC SMLENTI 71 : POINTEUR KRINCD.MLENTI 72 : POINTEUR KRINCP.MLENTI 73 : POINTEUR KRSPGT.MLENTI 74 : POINTEUR RPMAT.MLENTI 75 : * 76 : INTEGER IMPR,IRET 77 : * 78 : LOGICAL LPARTD,LPARTP 79 : INTEGER IDX,IDXDEB 80 : INTEGER ISOUM,NBSOUM,NBSOUD,NBSOUP 81 : INTEGER ITDDLD,ITDDLP,ITIDUA,ITIPRI,ITPODU,ITPOPR 82 : INTEGER NBCMPD,NBCMPP 83 : INTEGER NELPRI 84 : INTEGER ILMAT,JDMAT,IPMAT,IMATL 85 : INTEGER NDMAT,NPMAT,NBMATL 86 : INTEGER LONLIG 87 : INTEGER IELEM 88 : INTEGER NUELG,OLDISM,ISOUMA,NUELOC 89 : * 90 : * Executable statements 91 : * 92 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkiza' 93 : * On régularise les maillage pour plus se faire chier si LISOUS(/1).EQ.0 94 : * In REGMAI : IF (.NOT.LPARTD) SEGINI ML2DUA 94 : CALL REGMAI(MELDUA,ML2DUA,LPARTD,IMPR,IRET) 95 : IF (IRET.NE.0) GOTO 9999 96 : * In REGMAI : IF (.NOT.LPARTP) SEGINI ML2PRI 96 : CALL REGMAI(MELPRI,ML2PRI,LPARTP,IMPR,IRET) 97 : IF (IRET.NE.0) GOTO 9999 98 : * 99 : * Activons les chapeaux (Matrices et supports) 100 : * 101 : SEGACT ML2DUA 102 : NBSOUD=ML2DUA.LISOUS(/1) 103 : SEGACT ML2PRI 104 : NBSOUP=ML2PRI.LISOUS(/1) 105 : SEGACT IMATEL 106 : NBSOUM=NBSOUP 107 : NBMATL=IMATEL.LIZAFM(/2) 108 : IF (NBSOUD.NE.NBSOUP) THEN 109 : WRITE(IOIMP,*) 'Maillage primal, dual :' 110 : WRITE(IOIMP,*) 'partitionnment différent...' 111 : WRITE(IOIMP,*) 'NBSOUD=',NBSOUD 112 : WRITE(IOIMP,*) 'NBSOUP=',NBSOUP 113 : GOTO 9999 114 : ENDIF 115 : * 116 : * Tableau de repérage dans la matrice 117 : * 118 : * In INIRPM : SEGINI RPMAT 118 : CALL INIRPM(IMATEL,RPMAT,IMPR,IRET) 119 : IF (IRET.NE.0) GOTO 9999 120 : * 121 : * Activons les tableaux de repérage 122 : * 123 : SEGACT KRINCD 124 : NBCMPD=KRINCD.LECT(/1) 125 : SEGACT KRINCP 126 : NBCMPP=KRINCP.LECT(/1) 127 : IF (NBCMPD.NE.NBMATL.OR.NBCMPP.NE.NBMATL) THEN 128 : WRITE(IOIMP,*) 'KRINCD, KRINCP et IMATEL :' 129 : WRITE(IOIMP,*) 'nb. comp. différents...' 130 : GOTO 9999 131 : ENDIF 132 : SEGACT KMINCT 133 : SEGACT KRSPGT 134 : SEGACT PMTOT 135 : SEGACT IZATOT*MOD 136 : * 137 : * Parcourons les matrices élémentaires par sous-domaine et 138 : * remplissons les valeurs de la matrice Morse. 139 : * 140 : DO 1 IMATL=1,NBMATL 141 : ITIDUA=KRINCD.LECT(IMATL) 142 : ITIPRI=KRINCP.LECT(IMATL) 143 : NUELG=0 144 : OLDISM=1 145 : VMATEL=IMATEL.LIZAFM(OLDISM,IMATL) 146 : SEGACT VMATEL 147 : DO 12 ISOUM=1,NBSOUM 148 : SMLDUA=ML2DUA.LISOUS(ISOUM) 149 : SEGACT SMLDUA 150 : SMLPRI=ML2PRI.LISOUS(ISOUM) 151 : SEGACT SMLPRI 152 : NELPRI=SMLPRI.NUM(/2) 153 : DO 122 IELEM=1,NELPRI 154 : NUELG=NUELG+1 154 : CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET) 155 : IF (IRET.NE.0) GOTO 9999 156 : ISOUMA=MAX(ISOUMA,1) 157 : IF (ISOUMA.NE.OLDISM) THEN 158 : SEGDES VMATEL 159 : VMATEL=IMATEL.LIZAFM(ISOUMA,IMATL) 160 : SEGACT VMATEL 161 : OLDISM=ISOUMA 162 : ENDIF 163 : ILMAT=NUELOC 164 : NPMAT=VMATEL.AM(/2) 165 : NDMAT=VMATEL.AM(/3) 166 : DO 1222 JDMAT=1,NDMAT 167 : ITPODU=KRSPGT.LECT(SMLDUA.NUM(JDMAT,IELEM)) 168 : IF (ITPODU.EQ.0) THEN 169 : WRITE(IOIMP,*) 'Point dual ????' 170 : GOTO 9999 171 : ENDIF 172 : C Test du MPOS... déjà fait dans mkpmor... 173 : ITDDLD=KMINCT.NPOS(ITPODU) 174 : $ + KMINCT.MPOS(ITPODU,ITIDUA)-1 175 : IDXDEB=PMTOT.IA(ITDDLD) 176 : LONLIG=PMTOT.IA(ITDDLD+1)-IDXDEB 177 : IF (LONLIG.EQ.0) THEN 178 : WRITE(IOIMP,*) 'Ligne inex. ddl dua =',ITDDLD 179 : GOTO 9999 180 : ENDIF 181 : C IPMAT parce que IDMAT est le nom d'un segment par défaut... 182 : DO 12222 IPMAT=1,NPMAT 183 : ITPOPR=KRSPGT.LECT(SMLPRI.NUM(IPMAT,IELEM)) 184 : IF (ITPOPR.EQ.0) THEN 185 : WRITE(IOIMP,*) 'Point primal ????' 186 : GOTO 9999 187 : ENDIF 188 : ITDDLP=KMINCT.NPOS(ITPOPR) 189 : $ + KMINCT.MPOS(ITPOPR,ITIPRI)-1 189 : CALL IFIDIC(LONLIG,PMTOT.JA(IDXDEB),ITDDLP, 190 : $ IDX, 191 : $ IMPR,IRET) 192 : IF (IRET.NE.0) GOTO 9999 193 : IZATOT.A(IDXDEB+IDX-1)=IZATOT.A(IDXDEB+IDX-1) 194 : $ + VMATEL.AM(ILMAT,IPMAT,JDMAT) 195 : 12222 CONTINUE 196 : 1222 CONTINUE 197 : 122 CONTINUE 198 : SEGDES SMLPRI 199 : SEGDES SMLDUA 200 : 12 CONTINUE 201 : SEGDES VMATEL 202 : 1 CONTINUE 203 : SEGDES IZATOT 204 : SEGDES PMTOT 205 : SEGDES KRSPGT 206 : SEGDES KMINCT 207 : SEGDES KRINCP 208 : SEGDES KRINCD 209 : SEGSUP RPMAT 210 : SEGDES IMATEL 211 : SEGDES ML2PRI 212 : SEGDES ML2DUA 213 : IF (.NOT.LPARTP) SEGSUP ML2PRI 214 : IF (.NOT.LPARTD) SEGSUP ML2DUA 215 : * 216 : * Normal termination 217 : * 218 : IRET=0 219 : RETURN 220 : * 221 : * Format handling 222 : * 223 : * 224 : * Error handling 225 : * 226 : 9999 CONTINUE 227 : IRET=1 228 : WRITE(IOIMP,*) 'An error was detected in subroutine mkiza' 229 : RETURN 230 : * 231 : * End of subroutine MKIZA 232 : * 233 : END 234 : 235 : 236 : 237 : 238 :
© Cast3M 2003 - All rights reserved.
Disclaimer