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