Télécharger fuspr5.eso

Retour à la liste

Numérotation des lignes :

  1. C FUSPR5 SOURCE PV 16/11/17 21:59:28 9180
  2. C FUSPR5 SOURCE MAGN 09/07/30 21:17:05 6458
  3. SUBROUTINE FUSPR5(PMORSS,NTTDDL,
  4. $ PMTOT,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : FUSPR5
  10. C PROJET : Assemblage matrice élémentaire -> matrice Morse
  11. C DESCRIPTION : Assemblage d'un ensemble de profils Morse
  12. C Le résultat est dans PMTOT.
  13. C Subroutine quasi-identique à FUSPR5. On
  14. C suppose la matrice totale carrée
  15. C
  16. C
  17. C LANGAGE : ESOPE
  18. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  19. C mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES :
  22. C APPELE PAR : PRASEM, MAKPMT
  23. C***********************************************************************
  24. C ENTREES : PMORSS
  25. C SORTIES : PMTOT
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION : v1, 13/12/99, version initiale
  29. C HISTORIQUE : v1, 13/12/99, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37. *
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. INTEGER NTT,NJA
  42. POINTEUR PMCOU.PMORS
  43. POINTEUR PMTOT.PMORS
  44. *
  45. SEGMENT PMORSS
  46. POINTEUR LISDD(NBPM).MLENTI
  47. POINTEUR LISPM(NBPM).PMORS
  48. ENDSEGMENT
  49. *
  50.  
  51. -INC SMLENTI
  52. POINTEUR LDDCOU.MLENTI
  53. POINTEUR INDEX.MLENTI
  54. POINTEUR IWORK.MLENTI
  55. *
  56. INTEGER IMPR,IRET
  57. *
  58. INTEGER NTTDU2,NTTDUA,NTTPRI
  59. INTEGER NNZTOT
  60. *
  61. * Executable statements
  62. *
  63. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fuspr5'
  64. NBPM=PMORSS.LISDD(/1)
  65. *
  66. DO IPM=1,NBPM
  67. LDDCOU=PMORSS.LISDD(IPM)
  68. PMCOU=PMORSS.LISPM(IPM)
  69. SEGACT LDDCOU
  70. SEGACT PMCOU
  71. ENDDO
  72. *
  73. * On compte le nombre de termes par ligne
  74. *
  75. NTT=NTTDDL
  76. NJA=0
  77. SEGINI PMTOT
  78. * Ici IA est le nombre de termes par ligne
  79. DO IPM=1,NBPM
  80. LDDCOU=PMORSS.LISDD(IPM)
  81. PMCOU=PMORSS.LISPM(IPM)
  82. NLIG=PMCOU.IA(/1)-1
  83. DO ILIG=1,NLIG
  84. ILIGG=LDDCOU.LECT(ILIG)
  85. NCOL=PMCOU.IA(ILIG+1)-PMCOU.IA(ILIG)
  86. PMTOT.IA(ILIGG)=PMTOT.IA(ILIGG)+NCOL
  87. NJA=NJA+NCOL
  88. ENDDO
  89. ENDDO
  90. SEGADJ PMTOT
  91. * Calcul de NJA
  92. * Maintenant, IA va être le pointeur sur l'indice courant dans JA
  93. NCOL1=PMTOT.IA(1)
  94. PMTOT.IA(1)=1
  95. DO ITT=1,NTT
  96. NCOL=PMTOT.IA(ITT+1)
  97. PMTOT.IA(ITT+1)=PMTOT.IA(ITT)+NCOL1
  98. NCOL1=NCOL
  99. ENDDO
  100. *
  101. * Remplissage de PMTOT
  102. *
  103. DO IPM=1,NBPM
  104. LDDCOU=PMORSS.LISDD(IPM)
  105. PMCOU=PMORSS.LISPM(IPM)
  106. NLIG=PMCOU.IA(/1)-1
  107. DO ILIG=1,NLIG
  108. ILIGG=LDDCOU.LECT(ILIG)
  109. NCOL=PMCOU.IA(ILIG+1)-PMCOU.IA(ILIG)
  110. DO ICOL=1,NCOL
  111. IJA=PMCOU.IA(ILIG)+ICOL-1
  112. IJAG=PMTOT.IA(ILIGG)+ICOL-1
  113. PMTOT.JA(IJAG)=PMCOU.JA(IJA)
  114. ENDDO
  115. PMTOT.IA(ILIGG)=PMTOT.IA(ILIGG)+NCOL
  116. ENDDO
  117. ENDDO
  118. * On rétablit IA comme pointeur sur le premier indice courant dans JA
  119. DO ITT=NTT,1,-1
  120. PMTOT.IA(ITT+1)=PMTOT.IA(ITT)
  121. ENDDO
  122. PMTOT.IA(1)=1
  123. DO IPM=1,NBPM
  124. LDDCOU=PMORSS.LISDD(IPM)
  125. PMCOU=PMORSS.LISPM(IPM)
  126. SEGDES LDDCOU
  127. SEGDES PMCOU
  128. ENDDO
  129. SEGDES PMTOT
  130. *
  131. * Normal termination
  132. *
  133. IRET=0
  134. RETURN
  135. *
  136. * Format handling
  137. *
  138. *
  139. * Error handling
  140. *
  141. 9999 CONTINUE
  142. IRET=1
  143. WRITE(IOIMP,*) 'An error was detected in subroutine fuspr5'
  144. RETURN
  145. *
  146. * End of subroutine FUSPR5
  147. *
  148. END
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  

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