1 : C PROLIS SOURCE GOUNAND 06/04/26 21:16:21 5414 2 : SUBROUTINE PROLIS(JCDUAB,JCPRIB,JCPRIC,JCDUAC, 3 : $ LIPNMC, KRIPRI, 4 : $ LMDUAB,LMPRIB,LMPRIC,LMDUAC, 5 : $ LILBLC,KRMPRI, 6 : $ LCHPOD,LMATRB,LMATRC, 7 : $ ICPCDB,ICDCDB,NIUNIQ, 8 : $ LMPCDB,LMDCDB,NTOTPO, 9 : $ LMACDB, 10 : $ IMPR,IRET) 11 : IMPLICIT INTEGER(I-N) 12 : IMPLICIT REAL*8 (A-H,O-Z) 13 : C*********************************************************************** 14 : C NOM : PROLIS 15 : C DESCRIPTION : Produit des matrices stockées sous forme de listes 16 : C indexées (1 : Initialisation des tableaux de travail et 17 : C boucle sur les noms d'inconnues) 18 : C 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 : INLMAP, RSETEE, PROLI2 25 : C APPELE PAR : PROMAT 26 : C*********************************************************************** 27 : C ENTREES : tout sauf LMACDB 28 : C SORTIES : LMACDB 29 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 30 : C*********************************************************************** 31 : C VERSION : v1, 10/02/2000, version initiale 32 : C HISTORIQUE : v1, 10/02/2000, création 33 : C HISTORIQUE : 34 : C HISTORIQUE : 35 : C*********************************************************************** 36 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 37 : C en cas de modification de ce sous-programme afin de faciliter 38 : C la maintenance ! 39 : C*********************************************************************** 40 : -INC CCOPTIO 41 : -INC SMLENTI 42 : POINTEUR JCPRIB.MLENTI 43 : POINTEUR JCDUAB.MLENTI 44 : POINTEUR JCPRIC.MLENTI 45 : POINTEUR JCDUAC.MLENTI 46 : POINTEUR KRIPRI.MLENTI 47 : POINTEUR ICPCDB.MLENTI 48 : INTEGER JG 49 : POINTEUR KRMPRI.MLENTI 50 : POINTEUR KIPCDB.MLENTI 51 : POINTEUR KIDCDB.MLENTI 52 : POINTEUR KMPRBP.MLENTI 53 : POINTEUR KMDCDB.MLENTI 54 : * Includes persos 55 : * Segment LSTIND (liste séquentielle indexée) 56 : SEGMENT LSTIND 57 : INTEGER IDX(NBM+1) 58 : INTEGER IVAL(NBTVAL) 59 : ENDSEGMENT 60 : POINTEUR LIPNMC.LSTIND 61 : POINTEUR ICDCDB.LSTIND 62 : POINTEUR LMDUAB.LSTIND 63 : POINTEUR LMPRIB.LSTIND 64 : POINTEUR LMPRIC.LSTIND 65 : POINTEUR LMDUAC.LSTIND 66 : POINTEUR LILBLC.LSTIND 67 : POINTEUR LMPCDB.LSTIND 68 : POINTEUR LMDCDB.LSTIND 69 : SEGMENT LSRIND 70 : INTEGER IDXX(NBM+1) 71 : REAL*8 XVAL(NBTVAL) 72 : ENDSEGMENT 73 : SEGMENT LLI 74 : POINTEUR LISLI(NBME).LSRIND 75 : ENDSEGMENT 76 : POINTEUR LMATRB.LLI 77 : POINTEUR LMATRC.LLI 78 : POINTEUR LMACDB.LLI 79 : POINTEUR SLMATB.LSRIND 80 : POINTEUR SLMATC.LSRIND 81 : POINTEUR SLMCDB.LSRIND 82 : -INC SMLREEL 83 : SEGMENT LLR 84 : POINTEUR LISLR(NBME).MLREEL 85 : ENDSEGMENT 86 : POINTEUR LCHPOD.LLR 87 : POINTEUR SLCHPD.MLREEL 88 : * 89 : INTEGER IMPR,IRET 90 : * 91 : INTEGER NIUNIQ 92 : INTEGER NTOTPO 93 : INTEGER NBMEB,NMPCDB,NELCDB 94 : INTEGER IBMEB,IMPCDB,IBMEC,IBMCDB,INMLPB,NUIDP 95 : INTEGER IVDCDB,IVSTRT,IVSTOP 96 : INTEGER JVBMEC,JVSTRT,JVSTOP 97 : 98 : * 99 : * Executable statements 100 : * 101 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prolis.eso' 102 : * Initialisation de LMACDB 102 : CALL INLMAP(ICDCDB,LMPCDB,LMDCDB, 103 : $ LMACDB, 104 : $ IMPR,IRET) 105 : IF (IRET.NE.0) GOTO 9999 106 : * 107 : * Bouclage sur les inconnues 108 : * 109 : * Repérage dans ICPCDB 110 : JG=NIUNIQ 111 : SEGINI KIPCDB 112 : SEGACT ICPCDB 113 : NMPCDB=ICPCDB.LECT(/1) 113 : CALL RSETEE(ICPCDB.LECT,NMPCDB, 114 : $ KIPCDB.LECT,NIUNIQ, 115 : $ IMPR,IRET) 116 : IF (IRET.NE.0) GOTO 9999 117 : SEGDES ICPCDB 118 : * Repérage dans ICDCDB 119 : JG=NIUNIQ 120 : SEGINI KIDCDB 121 : SEGACT ICDCDB 122 : * Repérage dans MAIPRI 123 : JG=NTOTPO 124 : SEGINI KMPRBP 125 : * Repérage dans LMDCDB 126 : JG=NTOTPO 127 : SEGINI KMDCDB 128 : SEGACT JCDUAB 129 : SEGACT JCPRIB 130 : NBMEB=JCPRIB.LECT(/1) 131 : SEGACT JCPRIC 132 : SEGACT JCDUAC 133 : SEGACT KRIPRI 134 : SEGACT LIPNMC 135 : SEGACT LMDUAB 136 : SEGACT LMPRIB 137 : SEGACT LMPRIC 138 : SEGACT LMDUAC 139 : SEGACT KRMPRI 140 : SEGACT LILBLC 141 : SEGACT LMPCDB 142 : NELCDB=LMPCDB.IDX(/1)-1 143 : SEGACT LMDCDB 144 : SEGACT LMATRB 145 : SEGACT LMATRC 146 : IF (LCHPOD.NE.0) THEN 147 : SEGACT LCHPOD 148 : ENDIF 149 : SEGACT LMACDB 150 : * 151 : * Boucle sur les inconnues de B 152 : * 153 : DO 1 IBMEB=1,NBMEB 154 : IMPCDB=KIPCDB.LECT(JCDUAB.LECT(IBMEB)) 155 : IVSTRT=ICDCDB.IDX(IMPCDB) 156 : IVSTOP=ICDCDB.IDX(IMPCDB+1)-1 157 : DO 12 IVDCDB=IVSTRT,IVSTOP 158 : NUIDP=ICDCDB.IVAL(IVDCDB) 159 : KIDCDB.LECT(NUIDP)=IVDCDB 160 : 12 CONTINUE 161 : INMLPB=KRIPRI.LECT(JCPRIB.LECT(IBMEB)) 162 : JVSTRT=LIPNMC.IDX(INMLPB) 163 : JVSTOP=LIPNMC.IDX(INMLPB+1)-1 164 : * 165 : * Boucle sur les inconnues C associées à chaque inconnue B 166 : * 167 : DO 14 JVBMEC=JVSTRT,JVSTOP 168 : IBMEC=LIPNMC.IVAL(JVBMEC) 169 : IBMCDB=KIDCDB.LECT(JCDUAC.LECT(IBMEC)) 170 : SLMATB=LMATRB.LISLI(IBMEB) 171 : SLMATC=LMATRC.LISLI(IBMEC) 172 : IF (LCHPOD.NE.0) THEN 173 : SLCHPD=LCHPOD.LISLR(INMLPB) 174 : SEGACT SLCHPD 175 : ELSE 176 : SLCHPD=0 177 : ENDIF 178 : SLMCDB=LMACDB.LISLI(IBMCDB) 179 : SEGACT SLMATB 180 : SEGACT SLMATC 181 : SEGACT SLMCDB*MOD 181 : CALL PROLI2(LMDUAB,LMPRIB,LMPRIC,LMDUAC, 182 : $ LILBLC,KRMPRI,KMDCDB,KMPRBP, 183 : $ SLCHPD,SLMATB,SLMATC, 184 : $ LMPCDB,LMDCDB,NELCDB, 185 : $ SLMCDB, 186 : $ IMPR,IRET) 187 : IF (IRET.NE.0) GOTO 9999 188 : SEGDES SLMCDB 189 : IF (SLCHPD.NE.0) THEN 190 : SEGDES SLCHPD 191 : ENDIF 192 : SEGDES SLMATC 193 : SEGDES SLMATB 194 : 14 CONTINUE 195 : DO 16 IVDCDB=IVSTRT,IVSTOP 196 : NUIDP=ICDCDB.IVAL(IVDCDB) 197 : KIDCDB.LECT(NUIDP)=0 198 : 16 CONTINUE 199 : 1 CONTINUE 200 : SEGDES LMACDB 201 : IF (LCHPOD.NE.0) THEN 202 : SEGDES LCHPOD 203 : ENDIF 204 : SEGDES LMATRC 205 : SEGDES LMATRB 206 : SEGDES LMDCDB 207 : SEGDES LMPCDB 208 : SEGDES LILBLC 209 : SEGDES KRMPRI 210 : SEGDES LMDUAC 211 : SEGDES LMPRIC 212 : SEGDES LMPRIB 213 : SEGDES LMDUAB 214 : SEGDES LIPNMC 215 : SEGDES KRIPRI 216 : SEGDES JCDUAC 217 : SEGDES JCPRIC 218 : SEGDES JCPRIB 219 : SEGDES JCDUAB 220 : SEGSUP KMDCDB 221 : SEGSUP KMPRBP 222 : SEGDES ICDCDB 223 : SEGSUP KIDCDB 224 : SEGSUP KIPCDB 225 : * 226 : * Normal termination 227 : * 228 : IRET=0 229 : RETURN 230 : * 231 : * Format handling 232 : * 233 : * 234 : * Error handling 235 : * 236 : 9999 CONTINUE 237 : IRET=1 238 : WRITE(IOIMP,*) 'An error was detected in subroutine prolis' 239 : RETURN 240 : * 241 : * End of subroutine PROLIS 242 : * 243 : END 244 : 245 : 246 : 247 :
© Cast3M 2003 - All rights reserved.
Disclaimer