Télécharger dedu3.eso

Retour à la liste

Numérotation des lignes :

  1. C DEDU3 SOURCE PV 11/03/08 21:15:19 6888
  2. C
  3. SUBROUTINE DEDU3(IPCHPO,XERR1)
  4. ************************************************************************
  5. *
  6. * DEDU3
  7. *
  8. *
  9. * FONCTION:
  10. * -appelé par PROPER.eso
  11. * -TESTE SI UN CHPOINT DE TRANSFORMATION U REPRESENTE UNE TRANSLATION
  12. * -calcule l'ecart relatif à une translation :
  13. * XERR1 = | max_x(IPOIN1(x)) - min_x(IPOIN1(x)) |_relatif
  14. *
  15. * CREATION,MODIFICATION:
  16. * - creation : 07/2009 (BP)
  17. *
  18. ************************************************************************
  19. *
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8 (A-H,O-Z)
  22. -INC CCOPTIO
  23. -INC SMCHPOI
  24. -INC SMELEME
  25. -INC SMCOORD
  26. *
  27. *
  28. ***** INITIALISATIONS **************************************************
  29. *
  30. * -ERREUR RELATIVE, LONGUEUR CARACTERISTIQUE
  31. XERR1 = 0.D0
  32. XREF1 = 0.D0
  33.  
  34. * -ACTIVATION DU CHPOINT DE TRANSFORMATION
  35. MCHPOI = IPCHPO
  36. SEGACT,MCHPOI
  37. NSOUPO = IPCHP(/1)
  38. *
  39. *
  40. ***** RECHERCHE DU MAXIMUM par ZONE ************************************
  41.  
  42. *-----boucle sur les zones du chpoint
  43. DO 100 IB100=1,NSOUPO
  44. *
  45. * -sous-chpoint
  46. MSOUPO = IPCHP(IB100)
  47. SEGACT,MSOUPO
  48.  
  49. * -ouverture du mpoval
  50. NC = NOCOMP(/2)
  51. MPOVAL = IPOVAL
  52. SEGACT,MPOVAL
  53.  
  54. * -creation de mpova1 contenant le maxi et le mini
  55. N = 2
  56. segini,mpova1
  57. IDEB = 0
  58.  
  59. * -ouverture du meleme pour avoir une distance de reference XREF100
  60. XREF100 = 0.D0
  61. IPT3 = IGEOC
  62. segact,IPT3
  63. N3 = IPT3.NUM(/2)
  64.  
  65. *--------boucle sur les points
  66. N = VPOCHA(/1)
  67. * write(6,*) 'N3=N?',N3,N
  68. if (N.gt.0) then
  69. DO 110 IB110=1,N
  70.  
  71. *----------1ere rencontre avec boucle sur les composantes
  72. IF(IDEB.eq.0) THEN
  73. IDEB = 1
  74. * -recup des coordonnées
  75. IP = IPT3.NUM(1,IB110)
  76. X1 = XCOOR((IP-1)*(IDIM+1) +1)
  77. Y1 = XCOOR((IP-1)*(IDIM+1) +2)
  78. XMAX1 = X1
  79. XMIN1 = X1
  80. YMAX1 = Y1
  81. YMIN1 = Y1
  82. if(IDIM.EQ.3) then
  83. Z1 = XCOOR((IP-1)*(IDIM+1) +3)
  84. ZMAX1 = Z1
  85. ZMIN1 = Z1
  86. endif
  87. * -boucle sur les composantes
  88. DO 120 IB120=1,NC
  89. XVAL = VPOCHA(IB110,IB120)
  90. mpova1.VPOCHA(1,IB120) = XVAL
  91. mpova1.VPOCHA(2,IB120) = XVAL
  92. 120 CONTINUE
  93. goto 110
  94. ENDIF
  95.  
  96. *----------recup des coordonnées
  97. IP = IPT3.NUM(1,IB110)
  98. X1 = XCOOR((IP-1)*(IDIM+1) +1)
  99. Y1 = XCOOR((IP-1)*(IDIM+1) +2)
  100. if(X1.gt.XMAX1) XMAX1 = X1
  101. if(X1.lt.XMIN1) XMIN1 = X1
  102. if(Y1.gt.YMAX1) YMAX1 = Y1
  103. if(Y1.lt.YMIN1) YMIN1 = Y1
  104. if(IDIM.EQ.3) then
  105. Z1 = XCOOR((IP-1)*(IDIM+1) +3)
  106. if(Z1.gt.ZMAX1) ZMAX1 = Z1
  107. if(Z1.lt.ZMIN1) ZMIN1 = Z1
  108. endif
  109.  
  110. *----------boucle sur les composantes
  111. DO 121 IB120=1,NC
  112. XVAL = VPOCHA(IB110,IB120)
  113. * -tests
  114. if(XVAL.gt.(mpova1.VPOCHA(1,IB120)))
  115. $ mpova1.VPOCHA(1,IB120) = XVAL
  116. if(XVAL.lt.(mpova1.VPOCHA(2,IB120)))
  117. $ mpova1.VPOCHA(2,IB120) = XVAL
  118. 121 CONTINUE
  119.  
  120. 110 CONTINUE
  121. *--------fin de boucle sur les points
  122.  
  123. *--------calcul de XREF100
  124. * write(6,*) 'MAX=',XMAX1,YMAX1,ZMAX1
  125. * write(6,*) 'MIN=',XMIN1,YMIN1,ZMIN1
  126. XREF100 = (XMAX1 - XMIN1) + (YMAX1 - YMIN1) + (ZMAX1 - ZMIN1)
  127. XREF100 = XREF100 / N
  128. *--------calcul de la norme XERR100 = |max(U_ib100) - min(U_ib100)|_1
  129. XERR100 = 0.D0
  130. DO 129 IB120=1,NC
  131. UMAX1 = mpova1.VPOCHA(1,IB120)
  132. UMIN1 = mpova1.VPOCHA(2,IB120)
  133. XERR100 = XERR100 + (UMAX1-UMIN1)
  134. 129 CONTINUE
  135. *--------moyenne des zones
  136. XREF1 = XREF1 + XREF100
  137. XERR1 = max(XERR1,XERR100)
  138. * write(6,*) 'XREF100,XERR100 = ',XREF100,XERR100
  139.  
  140. endif
  141. *--------fin deu cas (N.ne.0)
  142.  
  143. *--------quelques desactivations...
  144. segsup,mpova1
  145. segdes,IPT3,MPOVAL,MSOUPO
  146.  
  147. 100 CONTINUE
  148. *-----fin de boucle sur les zones
  149.  
  150.  
  151. ***** ECART RELATIF A UNE TRANSLATION **********************************
  152. *
  153. XREF1 = XREF1 / NSOUPO
  154. XERR1 = XERR1 / XREF1
  155. * write(6,*) '=> XREF1,XERR1 = ',XREF1,XERR1
  156.  
  157.  
  158. RETURN
  159. END
  160.  
  161.  
  162.  
  163.  
  164.  

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