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.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC CCREEL
  40. POINTEUR AMORS.PMORS
  41. POINTEUR AISA.IZA
  42. POINTEUR NORMP.IZA
  43. POINTEUR NORMD.IZA
  44. *
  45. INTEGER IMPR,IRET
  46. *
  47. * Executable statements
  48. *
  49. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans normat.eso'
  50. SEGACT AMORS
  51. SEGACT AISA
  52. NTTDDL=AMORS.IA(/1)-1
  53. NBVA=NTTDDL
  54. SEGINI NORMP
  55. SEGINI NORMD
  56. DO ITTDDL=1,NTTDDL
  57. JSTRT=AMORS.IA(ITTDDL)
  58. JSTOP=AMORS.IA(ITTDDL+1)-1
  59. DO J=JSTRT,JSTOP
  60. JTTDDL=AMORS.JA(J)
  61. VAL=AISA.A(J)
  62. IF (ISCAL.EQ.1) THEN
  63. VAL2=VAL*VAL
  64. ELSEIF (ISCAL.EQ.2) THEN
  65. VAL2=ABS(VAL)
  66. ELSE
  67. CALL ERREUR(5)
  68. GOTO 9999
  69. ENDIF
  70. NORMP.A(JTTDDL)=
  71. $ NORMP.A(JTTDDL)+VAL2
  72. NORMD.A(ITTDDL)=
  73. $ NORMD.A(ITTDDL)+VAL2
  74. ENDDO
  75. ENDDO
  76. SEGDES AISA
  77. SEGDES AMORS
  78. * Racine carrée
  79. IF (ISCAL.EQ.1) THEN
  80. DO ITTDDL=1,NTTDDL
  81. NORMP.A(ITTDDL)=
  82. $ SQRT(NORMP.A(ITTDDL))
  83. NORMD.A(ITTDDL)=
  84. $ SQRT(NORMD.A(ITTDDL))
  85. ENDDO
  86. ENDIF
  87. * Teste si une ligne ou une colonne de la matrice est nulle
  88. DO ITTDDL=1,NTTDDL
  89. VAL=NORMP.A(ITTDDL)
  90. IF(VAL.LE.SQRT(XPETIT)) THEN
  91. WRITE(IOIMP,*) 'La colonne ',ITTDDL,
  92. $ ' de la matrice est nulle : ', VAL
  93. GOTO 9999
  94. ENDIF
  95. ENDDO
  96. DO ITTDDL=1,NTTDDL
  97. VAL=NORMD.A(ITTDDL)
  98. IF(VAL.LE.SQRT(XPETIT)) THEN
  99. WRITE(IOIMP,*) 'La ligne ',ITTDDL,
  100. $ ' de la matrice est nulle : ', VAL
  101. GOTO 9999
  102. ENDIF
  103. ENDDO
  104. IF (IMPR.EQ.2) THEN
  105. WRITE(IOIMP,*) 'Scaling de la matrice'
  106. ELSEIF (IMPR.GE.3) THEN
  107. VMIP=NORMP.A(1)
  108. VMAP=NORMP.A(1)
  109. DO ITTDDL=2,NTTDDL
  110. VAL=NORMP.A(ITTDDL)
  111. VMIP=MIN(VMIP,VAL)
  112. VMAP=MAX(VMAP,VAL)
  113. ENDDO
  114. VMID=NORMD.A(1)
  115. VMAD=NORMD.A(1)
  116. DO ITTDDL=2,NTTDDL
  117. VAL=NORMD.A(ITTDDL)
  118. VMID=MIN(VMID,VAL)
  119. VMAD=MAX(VMAD,VAL)
  120. ENDDO
  121. WRITE(IOIMP,11) ' Scaling de la matrice : col(pri) min=',
  122. $ VMIP,' max=',VMAP
  123. WRITE(IOIMP,11) ' lig(dua) min=',
  124. $ VMID,' max=',VMAD
  125. ENDIF
  126. SEGDES NORMP
  127. SEGDES NORMD
  128. *
  129. * Normal termination
  130. *
  131. IRET=0
  132. RETURN
  133. *
  134. * Format handling
  135. *
  136. 11 FORMAT (A,D9.2,A,D9.2)
  137. *
  138. * Error handling
  139. *
  140. 9999 CONTINUE
  141. IRET=1
  142. WRITE(IOIMP,*) 'An error was detected in subroutine normat'
  143. RETURN
  144. *
  145. * End of subroutine NORMAT
  146. *
  147. END
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  

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