1 : C MKPMOR SOURCE MAGN 09/07/30 21:19:35 6458 2 : SUBROUTINE MKPMOR(LPDPP,KJSPGD,KRINCP,KRINCD, 3 : $ KRSPGT,KMINCT, 4 : $ PMCOU, 5 : $ IMPR,IRET) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : C*********************************************************************** 9 : C NOM : MKPMOR 10 : C PROJET : Assemblage matrice élémentaire -> matrice Morse 11 : C DESCRIPTION : Matrice élémentaire + liste indexée d'entiers(popoin) => 12 : C Profil Morse de la matrice assemblée (les colonnes ne 13 : C sont pas ordonnées). 14 : C 15 : C LANGAGE : ESOPE 16 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 17 : C mél : gounand@semt2.smts.cea.fr 18 : C*********************************************************************** 19 : C APPELES : CORINC 20 : C APPELE PAR : MAKPRM 21 : C*********************************************************************** 22 : C ENTREES : LPDPP, KJSPGD, KRINCP, KRINCD, KRSPGT, KMINCT 23 : C SORTIES : PMCOU 24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 25 : C*********************************************************************** 26 : C VERSION : v1, 06/10/99, version initiale 27 : C HISTORIQUE : v1, 06/10/99, 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 : * 36 : * 37 : * On peut optimiser les boucles en sortant les NPOS 38 : * 39 : * 40 : -INC CCOPTIO 41 : -INC SMELEME 42 : POINTEUR KJSPGD.MELEME 43 : -INC SMMATRIK 44 : POINTEUR KMINCT.MINC 45 : INTEGER NTT,NJA 46 : POINTEUR PMCOU.PMORS 47 : -INC SMLENTI 48 : INTEGER JG 49 : POINTEUR KRINCD.MLENTI 50 : POINTEUR KRIDUN.MLENTI 51 : POINTEUR KRINCP.MLENTI 52 : POINTEUR KRSPGT.MLENTI 53 : POINTEUR DD2DP.MLENTI 54 : * 55 : * Includes perso 56 : * 57 : *-INC SLSTIND 58 : * 59 : * Segment LSTIND (liste séquentielle indexée) 60 : * 61 : SEGMENT LSTIND 62 : INTEGER IDX(NBM+1) 63 : INTEGER IVAL(NBTVAL) 64 : ENDSEGMENT 65 : * 66 : * LISTE SEQUENTIELLE INDEXEE D'ENTIERS 67 : * 68 : * NBM : NOMBRE DE MULTIPLETS 69 : * NBTVAL : NOMBRE TOTAL DE VALEURS 70 : * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME 71 : * MULTIPLET DANS LE TABLEAU IVAL 72 : * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET 73 : POINTEUR LIPUN.LSTIND 74 : POINTEUR LPDPP.LSTIND 75 : * 76 : INTEGER IMPR,IRET 77 : * 78 : LOGICAL LEXIST 79 : INTEGER IDEPA 80 : INTEGER IDUNIQ,IPUNIQ,IPDUA,IPPRI,ITTDDL 81 : INTEGER NDUNIQ,NPDUA, NTTDDL 82 : INTEGER NOPPR,NOPDU 83 : INTEGER NUTPPR,NUTPDU,NUTDPR,NUTDDU 84 : INTEGER NTOTCO,NTOTPO 85 : * 86 : * Executable statements 87 : * 88 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkpmor' 89 : C Pour chaque composante primale distincte, il faudrait déterminer 90 : C avec quels composantes duales distinctes il est relié : 91 : C Par exemple, si on a : 92 : C KRINCD = 1 1 1 2 93 : C KRINCP = 2 2 3 4 94 : C On a : KRIDUN = 1 2 95 : C On veut : LIPUN = (2 3) (4) (c'est une liste indexée) 96 : C 96 : CALL CORINC(KRINCD,KRINCP, 97 : $ KRIDUN,LIPUN, 98 : $ IMPR,IRET) 99 : C - Construire la liste d'entiers suivante (DD2DP) : 100 : C * Nombre d'entiers = nb total de ddl (primaux) ; 101 : C * pour chaque ddl primal : nb. total de ddl duaux qui lui 102 : C sont reliés. 103 : SEGACT KRIDUN 104 : NDUNIQ=KRIDUN.LECT(/1) 105 : SEGACT LIPUN 106 : SEGACT KJSPGD 107 : SEGACT KRSPGT 108 : SEGACT KMINCT 109 : NTOTPO=KMINCT.NPOS(/1)-1 110 : NTTDDL=KMINCT.NPOS(NTOTPO+1)-1 111 : JG=NTTDDL 112 : SEGINI DD2DP 113 : SEGACT LPDPP 114 : NPDUA=KJSPGD.NUM(/2) 115 : DO 1 IPDUA=1,NPDUA 116 : NOPDU=KJSPGD.NUM(1,IPDUA) 117 : NUTPDU=KRSPGT.LECT(NOPDU) 118 : IF (NUTPDU.EQ.0) THEN 119 : WRITE(IOIMP,*) 'C''est dual grave...' 120 : GOTO 9999 121 : ENDIF 122 : DO 12 IDUNIQ=1,NDUNIQ 123 : LEXIST=(KMINCT.MPOS(NUTPDU,KRIDUN.LECT(IDUNIQ)).NE.0) 124 : IF (.NOT.LEXIST) THEN 125 : WRITE(IOIMP,*) 'C''est comp. duale grave...' 126 : GOTO 9999 127 : ENDIF 128 : NUTDDU=KMINCT.NPOS(NUTPDU) 129 : $ +KMINCT.MPOS(NUTPDU,KRIDUN.LECT(IDUNIQ))-1 130 : DD2DP.LECT(NUTDDU)=(LIPUN.IDX(IDUNIQ+1)-LIPUN.IDX(IDUNIQ)) 131 : $ *(LPDPP.IDX(IPDUA+1)-LPDPP.IDX(IPDUA)) 132 : 12 CONTINUE 133 : 1 CONTINUE 134 : C 135 : C - Dimensionner le profil Morse 136 : C 137 : NTOTCO=0 138 : DO 3 ITTDDL=1,NTTDDL 139 : NTOTCO=NTOTCO+DD2DP.LECT(ITTDDL) 140 : 3 CONTINUE 141 : NTT=NTTDDL 142 : NJA=NTOTCO 143 : SEGINI PMCOU 144 : C 145 : C - Remplissage du profil de la matrice Morse : 146 : C * Le tableau IA : 147 : PMCOU.IA(1)=1 148 : DO 5 ITTDDL=1,NTTDDL 149 : PMCOU.IA(ITTDDL+1)=PMCOU.IA(ITTDDL) 150 : $ +DD2DP.LECT(ITTDDL) 151 : 5 CONTINUE 152 : SEGSUP DD2DP 153 : C * Le tableau JA : 154 : DO 7 IPDUA=1,NPDUA 155 : NOPDU=KJSPGD.NUM(1,IPDUA) 156 : NUTPDU=KRSPGT.LECT(NOPDU) 157 : DO 72 IDUNIQ=1,NDUNIQ 158 : NUTDDU=KMINCT.NPOS(NUTPDU) 159 : $ +KMINCT.MPOS(NUTPDU,KRIDUN.LECT(IDUNIQ))-1 160 : IDEPA=PMCOU.IA(NUTDDU) 161 : DO 722 IPPRI=LPDPP.IDX(IPDUA),LPDPP.IDX(IPDUA+1)-1 162 : NOPPR=LPDPP.IVAL(IPPRI) 163 : NUTPPR=KRSPGT.LECT(NOPPR) 164 : DO 7222 IPUNIQ=LIPUN.IDX(IDUNIQ),LIPUN.IDX(IDUNIQ+1)-1 165 : NUTDPR=KMINCT.NPOS(NUTPPR) 166 : $ +KMINCT.MPOS(NUTPPR,LIPUN.IVAL(IPUNIQ))-1 167 : PMCOU.JA(IDEPA)=NUTDPR 168 : IDEPA=IDEPA+1 169 : 7222 CONTINUE 170 : 722 CONTINUE 171 : 72 CONTINUE 172 : 7 CONTINUE 173 : SEGDES PMCOU 174 : SEGDES LPDPP 175 : SEGDES KMINCT 176 : SEGDES KRSPGT 177 : SEGDES KJSPGD 178 : SEGSUP LIPUN 179 : SEGSUP KRIDUN 180 : * 181 : * Normal termination 182 : * 183 : IRET=0 184 : RETURN 185 : * 186 : * Format handling 187 : * 188 : * 189 : * Error handling 190 : * 191 : 9999 CONTINUE 192 : IRET=1 193 : WRITE(IOIMP,*) 'An error was detected in subroutine mkpmor' 194 : RETURN 195 : * 196 : * End of subroutine MKPMOR 197 : * 198 : END 199 : 200 : 201 : 202 :
© Cast3M 2003 - All rights reserved.
Disclaimer