Télécharger versym.eso

Retour à la liste

Numérotation des lignes :

  1. C VERSYM SOURCE PV 20/05/11 21:15:04 10611
  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.  
  21. * matrice asymetrique (quelconque) -> pas de verif
  22. IF(IANTI.ne.0.and.IANTI.ne.1) return
  23.  
  24. * matrices carree uniquement
  25. IF (ire1.ne.ire2) CALL erreur(1044)
  26. mdim=ire1
  27.  
  28. * parametres
  29. xzref=(xpetit/xzprec)
  30. xzprla=xzprec*5.5D0
  31.  
  32. * boucle sur les termes ir,jr (limite sur ir pour optimiser cache)
  33.  
  34. * - Cas symetrique
  35. IF(IANTI.eq.0) THEN
  36. do iel=1,ire3
  37.  
  38.  
  39.  
  40. do i=1,mdim,ninc
  41. do jr=1,mdim
  42. redj=abs(re(jr,jr,iel))
  43. do ir=i,min(jr-1,i+ninc-1)
  44. re1=re(ir,jr,iel)
  45. re2=re(jr,ir,iel)
  46. redi=abs(re(ir,ir,iel))
  47. xn=abs(re1-re2)
  48. xd=abs((re1+re2) / 2.D0)+xzref
  49. xd=max(xd,redi,redj)
  50. if (xn.gt.xd*xzprla) then
  51. c MOTERR=' '
  52. c MOTERR(1:10)='SYMETRIQUE'
  53. MOTERR='SYMETRIQUE'
  54. reaerr(1)=re1
  55. reaerr(2)=re2
  56. reaerr(3)=xn
  57. call erreur(1044)
  58. return
  59. endif
  60. enddo
  61. enddo
  62. enddo
  63. enddo
  64.  
  65. * - Cas anti-symetrique (on change les signes)
  66. ELSEIF(IANTI.eq.1) THEN
  67. do iel=1,ire3
  68. do i=1,mdim,ninc
  69. do jr=1,mdim
  70. do ir=i,min(jr-1,i+ninc-1)
  71. re1=re(ir,jr,iel)
  72. re2=re(jr,ir,iel)
  73. xn=abs(re1+re2)
  74. xd=abs((re1-re2) / 2.D0)+xzref
  75. if (xn.gt.xd*xzprla) then
  76. c MOTERR=' '
  77. c MOTERR(1:15)='ANTI-SYMETRIQUE'
  78. MOTERR='ANTI-SYMETRIQUE'
  79. reaerr(1)=re1
  80. reaerr(2)=re2
  81. reaerr(3)=xn
  82. call erreur(1044)
  83. return
  84. endif
  85. enddo
  86. enddo
  87. enddo
  88. c verif diagonale nulle
  89. do ir=1,mdim
  90. re1=re(ir,ir,iel)
  91. if (abs(re1).gt.xzref) then
  92. c MOTERR=' '
  93. c MOTERR(1:15)='ANTI-SYMETRIQUE'
  94. MOTERR='ANTI-SYMETRIQUE'
  95. reaerr(1)=re1
  96. reaerr(2)=0.D0
  97. reaerr(3)=abs(re1)
  98. call erreur(1044)
  99. return
  100. endif
  101. enddo
  102. enddo
  103. ENDIF
  104.  
  105. END
  106.  
  107.  
  108.  
  109.  

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