1 : C MKIZAT SOURCE MAGN 09/07/30 21:19:30 6458 2 : SUBROUTINE MKIZAT(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 : MKIZAT 11 : C DESCRIPTION : Matrice élémentaire + Profil Morse de la matrice 12 : C assemblée => ajout de la contribution de la transposée 13 : C de la matrice élémentaire aux valeurs de la matrice 14 : C Morse assemblée. 15 : C 16 : C Le profil Morse est supposé avoir ses colonnes 17 : C ordonnées. 18 : C 19 : C !!!!!!!! 20 : C Ce source devrait être quasiment identique à mkiza et évolué en 21 : C même temps... 22 : C 23 : C LANGAGE : ESOPE 24 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 25 : C mél : gounand@semt2.smts.cea.fr 26 : C*********************************************************************** 27 : C APPELES : REGMAI, IFIDIC, INIRPM 28 : C APPELE PAR : PRASEM 29 : C*********************************************************************** 30 : C ENTREES : MELDUA, MELPRI, IMATEL, KRINCD, KRINCP, KMINCT, 31 : C KRSPGT, PMTOT 32 : C ENTREES/SORTIES : IZATOT 33 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 34 : C*********************************************************************** 35 : C VERSION : v1, 16/12/99 36 : C HISTORIQUE : v1, 16/12/99, création 37 : C HISTORIQUE : 05/01/00 : On ne suppose plus les maillages duaux et 38 : C primaux partitionnés de la même façon que les matrices 39 : C élémentaires. 40 : C HISTORIQUE : 41 : C HISTORIQUE : 42 : C*********************************************************************** 43 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 44 : C en cas de modification de ce sous-programme afin de faciliter 45 : C la maintenance ! 46 : C*********************************************************************** 47 : -INC CCOPTIO 48 : -INC SMELEME 49 : POINTEUR MELDUA.MELEME 50 : POINTEUR ML2DUA.MELEME 51 : POINTEUR SMLDUA.MELEME 52 : POINTEUR MELPRI.MELEME 53 : POINTEUR ML2PRI.MELEME 54 : POINTEUR SMLPRI.MELEME 55 : -INC SMMATRIK 56 : POINTEUR IMATEL.IMATRI 57 : POINTEUR VMATEL.IZAFM 58 : POINTEUR KMINCT.MINC 59 : POINTEUR PMTOT.PMORS 60 : POINTEUR IZATOT.IZA 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 mkizat' 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 IZATOT*MOD 126 : * 127 : * Parcourons les matrices élémentaires par sous-domaine et 128 : * remplissons les valeurs de la matrice Morse. 129 : * 130 : DO 1 IMATL=1,NBMATL 131 : ITIDUA=KRINCD.LECT(IMATL) 132 : ITIPRI=KRINCP.LECT(IMATL) 133 : NUELG=0 134 : OLDISM=1 135 : VMATEL=IMATEL.LIZAFM(OLDISM,IMATL) 136 : SEGACT VMATEL 137 : DO 12 ISOUM=1,NBSOUM 138 : SMLDUA=ML2DUA.LISOUS(ISOUM) 139 : SEGACT SMLDUA 140 : SMLPRI=ML2PRI.LISOUS(ISOUM) 141 : SEGACT SMLPRI 142 : NELPRI=SMLPRI.NUM(/2) 143 : DO 122 IELEM=1,NELPRI 144 : NUELG=NUELG+1 144 : CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET) 145 : IF (IRET.NE.0) GOTO 9999 146 : ISOUMA=MAX(ISOUMA,1) 147 : IF (ISOUMA.NE.OLDISM) THEN 148 : SEGDES VMATEL 149 : VMATEL=IMATEL.LIZAFM(ISOUMA,IMATL) 150 : SEGACT VMATEL 151 : OLDISM=ISOUMA 152 : ENDIF 153 : ILMAT=NUELOC 154 : NPMAT=VMATEL.AM(/2) 155 : NDMAT=VMATEL.AM(/3) 156 : DO 1222 JDMAT=1,NDMAT 157 : ITPODU=KRSPGT.LECT(SMLDUA.NUM(JDMAT,IELEM)) 158 : IF (ITPODU.EQ.0) THEN 159 : WRITE(IOIMP,*) 'Point dual ????' 160 : GOTO 9999 161 : ENDIF 162 : C Test du MPOS... déjà fait dans mkpmor... 163 : ITDDLD=KMINCT.NPOS(ITPODU) 164 : $ + KMINCT.MPOS(ITPODU,ITIDUA)-1 165 : C IPMAT parce que IDMAT est le nom d'un segment par défaut... 166 : DO 12222 IPMAT=1,NPMAT 167 : ITPOPR=KRSPGT.LECT(SMLPRI.NUM(IPMAT,IELEM)) 168 : IF (ITPOPR.EQ.0) THEN 169 : WRITE(IOIMP,*) 'Point primal ????' 170 : GOTO 9999 171 : ENDIF 172 : ITDDLP=KMINCT.NPOS(ITPOPR) 173 : $ + KMINCT.MPOS(ITPOPR,ITIPRI)-1 174 : IDXDEB=PMTOT.IA(ITDDLP) 175 : LONLIG=PMTOT.IA(ITDDLP+1)-IDXDEB 176 : IF (LONLIG.EQ.0) THEN 177 : WRITE(IOIMP,*) 'Ligne inex. ddl pri =',ITDDLP 178 : GOTO 9999 179 : ENDIF 179 : CALL IFIDIC(LONLIG,PMTOT.JA(IDXDEB),ITDDLD, 180 : $ IDX, 181 : $ IMPR,IRET) 182 : IF (IRET.NE.0) GOTO 9999 183 : IZATOT.A(IDXDEB+IDX-1)=IZATOT.A(IDXDEB+IDX-1) 184 : $ + VMATEL.AM(ILMAT,IPMAT,JDMAT) 185 : 12222 CONTINUE 186 : 1222 CONTINUE 187 : 122 CONTINUE 188 : SEGDES VMATEL 189 : 12 CONTINUE 190 : SEGDES SMLPRI 191 : SEGDES SMLDUA 192 : 1 CONTINUE 193 : SEGDES IZATOT 194 : SEGDES PMTOT 195 : SEGDES KRSPGT 196 : SEGDES KMINCT 197 : SEGDES KRINCP 198 : SEGDES KRINCD 199 : SEGSUP RPMAT 200 : SEGDES IMATEL 201 : SEGDES ML2PRI 202 : SEGDES ML2DUA 203 : IF (.NOT.LPARTP) SEGSUP ML2PRI 204 : IF (.NOT.LPARTD) SEGSUP ML2DUA 205 : * 206 : * Normal termination 207 : * 208 : IRET=0 209 : RETURN 210 : * 211 : * Format handling 212 : * 213 : * 214 : * Error handling 215 : * 216 : 9999 CONTINUE 217 : IRET=1 218 : WRITE(IOIMP,*) 'An error was detected in subroutine mkizat' 219 : RETURN 220 : * 221 : * End of subroutine MKIZAT 222 : * 223 : END 224 : 225 : 226 : 227 : 228 :
© Cast3M 2003 - All rights reserved.
Disclaimer