1 : C INLMAP SOURCE CHAT 05/01/13 00:38:26 5004 2 : SUBROUTINE INLMAP(ICDCDB,LMPCDB,LMDCDB, 3 : $ LMACDB, 4 : $ IMPR,IRET) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C*********************************************************************** 8 : C NOM : INLMAP 9 : C DESCRIPTION : Initialisation de la matrice produit. 10 : C 11 : C 12 : C LANGAGE : ESOPE 13 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 14 : C mél : gounand@semt2.smts.cea.fr 15 : C*********************************************************************** 16 : C APPELES : - 17 : C APPELE PAR : PROLIS 18 : C*********************************************************************** 19 : C ENTREES : ICDCDB, LMPCDB, LMDCDB 20 : C SORTIES : LMACDB 21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 22 : C*********************************************************************** 23 : C VERSION : v1, 10/02/2000, version initiale 24 : C HISTORIQUE : v1, 10/02/2000, création 25 : C HISTORIQUE : 26 : C HISTORIQUE : 27 : C*********************************************************************** 28 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 29 : C en cas de modification de ce sous-programme afin de faciliter 30 : C la maintenance ! 31 : C*********************************************************************** 32 : -INC CCOPTIO 33 : * Includes persos 34 : * Segment LSTIND (liste séquentielle indexée) 35 : SEGMENT LSTIND 36 : INTEGER IDX(NBM+1) 37 : INTEGER IVAL(NBTVAL) 38 : ENDSEGMENT 39 : POINTEUR ICDCDB.LSTIND 40 : POINTEUR LMPCDB.LSTIND 41 : POINTEUR LMDCDB.LSTIND 42 : SEGMENT LSRIND 43 : INTEGER IDXX(NBM+1) 44 : REAL*8 XVAL(NBTVAL) 45 : ENDSEGMENT 46 : SEGMENT LLI 47 : POINTEUR LISLI(NBME).LSRIND 48 : ENDSEGMENT 49 : INTEGER NBM,NBTVAL,NBME 50 : POINTEUR LMACDB.LLI 51 : POINTEUR SLMCDB.LSRIND 52 : POINTEUR SLMPIX.LSRIND 53 : * 54 : INTEGER IMPR,IRET 55 : * 56 : INTEGER IBME,ILCDB 57 : INTEGER NCPL,NLCDB 58 : INTEGER NUVP,NUVD,NUVPD 59 : * 60 : * Executable statements 61 : * 62 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inlmap.eso' 63 : * - nombre d'inconnues : 64 : SEGACT ICDCDB 65 : NCPL=ICDCDB.IVAL(/1) 66 : NBME=NCPL 67 : SEGINI LMACDB 68 : SEGACT LMPCDB 69 : SEGACT LMDCDB 70 : NLCDB=LMPCDB.IDX(/1)-1 71 : NBM=NLCDB 72 : NBTVAL=0 73 : SEGINI SLMPIX 74 : DO 1 ILCDB=1,NLCDB 75 : NUVP=LMPCDB.IDX(ILCDB+1)-LMPCDB.IDX(ILCDB) 76 : NUVD=LMDCDB.IDX(ILCDB+1)-LMDCDB.IDX(ILCDB) 77 : NUVPD=NUVP*NUVD 78 : SLMPIX.IDXX(ILCDB+1)=NUVPD 79 : 1 CONTINUE 80 : * SLMPIX.IDXX est transformé en liste d'indexation 81 : SLMPIX.IDXX(1)=1 82 : DO 3 ILCDB=1,NLCDB 83 : SLMPIX.IDXX(ILCDB+1)=SLMPIX.IDXX(ILCDB+1)+SLMPIX.IDXX(ILCDB) 84 : 3 CONTINUE 85 : * Initialisation des segments de LMACDB 86 : DO 5 IBME=1,NBME 87 : NBM=NLCDB 88 : NBTVAL=SLMPIX.IDXX(NLCDB+1)-1 89 : SEGINI SLMCDB 90 : DO 52 ILCDB=1,NLCDB+1 91 : SLMCDB.IDXX(ILCDB)=SLMPIX.IDXX(ILCDB) 92 : 52 CONTINUE 93 : SEGDES SLMCDB 94 : LMACDB.LISLI(IBME)=SLMCDB 95 : 5 CONTINUE 96 : SEGSUP SLMPIX 97 : SEGDES LMDCDB 98 : SEGDES LMPCDB 99 : SEGDES LMACDB 100 : SEGDES ICDCDB 101 : * 102 : * Normal termination 103 : * 104 : IRET=0 105 : RETURN 106 : * 107 : * Format handling 108 : * 109 : * 110 : * Error handling 111 : * 112 : 9999 CONTINUE 113 : IRET=1 114 : WRITE(IOIMP,*) 'An error was detected in subroutine inlmap' 115 : RETURN 116 : * 117 : * End of subroutine INLMAP 118 : * 119 : END 120 : 121 : 122 :
© Cast3M 2003 - All rights reserved.
Disclaimer