Download inirpm.eso

Back to the list

   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