Télécharger nuachl.eso

Retour à la liste

Numérotation des lignes :

  1. C NUACHL SOURCE PV 09/03/12 21:29:51 6325
  2. SUBROUTINE NUACHL(ICHML)
  3. *
  4. * sous-routine de l'operateur nuage pour créer un objet nuage
  5. * à partir d'un champ par élément à composantes réelles.
  6. *
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. *
  10. -INC CCOPTIO
  11. -INC SMNUAGE
  12. -INC SMCHAML
  13. -INC SMELEME
  14. *
  15. * création d'un segment pour pouvoir créer un tableau
  16. *
  17. SEGMENT,ITABLE
  18. CHARACTER*8 COMPOS(N)
  19. INTEGER TABLEA(N1,N)
  20. ENDSEGMENT
  21. *compos(i) : nom de la i-ème composante
  22. *tablea(j,k) :place de la k-ème composante dans le j-ème segment
  23.  
  24. IRETOU = 0
  25. *
  26. * lecture du mchaml
  27. *
  28. MCHELM = ICHML
  29. SEGACT MCHELM
  30. N1 = ICHAML(/1)
  31. *
  32. * création du tableau
  33. *
  34. IF (N1.EQ.0) THEN
  35. NVAR = 0
  36. NCOUP = 0
  37. SEGINI MNUAGE
  38. SEGDES MNUAGE
  39. ENDIF
  40. *
  41. NBCOUP = 0
  42. DO 10 I = 1,N1
  43. MCHAML = ICHAML(I)
  44. SEGACT MCHAML
  45. N2 = NOMCHE(/2)
  46. DO 5 J = 1,N2
  47. * affichage de l'erreur dans le cas où les composantes ne sont pas
  48. * réelles
  49. IF (TYPCHE(J) .NE.'REAL*8') THEN
  50. MOTERR(1:8)=TYPCHE(J)
  51. MOTERR(17:20)=NOMCHE(J)
  52. MOTERR(21:29) = 'ARGUMENT'
  53. DO 7 K = 1,I
  54. MCHAML = ICHAML(K)
  55. SEGDES MCHAML
  56. 7 CONTINUE
  57. SEGDES MCHELM
  58. CALL ERREUR(552)
  59. RETURN
  60. ENDIF
  61. 5 CONTINUE
  62. *
  63. MELEME = IMACHE(I)
  64. SEGACT MELEME
  65. NBCOUP = NBCOUP + NUM(/1)*NUM(/2)
  66. IF (I.EQ.1) THEN
  67. N = N2
  68. SEGINI ITABLE
  69. do 20 j =1,n2
  70. compos(j) = nomche(j)
  71. tablea(i,j) = j
  72. 20 CONTINUE
  73. ELSE
  74. l = n
  75. do 40 k = 1,n2
  76. do 50 j = 1,n
  77. if (tablea(i,j).eq.0) then
  78. if (nomche(k).eq.compos(j)) then
  79. tablea(i,j) = k
  80. goto 40
  81. endif
  82. endif
  83. 50 CONTINUE
  84. l = l+1
  85. n = l
  86. segadj itable
  87. compos(l) = nomche(k)
  88. tablea(i,l) = k
  89. 40 CONTINUE
  90. ENDIF
  91. SEGDES MELEME
  92. SEGDES MCHAML
  93. 10 CONTINUE
  94.  
  95. *
  96. * initialisation de l'objet nuage
  97. *
  98. NVAR = N
  99. SEGINI MNUAGE
  100. DO 60 I =1,NVAR
  101. NUANOM(I) = COMPOS(I)
  102. NUATYP(I) = 'FLOTTANT'
  103. SEGINI NUAVFL
  104. NUAPOI(I)=NUAVFL
  105. 60 CONTINUE
  106. *
  107. * création du n-uplets du nuage
  108. *
  109. * le nuage ne contient que des flottants
  110. * boucle sur les sous zones
  111. IND = 1
  112. DO 70 I = 1,N1
  113. MCHAML = ICHAML(I)
  114. SEGACT MCHAML
  115. MELEME = IMACHE(I)
  116. SEGACT MELEME
  117. nbnn = num(/1)
  118. nbelem = num(/2)
  119. * boucle sur les éléments
  120. do 80 j = 1,nbelem
  121. * boucle sur les points
  122. do 90 k = 1,nbnn
  123. * remplissage du tableau pour chaque composante
  124. DO 100 L = 1,NVAR
  125. NUAVFL = NUAPOI(L)
  126. N3 = TABLEA(I,L)
  127. IF (N3.EQ.0) THEN
  128. NUAFLO(IND) = 0.D0
  129. ELSE
  130. MELVAL = IELVAL(N3)
  131. SEGACT MELVAL
  132. KMIN = MIN(VELCHE(/1),K)
  133. JMIN= MIN(J,VELCHE(/2))
  134. NUAFLO(IND) = VELCHE(KMIN,JMIN)
  135. SEGDES MELVAL
  136. ENDIF
  137. 100 CONTINUE
  138. IND = IND + 1
  139. 90 CONTINUE
  140. 80 CONTINUE
  141. SEGDES MELEME
  142. SEGDES MCHAML
  143. 70 CONTINUE
  144. SEGSUP ITABLE
  145. SEGDES MCHELM
  146. DO 110 I=1,NVAR
  147. NUAVFL=NUAPOI(I)
  148. SEGDES NUAVFL
  149. 110 CONTINUE
  150. SEGDES MNUAGE
  151. *
  152. * ecriture du nuage
  153. *
  154. CALL ECROBJ('NUAGE ',MNUAGE)
  155. END
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  

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