Télécharger alea2.eso

Retour à la liste

Numérotation des lignes :

  1. C ALEA2 SOURCE BP208322 16/11/18 21:15:08 9177
  2. SUBROUTINE ALEA2
  3. & (MELENT,LADIM,XDIR1,XDIR2,XDIR3,ZSIG,CLAMD1,CLAMD2,CLAMD3,VALMOY,
  4. & DELZET,OMMAX)
  5. C
  6. C=======================================================================
  7. C
  8. C Subroutine ALEA2 : génération d'un CHPOINT aléatoire
  9. C
  10. C Appellée par ALEA
  11. C
  12. C---------------------
  13. C Variables internes :
  14. C---------------------
  15. C
  16. C NBEL : nombre d'éléments
  17. C NBPT : nombre de noeuds par éléments
  18. C NBPGAU : nombre de valeurs à stocker par élément
  19. C
  20. C IPTABL : pointeur sur la table domaine, si elle existe
  21. C
  22. C=======================================================================
  23. C
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. REAL*8 ZDIST, VALMOY, OMMAX
  27. C
  28. -INC CCOPTIO
  29. -INC CCREEL
  30. -INC CCGEOME
  31. -INC SMELEME
  32. -INC SMCOORD
  33. -INC SMMODEL
  34. -INC SMCHPOI
  35. -INC SMTABLE
  36. -INC SMINTE
  37.  
  38. C Table des coordonnées des points supports
  39. SEGMENT TABCOR
  40. REAL*8 COR(NBL,3)
  41. ENDSEGMENT
  42.  
  43. C Table des valeurs en ces points
  44. SEGMENT TABVAL
  45. REAL*8 VAL(NBL)
  46. ENDSEGMENT
  47.  
  48. DIMENSION XDIR1(3),XDIR2(3),XDIR3(3)
  49. POINTEUR MELENT.MELEME, MELSUP.MELEME
  50. C
  51. C epsilon servant à différents tests
  52. EPS = 1.D-12
  53.  
  54. * ---------
  55. * 2. On construit les coordonnées des points supports
  56. * on initialise le champ résultat en parallèle (CHPOINT)
  57.  
  58. * On tire du maillage les points supports voulus
  59. * en changeant le maillage en POI1 si ce n'est déjà fait.
  60. MELSUP = MELENT
  61. SEGACT MELENT
  62. IF (MELENT.ITYPEL.NE.1) THEN
  63. CALL CHANGE(MELSUP,1)
  64. ENDIF
  65. SEGDES MELENT
  66. *
  67. * 2a. Construction des coordonnnées des points supports :
  68. *
  69. * MELSUP est un maillage simple de POI1
  70. * Les points existent, et leurs coordonnées sont dans XCOOR.
  71. SEGACT MELSUP
  72. NBL = MELSUP.NUM(/2)
  73. SEGINI TABCOR
  74. DO 9 I=1,NBL
  75. IREF = (IDIM+1) * (MELSUP.NUM(1,I)-1)
  76. DO 11 K=1,IDIM
  77. COR(I,K) = XCOOR(IREF+K)
  78. 11 CONTINUE
  79. 9 CONTINUE
  80. SEGDES MELSUP
  81. *
  82. * 2b. Transformation des coordonnées dans le repère adimensionné
  83. * par la matrice lambda de dimension LADIM.
  84. *
  85. IF (IDIM.EQ.2) THEN
  86. IF (LADIM.EQ.1) THEN
  87. * 2D stat 1D
  88. DO 20 L=1,NBL
  89. XX = COR(L,1)
  90. YY = COR(L,2)
  91. COR(L,1) = ((XX * XDIR1(1)) + (YY * XDIR1(2))) / CLAMD1
  92. 20 CONTINUE
  93. ELSE
  94. * 2D stat 2D
  95. DO 21 L=1,NBL
  96. XX = COR(L,1)
  97. YY = COR(L,2)
  98. COR(L,1) = ((XX * XDIR1(1)) + (YY * XDIR1(2))) / CLAMD1
  99. COR(L,2) = ((XX * XDIR2(1)) + (YY * XDIR2(2))) / CLAMD2
  100. 21 CONTINUE
  101. ENDIF
  102. ELSE
  103. IF (LADIM.EQ.1) THEN
  104. * 3D stat 1D
  105. DO 22 L=1,NBL
  106. XX = COR(L,1)
  107. YY = COR(L,2)
  108. ZZ = COR(L,3)
  109. COR(L,1) = ( (XX * XDIR1(1)) + (YY * XDIR1(2))
  110. & + (ZZ * XDIR1(3)) ) / CLAMD1
  111. 22 CONTINUE
  112. ELSEIF (LADIM.EQ.2) THEN
  113. * 3D stat 2D
  114. DO 23 L=1,NBL
  115. XX = COR(L,1)
  116. YY = COR(L,2)
  117. ZZ = COR(L,3)
  118. COR(L,1) = ( (XX * XDIR1(1)) + (YY * XDIR1(2))
  119. & + (ZZ * XDIR1(3)) ) / CLAMD1
  120. COR(L,2) = ( (XX * XDIR2(1)) + (YY * XDIR2(2))
  121. & + (ZZ * XDIR2(3)) ) / CLAMD2
  122. 23 CONTINUE
  123. ELSE
  124. * 3D stat 3D
  125. DO 24 L=1,NBL
  126. XX = COR(L,1)
  127. YY = COR(L,2)
  128. ZZ = COR(L,3)
  129. COR(L,1) = ( (XX * XDIR1(1)) + (YY * XDIR1(2))
  130. & + (ZZ * XDIR1(3)) ) / CLAMD1
  131. COR(L,2) = ( (XX * XDIR2(1)) + (YY * XDIR2(2))
  132. & + (ZZ * XDIR2(3)) ) / CLAMD2
  133. COR(L,3) = ( (XX * XDIR3(1)) + (YY * XDIR3(2))
  134. & + (ZZ * XDIR3(3)) ) / CLAMD3
  135. 24 CONTINUE
  136. ENDIF
  137. ENDIF
  138.  
  139. * 2c. En-tête du CHPO (Diffus, comp. 'SCAL')
  140. NAT = 1
  141. NSOUPO = 1
  142. SEGINI MCHPOI
  143. MTYPOI = ' '
  144. MOCHDE = 'Champ-point cree par l operateur ALEA'
  145. JATTRI(1) = 1
  146. IFOPOI = IFOUR
  147. NC = 1
  148. SEGINI MSOUPO
  149. IPCHP(1) = MSOUPO
  150. NOCOMP(1) = 'SCAL'
  151. * NOCONS(1) = pas de nom de constituant
  152. IGEOC = MELSUP
  153. NOHARM(1) = NIFOUR
  154. N = NBL
  155. SEGINI MPOVAL
  156. IPOVAL = MPOVAL
  157.  
  158. * ---------
  159. * 3. Génération aléatoire :
  160. *
  161. CALL BANTOU(TABCOR,TABVAL,LADIM,ZSIG,VALMOY,DELZET,OMMAX)
  162. SEGDES TABCOR
  163. *
  164. * ---------
  165. * 4. Construction champ résultat :
  166. *
  167. * BANTOU renvoie le résultat sous la forme d'une table de valeur,
  168. * TABVAL active, que l'on doit maintenant convertir en MPOVAL.
  169. DO 2 IEL=1,NBL
  170. VPOCHA(IEL,1) = VAL(IEL)
  171. 2 CONTINUE
  172.  
  173. SEGDES MPOVAL,MSOUPO,MCHPOI
  174. SEGSUP TABVAL
  175.  
  176. * ---------
  177. * 5. Ecriture en sortie
  178. *
  179. CALL ECROBJ('CHPOINT ',MCHPOI)
  180.  
  181. RETURN
  182. END
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  

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