1 : C INIRPM SOURCE MAGN 09/07/30 21:17:24 6458 2 : SUBROUTINE INIRPM(IMAT, 3 : $ RPMAT, 4 : $ IMPR,IRET) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C*********************************************************************** 8 : C NOM : INIRPM 9 : C DESCRIPTION : Ensemble de matrices élémentaires n-partitionné => liste 10 : C d'entiers de dim. n+1 permettant le repérage "global" 11 : C des matrices élémentaires. 12 : C 13 : C Renvoie une liste d'entiers qui permet le 14 : C repérage des matrices élémentaires dans IMAT. 15 : C nbsous=imat.lizafm(/1) 16 : C RPMAT a pour dimension : (nbsous +1) 17 : C RPMAT(i) numéro de la 1ere matrice élémentaire 18 : C de lizafm(i). 19 : C RPMAT(nbsous+1)=nombre de matrice élémentaires 20 : C de imat+1 21 : C LANGAGE : ESOPE 22 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 23 : C mél : gounand@semt2.smts.cea.fr 24 : C*********************************************************************** 25 : C APPELES (ESOPE) : OOOETA 26 : C APPELE PAR : ELELMA 27 : C*********************************************************************** 28 : C ENTREES : IMAT 29 : C SORTIES : RPMAT 30 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 31 : C*********************************************************************** 32 : C VERSION : v1, 28/05/99, version initiale 33 : C HISTORIQUE : v1, 28/05/99, création 34 : C HISTORIQUE : 35 : C HISTORIQUE : 36 : C*********************************************************************** 37 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 38 : C en cas de modification de ce sous-programme afin de faciliter 39 : C la maintenance ! 40 : C*********************************************************************** 41 : -INC CCOPTIO 42 : -INC SMMATRIK 43 : POINTEUR IMAT.IMATRI 44 : POINTEUR SOUMAT.IZAFM 45 : -INC SMLENTI 46 : INTEGER JG 47 : POINTEUR RPMAT.MLENTI 48 : * 49 : INTEGER IMPR,IRET 50 : * 51 : INTEGER MAETA,SMETA 52 : INTEGER NELCOU,INBSOU 53 : INTEGER NBEL ,NBSOUS 54 : * 55 : * Executable statements 56 : * 57 : IF (IMPR.GT.1) THEN 58 : WRITE(IOIMP,*) 'Entrée dans inirpm.eso' 59 : ENDIF 60 : NELCOU=1 60 : CALL OOOETA(IMAT,MAETA) 61 : IF (MAETA.NE.1) SEGACT IMAT 62 : NBSOUS=IMAT.LIZAFM(/1) 63 : JG=NBSOUS+1 64 : SEGINI RPMAT 65 : DO 1 INBSOU=1,NBSOUS 66 : SOUMAT=IMAT.LIZAFM(INBSOU,1) 66 : CALL OOOETA(SOUMAT,SMETA) 67 : IF (SMETA.NE.1) SEGACT SOUMAT 68 : RPMAT.LECT(INBSOU)=NELCOU 69 : NBEL=SOUMAT.AM(/1) 70 : NELCOU=NELCOU+NBEL 71 : IF (SMETA.NE.1) SEGDES SOUMAT 72 : 1 CONTINUE 73 : RPMAT.LECT(NBSOUS+1)=NELCOU 74 : IF (MAETA.NE.1) SEGDES IMAT 75 : SEGDES RPMAT 76 : * 77 : * Normal termination 78 : * 79 : IRET=0 80 : RETURN 81 : * 82 : * Format handling 83 : * 84 : * 85 : * Error handling 86 : * 87 : 9999 CONTINUE 88 : IRET=1 89 : WRITE(IOIMP,*) 'An error was detected in subroutine inirpm' 90 : RETURN 91 : * 92 : * End of subroutine INIRPM 93 : * 94 : END 95 : 96 : 97 : 98 :
© Cast3M 2003 - All rights reserved.
Disclaimer