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. -INC CCOPTIO
  39. INTEGER NTT,NJA
  40. POINTEUR PMCOU.PMORS
  41. POINTEUR PMTOT.PMORS
  42. *
  43. SEGMENT PMORSS
  44. POINTEUR LISDD(NBPM).MLENTI
  45. POINTEUR LISPM(NBPM).PMORS
  46. ENDSEGMENT
  47. *
  48.  
  49. -INC SMLENTI
  50. POINTEUR LDDCOU.MLENTI
  51. POINTEUR INDEX.MLENTI
  52. POINTEUR IWORK.MLENTI
  53. *
  54. INTEGER IMPR,IRET
  55. *
  56. INTEGER NTTDU2,NTTDUA,NTTPRI
  57. INTEGER NNZTOT
  58. *
  59. * Executable statements
  60. *
  61. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fuspr5'
  62. NBPM=PMORSS.LISDD(/1)
  63. *
  64. DO IPM=1,NBPM
  65. LDDCOU=PMORSS.LISDD(IPM)
  66. PMCOU=PMORSS.LISPM(IPM)
  67. SEGACT LDDCOU
  68. SEGACT PMCOU
  69. ENDDO
  70. *
  71. * On compte le nombre de termes par ligne
  72. *
  73. NTT=NTTDDL
  74. NJA=0
  75. SEGINI PMTOT
  76. * Ici IA est le nombre de termes par ligne
  77. DO IPM=1,NBPM
  78. LDDCOU=PMORSS.LISDD(IPM)
  79. PMCOU=PMORSS.LISPM(IPM)
  80. NLIG=PMCOU.IA(/1)-1
  81. DO ILIG=1,NLIG
  82. ILIGG=LDDCOU.LECT(ILIG)
  83. NCOL=PMCOU.IA(ILIG+1)-PMCOU.IA(ILIG)
  84. PMTOT.IA(ILIGG)=PMTOT.IA(ILIGG)+NCOL
  85. NJA=NJA+NCOL
  86. ENDDO
  87. ENDDO
  88. SEGADJ PMTOT
  89. * Calcul de NJA
  90. * Maintenant, IA va être le pointeur sur l'indice courant dans JA
  91. NCOL1=PMTOT.IA(1)
  92. PMTOT.IA(1)=1
  93. DO ITT=1,NTT
  94. NCOL=PMTOT.IA(ITT+1)
  95. PMTOT.IA(ITT+1)=PMTOT.IA(ITT)+NCOL1
  96. NCOL1=NCOL
  97. ENDDO
  98. *
  99. * Remplissage de PMTOT
  100. *
  101. DO IPM=1,NBPM
  102. LDDCOU=PMORSS.LISDD(IPM)
  103. PMCOU=PMORSS.LISPM(IPM)
  104. NLIG=PMCOU.IA(/1)-1
  105. DO ILIG=1,NLIG
  106. ILIGG=LDDCOU.LECT(ILIG)
  107. NCOL=PMCOU.IA(ILIG+1)-PMCOU.IA(ILIG)
  108. DO ICOL=1,NCOL
  109. IJA=PMCOU.IA(ILIG)+ICOL-1
  110. IJAG=PMTOT.IA(ILIGG)+ICOL-1
  111. PMTOT.JA(IJAG)=PMCOU.JA(IJA)
  112. ENDDO
  113. PMTOT.IA(ILIGG)=PMTOT.IA(ILIGG)+NCOL
  114. ENDDO
  115. ENDDO
  116. * On rétablit IA comme pointeur sur le premier indice courant dans JA
  117. DO ITT=NTT,1,-1
  118. PMTOT.IA(ITT+1)=PMTOT.IA(ITT)
  119. ENDDO
  120. PMTOT.IA(1)=1
  121. DO IPM=1,NBPM
  122. LDDCOU=PMORSS.LISDD(IPM)
  123. PMCOU=PMORSS.LISPM(IPM)
  124. SEGDES LDDCOU
  125. SEGDES PMCOU
  126. ENDDO
  127. SEGDES PMTOT
  128. *
  129. * Normal termination
  130. *
  131. IRET=0
  132. RETURN
  133. *
  134. * Format handling
  135. *
  136. *
  137. * Error handling
  138. *
  139. 9999 CONTINUE
  140. IRET=1
  141. WRITE(IOIMP,*) 'An error was detected in subroutine fuspr5'
  142. RETURN
  143. *
  144. * End of subroutine FUSPR5
  145. *
  146. END
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  

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