Télécharger la plaquette Cast3M


fr en

Télécharger trpmor.eso

Retour à la liste

Numérotation des lignes : 

trpmor

  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.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. *
  38.       INTEGER N,NLIS
  39.       INTEGER XLIS(N+1),LIS(NLIS),XTRA(N+1),TRA(NLIS)
  40.       INTEGER IMPR,IRET
  41. *
  42.       INTEGER I,ILIS,L,J,JSTRT,JSTOP,ICOL,JCOL
  43. *
  44. * Executable statements
  45. *
  46.       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans trpmor'
  47. *
  48. * Initialisation des sorties (supposée faite)
  49. *
  50. *      DO 1 I=1,N
  51. *         XTRA(I)=0
  52. * 1    CONTINUE
  53. *
  54. * On utilise XTRA(1...N) tel que XTRA(i) = le nombre d'occurence de i
  55. * dans LIS
  56. *
  57.       DO 3 ILIS=1,NLIS
  58.          ICOL=LIS(ILIS)
  59.          XTRA(ICOL)=XTRA(ICOL)+1
  60.  3    CONTINUE
  61. *
  62. * D'où l'on déduit XTRA, liste de repérage sur TRA
  63. *
  64.       L=1
  65.       DO 5 I=1,N
  66.          L=L+XTRA(I)
  67.          XTRA(I)=L-XTRA(I)
  68.  5    CONTINUE
  69.       XTRA(N+1)=L
  70. *
  71. * XTRA nous sert maintenant de liste de pointeurs courant
  72. * dans le tableau TRA que l'on remplit
  73. *
  74.       DO 7 I=1,N
  75.          JSTRT=XLIS(I)
  76.          JSTOP=XLIS(I+1)-1
  77.          DO 72 J=JSTRT,JSTOP
  78.             JCOL=LIS(J)
  79.             TRA(XTRA(JCOL))=I
  80.             XTRA(JCOL)=XTRA(JCOL)+1
  81.  72      CONTINUE
  82.  7    CONTINUE
  83. *
  84. * On reconstitue XTRA, liste de repérage sur TRA
  85. *
  86.       DO 9 I=N,2,-1
  87.          XTRA(I)=XTRA(I-1)
  88.  9    CONTINUE
  89.       XTRA(1)=1
  90. *
  91. * Normal termination
  92. *
  93.       IRET=0
  94.       RETURN
  95. *
  96. * Format handling
  97. *
  98. *
  99. * Error handling
  100. *
  101.  9999 CONTINUE
  102.       IRET=1
  103.       WRITE(IOIMP,*) 'An error was detected in subroutine trpmor'
  104.       RETURN
  105. *
  106. * End of subroutine TRPMOR
  107. *
  108.       END
  109.  
  110.  
  111.  
  112.  
  113.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales