1 : C PRASE2 SOURCE MAGN 09/07/30 21:19:49 6458 2 : SUBROUTINE PRASE2(MATELE,MATASS, 3 : $ IMPR,IRET) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : IMPLICIT INTEGER (I-N) 6 : C*********************************************************************** 7 : C NOM : PRASE2 8 : C PROJET : Noyau linéaire NLIN 9 : C DESCRIPTION : Version raccourcie de prasem lorsqu'on connaît la 10 : C structure de la matrice assemblée (tableau de repérage 11 : C des ddl, renumérotation, profil Morse). On effectue 12 : C l'assemblage d'un ensemble de matrices élémentaires pour 13 : C faire une matrice Morse. 14 : C Ceci est la version raccourcie de prasem. 15 : C on a une autre matrice identique sauf pour les 16 : C valeurs des matrices élémentaires. 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 : MKIZ2, MKIZT2 23 : C APPELES (UTIL) : RSETXI, CREPER 24 : C APPELE PAR : KRES2 25 : C*********************************************************************** 26 : C ENTREES : MATASS 27 : C ENTREES/SORTIES : MATELE 28 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 29 : C*********************************************************************** 30 : C VERSION : v1, 16/12/99, nouvelle version initiale 31 : C HISTORIQUE : v1, 16/12/99, création 32 : C HISTORIQUE : 09/04/04 rajout de idmatd 33 : C HISTORIQUE : 34 : C*********************************************************************** 35 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 36 : C en cas de modification de ce sous-programme afin de faciliter 37 : C la maintenance ! 38 : C*********************************************************************** 39 : * MATASS est une matrice de préconditionnement déjà assemblée 40 : * permettant de sauter des étapes de l'assemblage 41 : -INC CCOPTIO 42 : -INC SMCOORD 43 : -INC SMELEME 44 : POINTEUR KJSPGT.MELEME 45 : POINTEUR MELPRI.MELEME 46 : POINTEUR MELDUA.MELEME 47 : -INC SMLENTI 48 : INTEGER JG 49 : POINTEUR KRSPGT.MLENTI 50 : POINTEUR KRINCP.MLENTI 51 : POINTEUR KRINCD.MLENTI 52 : POINTEUR IWORK.MLENTI 53 : -INC SMLMOTS 54 : INTEGER JGN,JGM 55 : POINTEUR LITOT.MLMOTS 56 : -INC SMMATRIK 57 : POINTEUR MATELE.MATRIK 58 : POINTEUR MATASS.MATRIK 59 : POINTEUR IMATEL.IMATRI 60 : POINTEUR KMINCT.MINC 61 : * POINTEUR IDMTOT.IDMAT 62 : POINTEUR IDMATP.IDMAT 63 : POINTEUR IDMATD.IDMAT 64 : POINTEUR PMTOT.PMORS 65 : POINTEUR PMTOT2.PMORS 66 : INTEGER NBVA 67 : POINTEUR IZATOT.IZA 68 : * 69 : INTEGER LNMOTS 70 : PARAMETER (LNMOTS=8) 71 : * 72 : INTEGER IMPR,IRET 73 : * 74 : INTEGER NMATE,NTTDDL,NNZTOT,NTOGPO,NTOTIN,NTOTPO 75 : INTEGER IMATE, ITOTIN 76 : INTEGER LNM,NME 77 : * 78 : * Executable statements 79 : * 80 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prase2' 81 : SEGACT MATASS 82 : SEGACT MATELE*MOD 83 : NMATE=MATASS.IRIGEL(/2) 84 : * Copie de IRIGEL(1,I) et IRIGEL(2,I) 85 : DO 1 IMATE=1,NMATE 86 : MELPRI=MATASS.IRIGEL(1,IMATE) 87 : MELDUA=MATASS.IRIGEL(2,IMATE) 88 : MATELE.IRIGEL(1,IMATE)=MELPRI 89 : MATELE.IRIGEL(2,IMATE)=MELDUA 90 : 1 CONTINUE 91 : MATELE.KSYM=MATASS.KSYM 92 : * 93 : * Construire l'ensemble des points sur lesquels sont localisées des 94 : * inconnues (KSPGT). 95 : * 96 : KJSPGT=MATASS.KISPGT 97 : MATELE.KISPGT=KJSPGT 98 : MATELE.KISPGP=KJSPGT 99 : MATELE.KISPGD=KJSPGT 100 : * 101 : * Construire le repérage des inconnues KMINCT 102 : * 103 : KMINCT=MATASS.KMINC 104 : MATELE.KMINC=KMINCT 105 : MATELE.KMINCP=KMINCT 106 : MATELE.KMINCD=KMINCT 107 : * 108 : * Il faut reconstruire un profil Morse pour MATELE 109 : * 110 : NTTDDL=MATASS.KNTTT 111 : MATELE.KNTTT=NTTDDL 112 : MATELE.KNTTP=NTTDDL 113 : MATELE.KNTTD=NTTDDL 114 : IDMATP=MATASS.KIDMAT(1) 115 : IDMATD=MATASS.KIDMAT(2) 116 : MATELE.KIDMAT(1)=IDMATP 117 : MATELE.KIDMAT(2)=IDMATD 118 : PMTOT2=MATASS.KIDMAT(4) 119 : SEGINI,PMTOT=PMTOT2 120 : MATELE.KIDMAT(4)=PMTOT 121 : NNZTOT=PMTOT.JA(/1) 122 : SEGDES PMTOT 123 : * 124 : * L'ensemble des inconnues 125 : * 126 : SEGACT KMINCT 127 : NTOTIN=KMINCT.LISINC(/2) 128 : JGN=LNMOTS 129 : JGM=NTOTIN 130 : SEGINI LITOT 131 : DO 3 ITOTIN=1,NTOTIN 132 : LITOT.MOTS(ITOTIN)(1:8)=KMINCT.LISINC(ITOTIN)(1:LNMOTS) 133 : 3 CONTINUE 134 : SEGDES LITOT 135 : SEGDES KMINCT 136 : * 137 : * Le repérage dans KSPGT 138 : * 139 : SEGACT KJSPGT 140 : NTOTPO=KJSPGT.NUM(/2) 141 : NTOGPO=XCOOR(/1)/(IDIM+1) 142 : JG=NTOGPO 143 : SEGINI KRSPGT 144 : * SEGACT KRSPGT 144 : CALL RSETXI(KRSPGT.LECT,KJSPGT.NUM,NTOTPO) 145 : SEGDES KRSPGT 146 : SEGDES KJSPGT 147 : * 148 : * Ordonnancement du profil Morse total 149 : * 150 : SEGACT PMTOT*MOD 151 : NTTDDL=PMTOT.IA(/1)-1 152 : NNZTOT=PMTOT.JA(/1) 153 : JG=MAX(NTTDDL+1,2*NNZTOT) 154 : SEGINI IWORK 154 : CALL CSORT(PMTOT.IA(/1)-1,RDUMMY,PMTOT.JA,PMTOT.IA, 155 : $ IWORK.LECT,.FALSE.) 156 : SEGSUP IWORK 157 : SEGDES PMTOT 158 : * 159 : * Assemblage des matrices élémentaires 160 : * 161 : SEGACT LITOT 162 : NBVA=NNZTOT 163 : SEGINI IZATOT 164 : SEGDES IZATOT 165 : DO 77 IMATE=1,NMATE 166 : MELPRI=MATELE.IRIGEL(1,IMATE) 167 : MELDUA=MATELE.IRIGEL(2,IMATE) 168 : IMATEL=MATELE.IRIGEL(4,IMATE) 169 : SEGACT IMATEL 170 : * repérage dans la primale 171 : LNM=IMATEL.LISPRI(/1) 172 : NME=IMATEL.LISPRI(/2) 173 : JG=NME 174 : SEGINI KRINCP 174 : CALL CREPER(LNM,NME,NTOTIN, 175 : $ IMATEL.LISPRI,LITOT.MOTS, 176 : $ KRINCP.LECT, 177 : $ IMPR,IRET) 178 : IF (IRET.NE.0) GOTO 9999 179 : * repérage dans la duale 180 : LNM=IMATEL.LISDUA(/1) 181 : NME=IMATEL.LISDUA(/2) 182 : JG=NME 183 : SEGINI KRINCD 183 : CALL CREPER(LNM,NME,NTOTIN, 184 : $ IMATEL.LISDUA,LITOT.MOTS, 185 : $ KRINCD.LECT, 186 : $ IMPR,IRET) 187 : IF (IRET.NE.0) GOTO 9999 187 : CALL MKIZ2(MELDUA,MELPRI,IMATEL, 188 : $ KRINCD,KRINCP,KMINCT,KRSPGT, 189 : $ PMTOT,IDMATP,IDMATD, 190 : $ IZATOT, 191 : $ IMPR,IRET) 192 : IF (IRET.NE.0) GOTO 9999 193 : * 194 : * Cas particulier : celui des matrices CCt 195 : * 196 : ITYMAT=MATELE.IRIGEL(7,IMATE) 197 : IF (ITYMAT.EQ.4.OR.ITYMAT.EQ.-4) THEN 197 : CALL MKIZT2(MELDUA,MELPRI,IMATEL, 198 : $ KRINCD,KRINCP,KMINCT,KRSPGT, 199 : $ PMTOT,IDMATP,IDMATD, 200 : $ IZATOT, 201 : $ IMPR,IRET) 202 : IF (IRET.NE.0) GOTO 9999 203 : ENDIF 204 : SEGSUP KRINCD 205 : SEGSUP KRINCP 206 : SEGDES IMATEL 207 : 77 CONTINUE 208 : SEGSUP LITOT 209 : SEGSUP KRSPGT 210 : MATELE.KIDMAT(5)=IZATOT 211 : SEGDES MATELE 212 : SEGDES MATASS 213 : * 214 : * Normal termination 215 : * 216 : IRET=0 217 : RETURN 218 : * 219 : * Format handling 220 : * 221 : * 222 : * Error handling 223 : * 224 : 9999 CONTINUE 225 : IRET=1 226 : WRITE(IOIMP,*) 'An error was detected in subroutine prase2' 227 : RETURN 228 : * 229 : * End of subroutine PRASE2 230 : * 231 : END 232 : 233 : 234 :
© Cast3M 2003 - All rights reserved.
Disclaimer