Télécharger normat.eso

Retour à la liste

Numérotation des lignes :

  1. C NORMAT SOURCE PV 16/11/17 22:00:54 9180
  2. SUBROUTINE NORMAT(AMORS,AISA,ISCAL,
  3. $ NORMP,NORMD,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : NORMAT
  9. C DESCRIPTION :
  10. C
  11. C Calcul des normes primales (colonnes) et duales (lignes)
  12. C de la matrice.
  13. C
  14. C
  15. C
  16. C LANGAGE : ESOPE
  17. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  18. C mél : gounand@semt2.smts.cea.fr
  19. C********************************************************
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE :
  22. C ENTREES :
  23. C ENTREES/SORTIES :
  24. C SORTIES :
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION : v1, 26/04/2003, version initiale
  28. C HISTORIQUE : v1, 26/04/2003, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36. -INC CCOPTIO
  37. -INC CCREEL
  38. POINTEUR AMORS.PMORS
  39. POINTEUR AISA.IZA
  40. POINTEUR NORMP.IZA
  41. POINTEUR NORMD.IZA
  42. *
  43. INTEGER IMPR,IRET
  44. *
  45. * Executable statements
  46. *
  47. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans normat.eso'
  48. SEGACT AMORS
  49. SEGACT AISA
  50. NTTDDL=AMORS.IA(/1)-1
  51. NBVA=NTTDDL
  52. SEGINI NORMP
  53. SEGINI NORMD
  54. DO ITTDDL=1,NTTDDL
  55. JSTRT=AMORS.IA(ITTDDL)
  56. JSTOP=AMORS.IA(ITTDDL+1)-1
  57. DO J=JSTRT,JSTOP
  58. JTTDDL=AMORS.JA(J)
  59. VAL=AISA.A(J)
  60. IF (ISCAL.EQ.1) THEN
  61. VAL2=VAL*VAL
  62. ELSEIF (ISCAL.EQ.2) THEN
  63. VAL2=ABS(VAL)
  64. ELSE
  65. CALL ERREUR(5)
  66. GOTO 9999
  67. ENDIF
  68. NORMP.A(JTTDDL)=
  69. $ NORMP.A(JTTDDL)+VAL2
  70. NORMD.A(ITTDDL)=
  71. $ NORMD.A(ITTDDL)+VAL2
  72. ENDDO
  73. ENDDO
  74. SEGDES AISA
  75. SEGDES AMORS
  76. * Racine carrée
  77. IF (ISCAL.EQ.1) THEN
  78. DO ITTDDL=1,NTTDDL
  79. NORMP.A(ITTDDL)=
  80. $ SQRT(NORMP.A(ITTDDL))
  81. NORMD.A(ITTDDL)=
  82. $ SQRT(NORMD.A(ITTDDL))
  83. ENDDO
  84. ENDIF
  85. * Teste si une ligne ou une colonne de la matrice est nulle
  86. DO ITTDDL=1,NTTDDL
  87. VAL=NORMP.A(ITTDDL)
  88. IF(VAL.LE.SQRT(XPETIT)) THEN
  89. WRITE(IOIMP,*) 'La colonne ',ITTDDL,
  90. $ ' de la matrice est nulle : ', VAL
  91. GOTO 9999
  92. ENDIF
  93. ENDDO
  94. DO ITTDDL=1,NTTDDL
  95. VAL=NORMD.A(ITTDDL)
  96. IF(VAL.LE.SQRT(XPETIT)) THEN
  97. WRITE(IOIMP,*) 'La ligne ',ITTDDL,
  98. $ ' de la matrice est nulle : ', VAL
  99. GOTO 9999
  100. ENDIF
  101. ENDDO
  102. IF (IMPR.EQ.2) THEN
  103. WRITE(IOIMP,*) 'Scaling de la matrice'
  104. ELSEIF (IMPR.GE.3) THEN
  105. VMIP=NORMP.A(1)
  106. VMAP=NORMP.A(1)
  107. DO ITTDDL=2,NTTDDL
  108. VAL=NORMP.A(ITTDDL)
  109. VMIP=MIN(VMIP,VAL)
  110. VMAP=MAX(VMAP,VAL)
  111. ENDDO
  112. VMID=NORMD.A(1)
  113. VMAD=NORMD.A(1)
  114. DO ITTDDL=2,NTTDDL
  115. VAL=NORMD.A(ITTDDL)
  116. VMID=MIN(VMID,VAL)
  117. VMAD=MAX(VMAD,VAL)
  118. ENDDO
  119. WRITE(IOIMP,11) ' Scaling de la matrice : col(pri) min=',
  120. $ VMIP,' max=',VMAP
  121. WRITE(IOIMP,11) ' lig(dua) min=',
  122. $ VMID,' max=',VMAD
  123. ENDIF
  124. SEGDES NORMP
  125. SEGDES NORMD
  126. *
  127. * Normal termination
  128. *
  129. IRET=0
  130. RETURN
  131. *
  132. * Format handling
  133. *
  134. 11 FORMAT (A,D9.2,A,D9.2)
  135. *
  136. * Error handling
  137. *
  138. 9999 CONTINUE
  139. IRET=1
  140. WRITE(IOIMP,*) 'An error was detected in subroutine normat'
  141. RETURN
  142. *
  143. * End of subroutine NORMAT
  144. *
  145. END
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  

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