Télécharger versym.eso

Retour à la liste

Numérotation des lignes :

versym
  1. C VERSYM SOURCE PV090527 24/01/19 21:15:06 11827
  2. *
  3. ************************************************************************
  4. * verification symetrie de la matrice
  5. *
  6. * IANTI = 0 : matrice symetrique -> Aij = Aji pour i<j
  7. * IANTI = 1 : matrice antisymetrique -> Aij = -Aji (et Aii=0)
  8. * IANTI = 2 : matrice quelconque -> pas de verification
  9. *
  10. ************************************************************************
  11. SUBROUTINE versym(re,ire1,ire2,ire3,IANTI)
  12.  
  13. IMPLICIT REAL*8 (a-h,o-z)
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC CCREEL
  17. REAL*8 re(ire1,ire2,ire3)
  18. * facteur de blocage pour optimiser le cache
  19. PARAMETER (NINC=32)
  20. PARAMETER (LIMTAIL=65532)
  21.  
  22. * matrice asymetrique (quelconque) -> pas de verif
  23. IF(IANTI.ne.0.and.IANTI.ne.1) return
  24.  
  25. * matrices carree uniquement
  26. IF (ire1.ne.ire2) CALL erreur(1044)
  27. mdim=ire1
  28.  
  29. * parametres
  30. xzref=(xpetit/xzprec)
  31. xzpref=1d1*xzprec
  32.  
  33. * boucle sur les termes ir,jr (limite sur ir pour optimiser cache)
  34.  
  35. * - Cas symetrique
  36. IF(IANTI.eq.0.and.ire1.lt.limtail) THEN
  37. do iel=1,ire3
  38. do i=1,mdim,ninc
  39. do jr=i+1,mdim
  40. redj=abs(re(jr,jr,iel))
  41. do ir=i,min(jr-1,i+ninc-1)
  42. re1=re(ir,jr,iel)
  43. re2=re(jr,ir,iel)
  44. redi=abs(re(ir,ir,iel))
  45. xn=abs(re1-re2)
  46. xd=max(redi,redj,abs(re1),abs(re2))+xzref
  47. if (xn/xd.gt.xzpref) then
  48. c MOTERR=' '
  49. c MOTERR(1:10)='SYMETRIQUE'
  50. MOTERR='SYMETRIQUE'
  51. reaerr(1)=re1
  52. reaerr(2)=re2
  53. reaerr(3)=xn
  54. call erreur(1044)
  55. return
  56. endif
  57. if (xn/xd.gt.xzref) then
  58. rem=(re1+re2)/2.d0
  59. re(ir,jr,iel)=rem
  60. re(jr,ir,iel)=rem
  61. endif
  62. enddo
  63. enddo
  64. enddo
  65. enddo
  66.  
  67. * - Cas anti-symetrique (on change les signes)
  68. ELSEIF(IANTI.eq.1) THEN
  69. do iel=1,ire3
  70. do i=1,mdim,ninc
  71. do jr=1,mdim
  72. do ir=i,min(jr-1,i+ninc-1)
  73. re1=re(ir,jr,iel)
  74. re2=re(jr,ir,iel)
  75. xn=abs(re1+re2)
  76. xd=max(abs(re1),abs(re2))+xzref
  77. if (xn.gt.xzpref*xd) then
  78. c MOTERR=' '
  79. c MOTERR(1:15)='ANTI-SYMETRIQUE'
  80. MOTERR='ANTI-SYMETRIQUE'
  81. reaerr(1)=re1
  82. reaerr(2)=re2
  83. reaerr(3)=xn
  84. call erreur(1044)
  85. return
  86. endif
  87. enddo
  88. enddo
  89. enddo
  90. c verif diagonale nulle
  91. do ir=1,mdim
  92. re1=re(ir,ir,iel)
  93. if (abs(re1).gt.xzref) then
  94. c MOTERR=' '
  95. c MOTERR(1:15)='ANTI-SYMETRIQUE'
  96. MOTERR='ANTI-SYMETRIQUE'
  97. reaerr(1)=re1
  98. reaerr(2)=0.D0
  99. reaerr(3)=abs(re1)
  100. call erreur(1044)
  101. return
  102. endif
  103. enddo
  104. enddo
  105. ENDIF
  106.  
  107. END
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  

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