Télécharger la plaquette Cast3M


fr en

Télécharger fusnua.eso

Retour à la liste

Numérotation des lignes : 

fusnua

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

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