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