Esope source files

   1 : C TRPMOR    SOURCE    CHAT      05/01/13    03:52:18     5004           
   2 :       SUBROUTINE TRPMOR(N,NLIS,LIS,XLIS,
   3 :      $     TRA,XTRA,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : TRPMOR
   9 : C PROJET      : Noyau linéaire NLIN
  10 : C DESCRIPTION : Profil Morse de C => profil Morse de Ct
  11 : C
  12 : C               Construit la transposée d'un profil Morse d'une matrice
  13 : C               "carrée" (i.e. il faut que : $ max_i LIS(i) \leq n $)
  14 : C
  15 : C LANGAGE     : Fortran 77 (sauf E/S)
  16 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17 : C               mél : gounand@semt2.smts.cea.fr
  18 : C***********************************************************************
  19 : C APPELE PAR       : MAKPMT
  20 : C***********************************************************************
  21 : C ENTREES            : N, NLIS, LIS, XLIS
  22 : C SORTIES            : TRA, XTRA
  23 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24 : C***********************************************************************
  25 : C VERSION    : v1, 13/12/99, version initiale
  26 : C HISTORIQUE : v1, 13/12/99, création
  27 : C HISTORIQUE :
  28 : C HISTORIQUE :
  29 : C***********************************************************************
  30 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31 : C en cas de modification de ce sous-programme afin de faciliter
  32 : C la maintenance !
  33 : C***********************************************************************
  34 : -INC CCOPTIO
  35 : *     
  36 :       INTEGER N,NLIS
  37 :       INTEGER XLIS(N+1),LIS(NLIS),XTRA(N+1),TRA(NLIS)
  38 :       INTEGER IMPR,IRET
  39 : *
  40 :       INTEGER I,ILIS,L,J,JSTRT,JSTOP,ICOL,JCOL
  41 : *     
  42 : * Executable statements
  43 : *     
  44 :       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans trpmor'
  45 : *
  46 : * Initialisation des sorties (supposée faite)
  47 : *
  48 : *      DO 1 I=1,N
  49 : *         XTRA(I)=0
  50 : * 1    CONTINUE
  51 : *
  52 : * On utilise XTRA(1...N) tel que XTRA(i) = le nombre d'occurence de i
  53 : * dans LIS
  54 : *
  55 :       DO 3 ILIS=1,NLIS
  56 :          ICOL=LIS(ILIS)
  57 :          XTRA(ICOL)=XTRA(ICOL)+1
  58 :  3    CONTINUE
  59 : *
  60 : * D'où l'on déduit XTRA, liste de repérage sur TRA
  61 : *
  62 :       L=1
  63 :       DO 5 I=1,N
  64 :          L=L+XTRA(I)
  65 :          XTRA(I)=L-XTRA(I)
  66 :  5    CONTINUE
  67 :       XTRA(N+1)=L
  68 : *
  69 : * XTRA nous sert maintenant de liste de pointeurs courant
  70 : * dans le tableau TRA que l'on remplit
  71 : *
  72 :       DO 7 I=1,N
  73 :          JSTRT=XLIS(I)
  74 :          JSTOP=XLIS(I+1)-1
  75 :          DO 72 J=JSTRT,JSTOP
  76 :             JCOL=LIS(J)
  77 :             TRA(XTRA(JCOL))=I
  78 :             XTRA(JCOL)=XTRA(JCOL)+1
  79 :  72      CONTINUE
  80 :  7    CONTINUE
  81 : *
  82 : * On reconstitue XTRA, liste de repérage sur TRA
  83 : *
  84 :       DO 9 I=N,2,-1
  85 :          XTRA(I)=XTRA(I-1)
  86 :  9    CONTINUE
  87 :       XTRA(1)=1
  88 : *     
  89 : * Normal termination
  90 : *     
  91 :       IRET=0
  92 :       RETURN
  93 : *     
  94 : * Format handling
  95 : *     
  96 : *     
  97 : * Error handling
  98 : *     
  99 :  9999 CONTINUE
 100 :       IRET=1
 101 :       WRITE(IOIMP,*) 'An error was detected in subroutine trpmor'
 102 :       RETURN
 103 : *     
 104 : * End of subroutine TRPMOR
 105 : *     
 106 :       END
 107 : 
 108 :  
 109 :  
 110 :