Télécharger alea2.eso

Retour à la liste

Numérotation des lignes :

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

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