1 : C MIDCDB SOURCE CHAT 05/01/13 01:45:12 5004 2 : SUBROUTINE MIDCDB(ICPCDB,JCDUAB,LINBNC,JCDUAC,NIUNIQ, 3 : $ ICDCDB, 4 : $ IMPR,IRET) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C*********************************************************************** 8 : C NOM : MIDCDB 9 : C DESCRIPTION : On construit la liste indexée à la précédente des 10 : C inconnues duales de CD-1Bt. 11 : C 12 : C 13 : C LANGAGE : ESOPE 14 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 15 : C mél : gounand@semt2.smts.cea.fr 16 : C*********************************************************************** 17 : C APPELES : RSETEE, RPENLE 18 : C APPELE PAR : PROMAT 19 : C*********************************************************************** 20 : C ENTREES : ICPCDB, JCDUAB, LINBNC, JCDUAC, NIUNIQ 21 : C SORTIES : ICDCDB 22 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 23 : C*********************************************************************** 24 : C VERSION : v1, 07/02/2000, version initiale 25 : C HISTORIQUE : v1, 07/02/2000, création 26 : C HISTORIQUE : 27 : C HISTORIQUE : 28 : C*********************************************************************** 29 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 30 : C en cas de modification de ce sous-programme afin de faciliter 31 : C la maintenance ! 32 : C*********************************************************************** 33 : -INC CCOPTIO 34 : -INC SMLENTI 35 : POINTEUR ICPCDB.MLENTI 36 : POINTEUR JCDUAB.MLENTI 37 : POINTEUR JCDUAC.MLENTI 38 : INTEGER JG 39 : POINTEUR KRPCDB.MLENTI 40 : POINTEUR KRDCDB.MLENTI 41 : * Includes persos 42 : * Segment LSTIND (liste séquentielle indexée) 43 : INTEGER NBM,NBTVAL 44 : SEGMENT LSTIND 45 : INTEGER IDX(NBM+1) 46 : INTEGER IVAL(NBTVAL) 47 : ENDSEGMENT 48 : *-INC SLSTIND 49 : POINTEUR LINBNC.LSTIND 50 : POINTEUR LIPDNB.LSTIND 51 : POINTEUR ICDCDB.LSTIND 52 : * 53 : INTEGER IMPR,IRET 54 : * 55 : INTEGER LDG,NCPCDB,NIUNIQ 56 : INTEGER IDG,JCPCDB 57 : INTEGER IVDCDB 58 : INTEGER JVPDNB,JVSTRT,JVSTOP,KVNBNC,KVSTRT,KVSTOP 59 : INTEGER INBMEB,INBMEC,NUDUAC 60 : INTEGER LAST,PREC 61 : * 62 : * Executable statements 63 : * 64 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans midcdb.eso' 65 : * On construit la liste de correspondance : 66 : * une inconnue de ICPCDB -> n°s(IBMEs) matrice B tels que 67 : * JCDUAB(IBME)=ICPCDB 68 : SEGACT ICPCDB 69 : NCPCDB=ICPCDB.LECT(/1) 70 : JG=NIUNIQ 71 : SEGINI KRPCDB 71 : CALL RSETEE(ICPCDB.LECT,NCPCDB, 72 : $ KRPCDB.LECT,NIUNIQ, 73 : $ IMPR,IRET) 74 : IF (IRET.NE.0) GOTO 9999 75 : * SEGPRT,KRPCDB 76 : SEGDES ICPCDB 76 : CALL RPENLE(JCDUAB,KRPCDB,NCPCDB, 77 : $ LIPDNB, 78 : $ IMPR,IRET) 79 : * SEGPRT,LIPDNB 80 : SEGSUP KRPCDB 81 : * Dimensionnement de ICDCDB 82 : * Pour l'instant ICDCDB.IDX(JCPCDB+1)=nombre d'inconnues 83 : * distinctes reliées à l'inconnue ICPCDB.LECT(JCPCDB) 84 : NBM=NCPCDB 85 : NBTVAL=0 86 : SEGINI ICDCDB 87 : JG=NIUNIQ 88 : SEGINI KRDCDB 89 : SEGACT LIPDNB 90 : SEGACT LINBNC 91 : SEGACT JCDUAC 92 : DO 1 JCPCDB=1,NCPCDB 93 : * Degré et fin de la liste chaînée 94 : LDG=0 95 : LAST=-1 96 : JVSTRT=LIPDNB.IDX(JCPCDB) 97 : JVSTOP=LIPDNB.IDX(JCPCDB+1)-1 98 : DO 12 JVPDNB=JVSTRT,JVSTOP 99 : INBMEB=LIPDNB.IVAL(JVPDNB) 100 : KVSTRT=LINBNC.IDX(INBMEB) 101 : KVSTOP=LINBNC.IDX(INBMEB+1)-1 102 : DO 122 KVNBNC=KVSTRT,KVSTOP 103 : INBMEC=LINBNC.IVAL(KVNBNC) 104 : NUDUAC=JCDUAC.LECT(INBMEC) 105 : IF (KRDCDB.LECT(NUDUAC).EQ.0) THEN 106 : LDG=LDG+1 107 : KRDCDB.LECT(NUDUAC)=LAST 108 : LAST=NUDUAC 109 : ENDIF 110 : 122 CONTINUE 111 : 12 CONTINUE 112 : ICDCDB.IDX(JCPCDB+1)=LDG 113 : * Remise à zéro de la liste chaînée 114 : DO 14 IDG=1,LDG 115 : PREC=KRDCDB.LECT(LAST) 116 : KRDCDB.LECT(LAST)=0 117 : LAST=PREC 118 : 14 CONTINUE 119 : 1 CONTINUE 120 : * ICDCDB.IDX est transformé en la liste d'indexation sur 121 : * ICDCDB.IVAL 122 : ICDCDB.IDX(1)=1 123 : DO 3 JCPCDB=1,NCPCDB 124 : ICDCDB.IDX(JCPCDB+1)=ICDCDB.IDX(JCPCDB+1)+ICDCDB.IDX(JCPCDB) 125 : 3 CONTINUE 126 : NBM=NCPCDB 127 : NBTVAL=ICDCDB.IDX(NCPCDB+1)-1 128 : SEGADJ,ICDCDB 129 : * Remplissage de ICDCDB 130 : IVDCDB=0 131 : DO 5 JCPCDB=1,NCPCDB 132 : * Degré et fin de la liste chaînée 133 : LDG=0 134 : LAST=-1 135 : JVSTRT=LIPDNB.IDX(JCPCDB) 136 : JVSTOP=LIPDNB.IDX(JCPCDB+1)-1 137 : DO 52 JVPDNB=JVSTRT,JVSTOP 138 : INBMEB=LIPDNB.IVAL(JVPDNB) 139 : KVSTRT=LINBNC.IDX(INBMEB) 140 : KVSTOP=LINBNC.IDX(INBMEB+1)-1 141 : DO 522 KVNBNC=KVSTRT,KVSTOP 142 : INBMEC=LINBNC.IVAL(KVNBNC) 143 : NUDUAC=JCDUAC.LECT(INBMEC) 144 : IF (KRDCDB.LECT(NUDUAC).EQ.0) THEN 145 : LDG=LDG+1 146 : KRDCDB.LECT(NUDUAC)=LAST 147 : LAST=NUDUAC 148 : ENDIF 149 : 522 CONTINUE 150 : 52 CONTINUE 151 : * Remise à zéro de la liste chaînée et vidage dans ICDCDB 152 : DO 54 IDG=1,LDG 153 : PREC=KRDCDB.LECT(LAST) 154 : IVDCDB=IVDCDB+1 155 : ICDCDB.IVAL(IVDCDB)=LAST 156 : KRDCDB.LECT(LAST)=0 157 : LAST=PREC 158 : 54 CONTINUE 159 : 5 CONTINUE 160 : SEGDES JCDUAC 161 : SEGDES LINBNC 162 : SEGSUP LIPDNB 163 : SEGSUP KRDCDB 164 : SEGDES ICDCDB 165 : * 166 : * Normal termination 167 : * 168 : IRET=0 169 : RETURN 170 : * 171 : * Format handling 172 : * 173 : * 174 : * Error handling 175 : * 176 : 9999 CONTINUE 177 : IRET=1 178 : WRITE(IOIMP,*) 'An error was detected in subroutine midcdb' 179 : RETURN 180 : * 181 : * End of subroutine MIDCDB 182 : * 183 : END 184 : 185 : 186 :
© Cast3M 2003 - All rights reserved.
Disclaimer