Télécharger fusnua.eso

Retour à la liste

Numérotation des lignes :

  1. C FUSNUA SOURCE CB215821 15/05/04 21:15:05 8516
  2. SUBROUTINE FUSNUA(IPO1,IPO2,IPO3)
  3. C_____________________________________________________________________
  4. C
  5. C REUNION DE DEUX OBJETS DE TYPE "NUAGE"
  6. C
  7. C Entrees :
  8. C ---------
  9. C IPO1 Pointeur sur le 1 er objet NUAGE
  10. C IPO2 Pointeur sur le 2 eme objet NUAGE
  11. C
  12. C Sortie :
  13. C --------
  14. C IPO3 Pointeur de l'objet NUAGE resultat ( =0 SI ECHEC )
  15. C
  16. C Suo le 05/94
  17. C_____________________________________________________________________
  18. C
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8(A-H,O-Z)
  21. C
  22. -INC CCOPTIO
  23. -INC SMNUAGE
  24. IPO3=0
  25.  
  26. C La dimension des objets NUAGE
  27. CALL DIME10(IPO1,1,NVAR1)
  28. IF (IERR.NE.0) RETURN
  29. CALL DIME10(IPO2,1,NVAR2)
  30. IF (IERR.NE.0) RETURN
  31. CALL DIME10(IPO1,2,NBCO1)
  32. IF (IERR.NE.0) RETURN
  33. CALL DIME10(IPO2,2,NBCO2)
  34. IF (IERR.NE.0) RETURN
  35.  
  36. C On active les deux objets NUAGE
  37. MNUAG1=IPO1
  38. MNUAG2=IPO2
  39. SEGACT,MNUAG1,MNUAG2
  40.  
  41. C On compare les noms et les types des composantes. Comme
  42. C resultats on a II=nombre de composantes communes et JJ=nombre
  43. C de type communs sous le meme nom entre MNUAG1 et MNUAG2
  44. II=0
  45. JJ=0
  46. NVA1 = MNUAG1.NUANOM(/2)
  47. NVA2 = MNUAG2.NUANOM(/2)
  48.  
  49. IF ( (NVA1 * NVA2) .GT. 0 ) THEN
  50. C Les 2 NUAGES ne sont pas VIDES
  51. DO 10 I=1,NVA1
  52. DO 20 J=1,NVA2
  53. IF (MNUAG1.NUANOM(I).EQ.MNUAG2.NUANOM(J)) THEN
  54. II=II+1
  55. IF (MNUAG1.NUATYP(I).EQ.MNUAG2.NUATYP(J))JJ=JJ+1
  56. ENDIF
  57. 20 CONTINUE
  58. 10 CONTINUE
  59.  
  60. ELSE
  61. C Un des 2 NUAGES est VIDES (ou les 2)
  62. IF (NVA1 .GT. 0) THEN
  63. SEGINI,MNUAGE=MNUAG1
  64. ELSE
  65. SEGINI,MNUAGE=MNUAG2
  66. ENDIF
  67. IPO3=MNUAGE
  68. SEGDES,MNUAGE
  69. GOTO 90
  70. ENDIF
  71.  
  72. C Reunion par allongement des objets MNUAG1 et MNUAG2
  73. C si les noms des composantes, les types des composantes
  74. C ainsi que le nombre de variable sont tous les memes
  75. IF (NVAR1.EQ.NVAR2.AND.NVAR1.EQ.II.AND.NVAR1.EQ.JJ)THEN
  76. NVAR=NVAR1
  77. SEGINI,MNUAGE
  78. IPO3=MNUAGE
  79. NBCOUP=NBCO1+NBCO2
  80. DO 30 I=1,NVAR1
  81. NUANOM(I)=MNUAG1.NUANOM(I)
  82. NUATYP(I)=MNUAG1.NUATYP(I)
  83.  
  84. C Composante de type FLOTTANT
  85. IF (MNUAG1.NUATYP(I).EQ.'FLOTTANT') THEN
  86. NUAVF1=MNUAG1.NUAPOI(I)
  87. SEGACT,NUAVF1
  88. SEGINI,NUAVFL
  89. NUAPOI(I)=NUAVFL
  90. DO 100 J=1,NVAR1
  91. IF (MNUAG1.NUANOM(I).EQ.MNUAG2.NUANOM(J)) THEN
  92. NUAVF2=MNUAG2.NUAPOI(J)
  93. GOTO 110
  94. ENDIF
  95. 100 CONTINUE
  96. 110 CONTINUE
  97. SEGACT,NUAVF2
  98. DO 120 K=1,NBCO1
  99. NUAFLO(K)=NUAVF1.NUAFLO(K)
  100. 120 CONTINUE
  101. DO 130 K=1,NBCO2
  102. NUAFLO(NBCO1+K)=NUAVF2.NUAFLO(K)
  103. 130 CONTINUE
  104. SEGDES,NUAVFL,NUAVF1,NUAVF2
  105.  
  106. C Composante de type MOT
  107. ELSEIF (MNUAG1.NUATYP(I).EQ.'MOT ') THEN
  108. NUAVM1=MNUAG1.NUAPOI(I)
  109. SEGACT,NUAVM1
  110. SEGINI,NUAVMO
  111. NUAPOI(I)=NUAVMO
  112. DO 200 J=1,NVAR1
  113. IF (MNUAG1.NUANOM(I).EQ.MNUAG2.NUANOM(J)) THEN
  114. NUAVM2=MNUAG2.NUAPOI(J)
  115. GOTO 210
  116. ENDIF
  117. 200 CONTINUE
  118. 210 CONTINUE
  119. SEGACT,NUAVM2
  120. DO 220 K=1,NBCO1
  121. NUAMOT(K)=NUAVM1.NUAMOT(K)
  122. 220 CONTINUE
  123. DO 230 K=1,NBCO2
  124. NUAMOT(NBCO1+K)=NUAVM2.NUAMOT(K)
  125. 230 CONTINUE
  126. SEGDES,NUAVMO,NUAVM1,NUAVM2
  127.  
  128. C Composante de type LOGIQUE
  129. ELSEIF (MNUAG1.NUATYP(I).EQ.'LOGIQUE ') THEN
  130. NUAVL1=MNUAG1.NUAPOI(I)
  131. SEGACT,NUAVL1
  132. SEGINI,NUAVLO
  133. NUAPOI(I)=NUAVLO
  134. DO 300 J=1,NVAR1
  135. IF (MNUAG1.NUANOM(I).EQ.MNUAG2.NUANOM(J)) THEN
  136. NUAVL2=MNUAG2.NUAPOI(J)
  137. GOTO 310
  138. ENDIF
  139. 300 CONTINUE
  140. 310 CONTINUE
  141. SEGACT,NUAVL2
  142. DO 320 K=1,NBCO1
  143. NUALOG(K)=NUAVL1.NUALOG(K)
  144. 320 CONTINUE
  145. DO 330 K=1,NBCO2
  146. NUALOG(NBCO1+K)=NUAVL2.NUALOG(K)
  147. 330 CONTINUE
  148. SEGDES,NUAVLO,NUAVL1,NUAVL2
  149.  
  150. C Composante d'autres types
  151. ELSE
  152. NUAVI1=MNUAG1.NUAPOI(I)
  153. SEGACT,NUAVI1
  154. SEGINI,NUAVIN
  155. NUAPOI(I)=NUAVIN
  156. DO 400 J=1,NVAR1
  157. IF (MNUAG1.NUANOM(I).EQ.MNUAG2.NUANOM(J)) THEN
  158. NUAVI2=MNUAG2.NUAPOI(J)
  159. GOTO 410
  160. ENDIF
  161. 400 CONTINUE
  162. 410 CONTINUE
  163. SEGACT,NUAVI2
  164. DO 420 K=1,NBCO1
  165. NUAINT(K)=NUAVI1.NUAINT(K)
  166. 420 CONTINUE
  167. DO 430 K=1,NBCO2
  168. NUAINT(NBCO1+K)=NUAVI2.NUAINT(K)
  169. 430 CONTINUE
  170. SEGDES,NUAVIN,NUAVI1,NUAVI2
  171. ENDIF
  172. 30 CONTINUE
  173. SEGDES,MNUAGE
  174. GOTO 90
  175. ENDIF
  176.  
  177. C Reunion en ajoutant dans le 1er objet NUAGE toutes les
  178. C composantes du 2eme NUAGE si les deux ne comportent pas
  179. C de noms de composante communs et de plus leur nombre de
  180. C uplets (NBCO1 et NBCO2) est identique
  181. IF (NBCO1.EQ.NBCO2.AND.II.EQ.0) THEN
  182. NVAR=NVAR1+NVAR2
  183. SEGINI,MNUAGE
  184. IPO3=MNUAGE
  185. DO 40 I=1,NVAR1
  186. NUANOM(I)=MNUAG1.NUANOM(I)
  187. NUATYP(I)=MNUAG1.NUATYP(I)
  188. NUAPOI(I)=MNUAG1.NUAPOI(I)
  189. 40 CONTINUE
  190. DO 50 I=1,NVAR2
  191. J=NVAR1+I
  192. NUANOM(J)=MNUAG2.NUANOM(I)
  193. NUATYP(J)=MNUAG2.NUATYP(I)
  194. NUAPOI(J)=MNUAG2.NUAPOI(I)
  195. 50 CONTINUE
  196. SEGDES,MNUAGE
  197. GOTO 90
  198. ENDIF
  199.  
  200. C Message d'erreur
  201. CALL ERREUR(646)
  202. 90 CONTINUE
  203. SEGDES,MNUAG1,MNUAG2
  204. C
  205. RETURN
  206. END
  207.  
  208.  
  209.  

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