1 : C MKIZT2 SOURCE MAGN 09/07/30 21:19:32 6458 2 : SUBROUTINE MKIZT2(MELDUA,MELPRI,IMATEL, 3 : $ KRINCD,KRINCP,KMINCT,KRSPGT, 4 : $ PMTOT,IDMATP,IDMATD, 5 : *IDMTOT, 6 : $ IZATOT, 7 : $ IMPR,IRET) 8 : IMPLICIT REAL*8 (A-H,O-Z) 9 : IMPLICIT INTEGER (I-N) 10 : C*********************************************************************** 11 : C NOM : MKIZT2 12 : C DESCRIPTION : Pareil que mkizat + changement de numérotation (argument 13 : C d'entrée) 14 : C Remplissage des valeurs de la Matrice Morse. 15 : C (dont les colonnes sont supposées ordonnées) 16 : C quasiment identique à mkiza. 17 : C pareil que mkizat avec changement de numérotation 18 : C (IDMTOT.NUAN) 19 : C 20 : C LANGAGE : ESOPE 21 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 22 : C mél : gounand@semt2.smts.cea.fr 23 : C*********************************************************************** 24 : C APPELES : REGMAI, IFIDIC, INIRPM 25 : C APPELE PAR : PRASEM 26 : C*********************************************************************** 27 : C ENTREES : MELDUA, MELPRI, IMATEL, KRINCD, KRINCP, KMINCT, 28 : C KRSPGT, PMTOT, IDMTOT 29 : C ENTREES/SORTIES : IZATOT 30 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 31 : C*********************************************************************** 32 : C VERSION : v1, 16/12/99 33 : C HISTORIQUE : v1, 16/12/99, création 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 : 09/04/04 ajout idmatp idmatd 38 : C HISTORIQUE : 39 : C*********************************************************************** 40 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 41 : C en cas de modification de ce sous-programme afin de faciliter 42 : C la maintenance ! 43 : C*********************************************************************** 44 : -INC CCOPTIO 45 : -INC SMELEME 46 : POINTEUR MELDUA.MELEME 47 : POINTEUR ML2DUA.MELEME 48 : POINTEUR SMLDUA.MELEME 49 : POINTEUR MELPRI.MELEME 50 : POINTEUR ML2PRI.MELEME 51 : POINTEUR SMLPRI.MELEME 52 : -INC SMMATRIK 53 : POINTEUR IMATEL.IMATRI 54 : POINTEUR VMATEL.IZAFM 55 : POINTEUR KMINCT.MINC 56 : POINTEUR PMTOT.PMORS 57 : POINTEUR IZATOT.IZA 58 : * POINTEUR IDMTOT.IDMAT 59 : POINTEUR IDMATP.IDMAT 60 : POINTEUR IDMATD.IDMAT 61 : -INC SMLENTI 62 : POINTEUR KRINCD.MLENTI 63 : POINTEUR KRINCP.MLENTI 64 : POINTEUR KRSPGT.MLENTI 65 : POINTEUR RPMAT.MLENTI 66 : * 67 : INTEGER IMPR,IRET 68 : * 69 : LOGICAL LPARTD,LPARTP 70 : INTEGER IDX,IDXDEB 71 : INTEGER ISOUM,NBSOUM,NBSOUD,NBSOUP 72 : INTEGER ITDDLD,ITDDLP,ITIDUA,ITIPRI,ITPODU,ITPOPR 73 : INTEGER NBCMPD,NBCMPP,NELPRI 74 : INTEGER ILMAT,JDMAT,IPMAT,IMATL 75 : INTEGER NLMAT,NDMAT,NPMAT,NBMATL 76 : INTEGER LONLIG 77 : INTEGER IELEM 78 : INTEGER NUELG,OLDISM,ISOUMA,NUELOC 79 : * 80 : * Executable statements 81 : * 82 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkizt2' 83 : * On régularise les maillage pour plus se faire chier si LISOUS(/1).EQ.0 84 : * In REGMAI : IF (.NOT.LPARTD) SEGINI ML2DUA 84 : CALL REGMAI(MELDUA,ML2DUA,LPARTD,IMPR,IRET) 85 : IF (IRET.NE.0) GOTO 9999 86 : * In REGMAI : IF (.NOT.LPARTP) SEGINI ML2PRI 86 : CALL REGMAI(MELPRI,ML2PRI,LPARTP,IMPR,IRET) 87 : IF (IRET.NE.0) GOTO 9999 88 : * 89 : * Activons les chapeaux (Matrices et supports) 90 : * 91 : SEGACT ML2DUA 92 : NBSOUD=ML2DUA.LISOUS(/1) 93 : SEGACT ML2PRI 94 : NBSOUP=ML2PRI.LISOUS(/1) 95 : SEGACT IMATEL 96 : NBSOUM=NBSOUP 97 : NBMATL=IMATEL.LIZAFM(/2) 98 : IF (NBSOUD.NE.NBSOUP) THEN 99 : WRITE(IOIMP,*) 'Maillage primal, dual :' 100 : WRITE(IOIMP,*) 'partitionnment différent...' 101 : WRITE(IOIMP,*) 'NBSOUD=',NBSOUD 102 : WRITE(IOIMP,*) 'NBSOUP=',NBSOUP 103 : GOTO 9999 104 : ENDIF 105 : * 106 : * Tableau de repérage dans la matrice 107 : * 108 : * In INIRPM : SEGINI RPMAT 108 : CALL INIRPM(IMATEL,RPMAT,IMPR,IRET) 109 : IF (IRET.NE.0) GOTO 9999 110 : * 111 : * Activons les tableaux de repérage 112 : * 113 : SEGACT KRINCD 114 : NBCMPD=KRINCD.LECT(/1) 115 : SEGACT KRINCP 116 : NBCMPP=KRINCP.LECT(/1) 117 : IF (NBCMPD.NE.NBMATL.OR.NBCMPP.NE.NBMATL) THEN 118 : WRITE(IOIMP,*) 'KRINCD, KRINCP et IMATEL :' 119 : WRITE(IOIMP,*) 'nb. comp. différents...' 120 : GOTO 9999 121 : ENDIF 122 : SEGACT KMINCT 123 : SEGACT KRSPGT 124 : SEGACT PMTOT 125 : * SEGACT IDMTOT 126 : SEGACT IDMATP 127 : SEGACT IDMATD 128 : SEGACT IZATOT*MOD 129 : * 130 : * Parcourons les matrices élémentaires par sous-domaine et 131 : * remplissons les valeurs de la matrice Morse. 132 : * 133 : DO 1 IMATL=1,NBMATL 134 : ITIDUA=KRINCD.LECT(IMATL) 135 : ITIPRI=KRINCP.LECT(IMATL) 136 : NUELG=0 137 : OLDISM=1 138 : VMATEL=IMATEL.LIZAFM(OLDISM,IMATL) 139 : SEGACT VMATEL 140 : DO 12 ISOUM=1,NBSOUM 141 : SMLDUA=ML2DUA.LISOUS(ISOUM) 142 : SEGACT SMLDUA 143 : SMLPRI=ML2PRI.LISOUS(ISOUM) 144 : SEGACT SMLPRI 145 : NELPRI=SMLPRI.NUM(/2) 146 : DO 122 IELEM=1,NELPRI 147 : NUELG=NUELG+1 147 : CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET) 148 : IF (IRET.NE.0) GOTO 9999 149 : ISOUMA=MAX(ISOUMA,1) 150 : IF (ISOUMA.NE.OLDISM) THEN 151 : SEGDES VMATEL 152 : VMATEL=IMATEL.LIZAFM(ISOUMA,IMATL) 153 : SEGACT VMATEL 154 : OLDISM=ISOUMA 155 : ENDIF 156 : ILMAT=NUELOC 157 : NPMAT=VMATEL.AM(/2) 158 : NDMAT=VMATEL.AM(/3) 159 : DO 1222 JDMAT=1,NDMAT 160 : ITPODU=KRSPGT.LECT(SMLDUA.NUM(JDMAT,IELEM)) 161 : IF (ITPODU.EQ.0) THEN 162 : WRITE(IOIMP,*) 'Point dual ????' 163 : GOTO 9999 164 : ENDIF 165 : C Test du MPOS... déjà fait dans mkpmor... 166 : ITDDLD=IDMATD.NUAN( 167 : $ KMINCT.NPOS(ITPODU) 168 : $ + KMINCT.MPOS(ITPODU,ITIDUA)-1 169 : $ ) 170 : C IPMAT parce que IDMAT est le nom d'un segment par défaut... 171 : DO 12222 IPMAT=1,NPMAT 172 : ITPOPR=KRSPGT.LECT(SMLPRI.NUM(IPMAT,IELEM)) 173 : IF (ITPOPR.EQ.0) THEN 174 : WRITE(IOIMP,*) 'Point primal ????' 175 : GOTO 9999 176 : ENDIF 177 : ITDDLP=IDMATP.NUAN( 178 : $ KMINCT.NPOS(ITPOPR) 179 : $ + KMINCT.MPOS(ITPOPR,ITIPRI)-1 180 : $ ) 181 : IDXDEB=PMTOT.IA(ITDDLP) 182 : LONLIG=PMTOT.IA(ITDDLP+1)-IDXDEB 183 : IF (LONLIG.EQ.0) THEN 184 : WRITE(IOIMP,*) 'Ligne inex. ddl pri =',ITDDLP 185 : GOTO 9999 186 : ENDIF 186 : CALL IFIDIC(LONLIG,PMTOT.JA(IDXDEB),ITDDLD, 187 : $ IDX, 188 : $ IMPR,IRET) 189 : IF (IRET.NE.0) GOTO 9999 190 : IZATOT.A(IDXDEB+IDX-1)=IZATOT.A(IDXDEB+IDX-1) 191 : $ + VMATEL.AM(ILMAT,IPMAT,JDMAT) 192 : 12222 CONTINUE 193 : 1222 CONTINUE 194 : 122 CONTINUE 195 : SEGDES VMATEL 196 : 12 CONTINUE 197 : SEGDES SMLPRI 198 : SEGDES SMLDUA 199 : 1 CONTINUE 200 : SEGDES IZATOT 201 : SEGDES IDMATD 202 : SEGDES IDMATP 203 : * SEGDES IDMTOT 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 mkizt2' 229 : RETURN 230 : * 231 : * End of subroutine MKIZT2 232 : * 233 : END 234 : 235 : 236 : 237 : 238 :
© Cast3M 2003 - All rights reserved.
Disclaimer