1 : C FUSOLU SOURCE CHAT 05/01/13 00:13:02 5004 2 : SUBROUTINE FUSOLU(MSO1,MSO2,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C REUNION DE 2 OBJETS SOLUTION DE MEME TYPE. OPTION VALABLE ACTUELLEMENT 7 : C POUR LES MODES ET LES SOLUTIONS STATIQUES ET LES PSEUDO MODES. 8 : C LES CHPOINTS DE DEPLACEMENT (QUAND IL Y EN A) DOIVENT S APPUYER SUR 9 : C LES MEMES POINTS MUNIS DES MEMES COMPOSANTES. LA VERIF EST FAITE 10 : C DANS COCHPO 11 : C SI 2 INDICES SONT IDENTIQUES ON N EN CONSERVE QU UN. 12 : C 13 : C ECRIT PAR FARVACQUE 14 : C APPELE PAR PRFUSE 15 : C APPELLE COCHPO,ERREUR(82,83) 16 : C======================================================================= 17 : -INC CCOPTIO 18 : -INC SMSOLUT 19 : -INC SMELEME 20 : SEGMENT ITRAV(NNN2) 21 : C 22 : SEGACT MSO1,MSO2 23 : IF(MSO1.ITYSOL.NE.MSO2.ITYSOL) GOTO 1000 24 : NIPO=MSO1.MSOLIS(/1) 25 : IF(MSO1.ITYSOL.NE.'MODE ') GOTO 1 26 : ITY=1 27 : GOTO 20 28 : 1 IF(MSO1.ITYSOL.NE.'SOLUSTAT'.AND. 29 : C MSO1.ITYSOL.NE.'PSEUMODE') GOTO 2 30 : ITY=2 31 : GOTO 20 32 : 2 CONTINUE 33 : 1001 CONTINUE 34 : MOTERR(1:8)=MSO1.ITYSOL 34 : CALL ERREUR(82) 35 : GOTO 5000 36 : C OPERATION NON PROGRAMMEE POUR CE TYPE DE SOLUTION 37 : C 38 : 20 CONTINUE 39 : SEGINI MSOLUT 40 : IRET=MSOLUT 41 : ITYSOL=MSO1.ITYSOL 42 : DO 40 I=1,NIPO 43 : MSOLIS(I)=0 44 : MSOLIT(I)=0 45 : 40 CONTINUE 46 : GOTO (21,21),ITY 47 : C *********** OPERATION SUR LES MODES ET LES SOLUSTAT **************** 48 : 21 CONTINUE 49 : MSOLEN=MSO1.MSOLIS(4) 50 : SEGACT MSOLEN 51 : MMODE=ISOLEN(1) 52 : SEGACT MMODE 53 : IP1=IMMODD(3) 54 : SEGDES MMODE,MSOLEN 55 : MSOLEN=MSO2.MSOLIS(4) 56 : SEGACT MSOLEN 57 : MMODE=ISOLEN(1) 58 : SEGACT MMODE 59 : IP2=IMMODD(3) 60 : SEGDES MMODE,MSOLEN 61 : IF(IP2.NE.IP1) GOTO 1000 62 : C IF(IP2.EQ.3) GOTO 1001 63 : IPT1=MSO1.MSOLIS(3) 64 : IPT2=MSO2.MSOLIS(3) 65 : SEGACT IPT1,IPT2 66 : NNN1=IPT1.NUM(/2) 67 : NNN2=IPT2.NUM(/2) 68 : SEGINI ITRAV 69 : IMEL=0 70 : DO 22 I2=1,NNN2 71 : IPOIN=IPT2.NUM(1,I2) 72 : DO 23 I1=1,NNN1 73 : IF(IPOIN.NE.IPT1.NUM(1,I2)) GOTO 23 74 : GOTO 22 75 : 23 CONTINUE 76 : IMEL=IMEL+1 77 : ITRAV(IMEL)=I2 78 : 22 CONTINUE 79 : C 80 : NBSOUS=0 81 : NBREF=0 82 : NBNN=1 83 : NBELEM=NNN1+IMEL 84 : SEGINI MELEME 85 : ITYPEL=1 86 : DO 24 I1=1,NNN1 87 : NUM(1,I1)=IPT1.NUM(1,I1) 88 : 24 CONTINUE 89 : DO 25 I1=1,IMEL 90 : NUM(1,NNN1+I1)=IPT2.NUM(1,ITRAV(I1)) 91 : 25 CONTINUE 92 : SEGDES IPT1,IPT2,MELEME 93 : MSOLIS(3)=MELEME 94 : N=NBELEM 95 : GOTO 200 96 : C 97 : C ***** POUR TOUS LES TYPES DE SOLUTION ************* 98 : C 99 : 200 CONTINUE 100 : DO 127 I=4,NIPO 101 : MSOLE1=MSO1.MSOLIS(I) 102 : MSOLE2=MSO2.MSOLIS(I) 103 : IF(MSOLE1.EQ.0.AND.MSOLE2.EQ.0) GOTO 127 104 : SEGINI MSOLEN 105 : IBO=MSOLEN 106 : IF(MSOLE1.EQ.0)GOTO 110 107 : SEGACT MSOLE1 108 : DO 129 I1=1,NNN1 109 : ISOLEN(I1)=MSOLE1.ISOLEN(I1) 110 : 129 CONTINUE 111 : IF(MSOLE2.EQ.0) GOTO 111 112 : C 113 : C **** ON VERIFIE QUE LES CHPOINTS CONTENUS DANS LES MSOLEN ONT BIEN 114 : C **** DES FORMES IDENTIQUES 115 : C 116 : IF(MSO1.MSOLIT(I).NE.2) GOTO 6 117 : DO 60 I1=1,NNN1 118 : IF(MSOLE1.ISOLEN(I1).EQ.0) GOTO 60 119 : II1=MSOLE1.ISOLEN(I1) 120 : GOTO 61 121 : 60 CONTINUE 122 : 61 CONTINUE 123 : SEGACT MSOLE2 124 : DO 62 I2=1,NNN2 125 : IF(MSOLE2.ISOLEN(I2).EQ.0) GOTO 62 126 : II2=MSOLE2.ISOLEN(I2) 127 : GOTO 63 128 : 62 CONTINUE 129 : 63 ITAI=MSOLE2 129 : CALL COCHPO(II1,II2,ITAI,ITAF) 130 : IF(IERR.NE.0) GOTO 5000 131 : MSOLEN=IBO 132 : MSOLE2=ITAF 133 : C 134 : 6 CONTINUE 135 : SEGACT MSOLEN*MOD 136 : SEGACT MSOLE2 137 : DO 126 I2=1,IMEL 138 : ISOLEN(NNN1+I2)=MSOLE2.ISOLEN(ITRAV(I2)) 139 : 126 CONTINUE 140 : GOTO 132 141 : C 142 : 111 CONTINUE 143 : DO 128 I2=1,IMEL 144 : ISOLEN(NNN1+I2)=0 145 : 128 CONTINUE 146 : GOTO 132 147 : C 148 : 110 CONTINUE 149 : SEGACT MSOLE2 150 : DO 130 I1=1,NNN1 151 : ISOLEN(I1)=0 152 : 130 CONTINUE 153 : DO 131 I2=1,IMEL 154 : ISOLEN(NNN1+I2)=MSOLE2.ISOLEN(ITRAV(I2)) 155 : 131 CONTINUE 156 : 132 MSOLIS(I)=MSOLEN 157 : SEGDES MSOLE1 158 : SEGDES MSOLE2 159 : SEGDES MSOLEN 160 : IF(MSO1.MSOLIT(I).NE.0) THEN 161 : MSOLIT(I)=MSO1.MSOLIT(I) 162 : ELSE 163 : MSOLIT(I)=MSO2.MSOLIT(I) 164 : ENDIF 165 : 127 CONTINUE 166 : C 167 : SEGSUP ITRAV 168 : SEGDES MSOLUT 169 : GOTO 5000 170 : 1000 CONTINUE 171 : MOTERR(1:8)='SOLUTION' 171 : CALL ERREUR(83) 172 : C LES 2 OBJETS DOIVENT ETRE DE MEME TYPE 173 : 5000 CONTINUE 174 : SEGDES MSO1,MSO2 175 : RETURN 176 : END 177 : 178 :
© Cast3M 2003 - All rights reserved.
Disclaimer