1 : C ECSOLU SOURCE PV 11/03/08 21:15:31 6888 2 : SUBROUTINE ECSOLU(IRET,jentet) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : CHARACTER*8 MOSINU(2) 6 : CHARACTER*19 MROTA , MROTP 7 : CHARACTER*24 MROTS 8 : CHARACTER*22 MTRAN , MTRAP 9 : CHARACTER*27 MTRAS 10 : CHARACTER*1 CHAR 11 : LOGICAL LOGIN, LOGRE 12 : C======================================================================= 13 : C ECRITURE D UN OBJET SOLUTION . 14 : C ITY : 1 MODE 2 SOLUSTAT 3 DYNAMIQU 15 : C 16 : C ECRIT PAR FARVACQUE 17 : C APPELLE ECCHPO,PRCHEL 18 : C======================================================================= 19 : -INC CCOPTIO 20 : -INC SMELEME 21 : -INC SMSOLUT 22 : -INC SMLREEL 23 : DATA MOSINU/'SINUS ','COSINUS '/ 24 : DATA MROTA/'ROTATION D ENSEMBLE'/ 25 : DATA MROTP/'VITESSE DE ROTATION'/ 26 : DATA MROTS/'ACCELERATION DE ROTATION'/ 27 : DATA MTRAN/'TRANSLATION D ENSEMBLE'/ 28 : DATA MTRAP/'VITESSE DE TRANSLATION'/ 29 : DATA MTRAS/'ACCELERATION DE TRANSLATION'/ 30 : C 31 : MSOLUT=IRET 32 : SEGACT MSOLUT 33 : INTERR(1)=MSOLUT 34 : NSOLUT=MSOLIS(/1) 35 : IF(NSOLUT.EQ.0) THEN 35 : CALL ERREUR(-71) 36 : RETURN 37 : ENDIF 38 : IF(ITYSOL.NE.'MODE ') GOTO 1 39 : ITY=1 40 : MELEME=MSOLIS(3) 41 : SEGACT MELEME 42 : NNN=NUM(/2) 43 : SEGDES MELEME 44 : INTERR(2)=NNN 44 : CALL ERREUR(-72) 45 : GOTO 30 46 : 1 IF(ITYSOL.NE.'SOLUSTAT'.AND.ITYSOL.NE.'PSEUMODE')GOTO 2 47 : ITY=2 48 : MELEME=MSOLIS(3) 49 : SEGACT MELEME 50 : NNN=NUM(/2) 51 : SEGDES MELEME 52 : INTERR(2)=NNN 52 : IF(ITYSOL.EQ.'SOLUSTAT') CALL ERREUR(-73) 52 : IF(ITYSOL.EQ.'PSEUMODE') CALL ERREUR(-74) 53 : GOTO 30 54 : 2 IF(ITYSOL.NE.'DYNAMIQU')GOTO 3 55 : ITY=3 56 : MSOLRE=MSOLIS(1) 57 : SEGACT MSOLRE 58 : NNN=SOLRE(/1) 59 : INTERR(2)=NNN 59 : CALL ERREUR(-75) 60 : GOTO 30 61 : 3 CONTINUE 62 : 30 CONTINUE 63 : C 64 : C 65 : GOTO (1100,1200,1300),ITY 66 : C 67 : C ************ MODES ****************************************** 68 : 1100 CONTINUE 69 : IBO=MSOLUT 69 : CALL ECMODE(IBO) 70 : MSOLUT=IBO 71 : SEGACT MSOLUT 72 : DO 1101 INNN=1,NNN 73 : INTERR(1)=INNN 73 : CALL ERREUR(-76) 74 : DO 1102 IS=4,NSOLUT 75 : IF(MSOLIS(IS).EQ.0) GOTO 1102 76 : MSOLEN=MSOLIS(IS) 77 : IF(INNN.EQ.1) SEGACT MSOLEN 78 : II=ISOLEN(INNN) 79 : IF(II.EQ.0) GOTO 1150 80 : GOTO(1150,1150,1150,1106,1103,1104,1105,1150,1150,1150),IS 81 : 1106 CONTINUE 82 : MMODE=II 83 : SEGACT MMODE 84 : REAERR(1)=FMMODD(1) 85 : REAERR(2)=FMMODD(2) 86 : REAERR(3)=FMMODD(3) 87 : REAERR(4)=FMMODD(4) 88 : REAERR(5)=FMMODD(5) 89 : INTERR(1)=IMMODD(1) 90 : IF(IMMODD(3).NE.0) INTERR(2)=IMMODD(2) 91 : IF(IMMODD(3).EQ.0) THEN 91 : CALL ERREUR(-77) 92 : ELSE 93 : IF(IMMODD(2).NE.0) THEN 94 : MOTERR(1:8)=MOSINU(IMMODD(3)) 95 : ELSE 96 : MOTERR(1:8)= ' ' 97 : ENDIF 97 : CALL ERREUR(-78) 98 : ENDIF 99 : SEGDES MMODE 100 : GOTO 1150 101 : 1103 CONTINUE 101 : CALL ERREUR(-79) 101 : CALL ECCHPO(II,jentet) 102 : GOTO 1150 103 : 1104 CONTINUE 103 : CALL ERREUR(-80) 103 : * CALL PRCHEL(II,jentet) 104 : GOTO 1150 105 : 1105 CONTINUE 105 : CALL ERREUR(-81) 105 : * CALL PRCHEL(II,jentet) 106 : GOTO 1150 107 : 1150 CONTINUE 108 : IF(INNN.EQ.NNN) SEGDES MSOLEN 109 : 1102 CONTINUE 110 : 1101 CONTINUE 111 : GOTO 2000 112 : C 113 : C 114 : C *************************** SOLUTIONS STATIQUES ********************** 115 : 1200 CONTINUE 116 : DO 1201 INNN=1,NNN 117 : INTERR(1)=INNN 117 : IF(ITYSOL.EQ.'SOLUSTAT') CALL ERREUR(-82) 117 : IF(ITYSOL.EQ.'PSEUMODE') CALL ERREUR(-83) 118 : IF(MSOLIS(10).EQ.0) GOTO 1206 119 : MSOLEN=MSOLIS(10) 120 : IF(INNN.EQ.1) SEGACT MSOLEN 121 : II=ISOLEN(INNN) 122 : IF(INNN.EQ.NNN) SEGDES MSOLEN 123 : IF(II.EQ.0) GOTO 1206 124 : INTERR(1)=II 124 : CALL ERREUR(-84) 125 : 1206 NSOLU1=NSOLUT-1 126 : DO 1202 IS=4,NSOLU1 127 : IF(MSOLIS(IS).EQ.0) GOTO 1202 128 : MSOLEN=MSOLIS(IS) 129 : IF(INNN.EQ.1) SEGACT MSOLEN 130 : II=ISOLEN(INNN) 131 : IF(II.EQ.0) GOTO 1250 132 : GOTO(1250,1250,1250,1250,1203,1204,1205,1250,1250),IS 133 : 1203 CONTINUE 133 : CALL ERREUR(-79) 133 : CALL ECCHPO(II,jentet) 134 : GOTO 1250 135 : 1204 CONTINUE 135 : CALL ERREUR(-80) 135 : * CALL PRCHEL(II,jentet) 136 : GOTO 1250 137 : 1205 CONTINUE 137 : CALL ERREUR(-81) 137 : * CALL PRCHEL(II,jentet) 138 : GOTO 1250 139 : 1250 CONTINUE 140 : IF(INNN.EQ.NNN) SEGDES MSOLEN 141 : 1202 CONTINUE 142 : 1201 CONTINUE 143 : GOTO 2000 144 : C 145 : C *************************** DYNAMIQUE ******************************** 146 : 1300 CONTINUE 147 : DO 1301 INNN=1,NNN 148 : REAERR(1)=SOLRE(INNN) 148 : CALL ERREUR(-85) 149 : DO 1302 IS=5,NSOLUT 150 : IF(MSOLIS(IS).EQ.0) GOTO 1302 151 : MSOLEN=MSOLIS(IS) 152 : IF(INNN.EQ.1) SEGACT MSOLEN 153 : II=ISOLEN(INNN) 154 : IF(II.EQ.0) GOTO 1350 155 : GOTO (1350,1350,1350,1350,1305,1306,1307,1308,1309,1310, 156 : *1311,1312,1350,1314),IS 157 : 1305 CONTINUE 157 : CALL ERREUR(-79) 157 : CALL ECCHPO(II,jentet) 158 : GOTO 1350 159 : 1306 CONTINUE 159 : CALL ERREUR(-80) 159 : * CALL PRCHEL(II,jentet) 160 : GOTO 1350 161 : 1307 CONTINUE 161 : CALL ERREUR(-81) 161 : * CALL PRCHEL(II,jentet) 162 : GOTO 1350 163 : 1308 CONTINUE 163 : CALL ERREUR(-86) 163 : CALL ECCHPO(II,jentet) 164 : GOTO 1350 165 : 1309 CONTINUE 165 : CALL ERREUR(-87) 165 : CALL ECCHPO(II,jentet) 166 : GOTO 1350 167 : 1310 CONTINUE 167 : CALL ERREUR(-88) 167 : CALL ECCHPO(II,jentet) 168 : GOTO 1350 169 : 1311 CONTINUE 169 : CALL ERREUR(-89) 169 : CALL ECROBJ('TABLE ',II) 169 : CALL INDETA 169 : CALL LIROBJ('TABLE ',LISTIND,1,IRETOU) 170 : I = 1 171 : 333 CONTINUE 172 : IGEO1 = 0 172 : CALL ACCTAB(LISTIND,'ENTIER ',I ,XVA,CHAR,LOGIN,IOBIN, 173 : * 'MAILLAGE',IVAL,XVA,CHAR,LOGRE,IGEO1) 174 : IF(IGEO1.EQ.0) GOTO 444 174 : CALL ACCTAB(II,'MAILLAGE',IVA,XVA,CHAR,LOGIN,IGEO1, 175 : * 'TABLE ',IVA,XVA,CHAR,LOGIN,ITAB1) 175 : CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MROTA,LOGIN,IOBIN, 176 : * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC1) 176 : CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MROTP,LOGIN,IOBIN, 177 : * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC2) 177 : CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MROTS,LOGIN,IOBIN, 178 : * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC3) 178 : CALL ERREUR(-90) 179 : MLREE1 = IVEC1 180 : MLREE2 = IVEC2 181 : MLREE3 = IVEC3 182 : SEGACT MLREE1,MLREE2,MLREE3 183 : DO 1401 I = 1,IDIM 184 : ILIGN = ( I - 1 ) * IDIM + 1 185 : JLIGN = ILIGN + IDIM - 1 186 : WRITE(IOIMP,1402) ( MLREE1.PROG(J) , J = ILIGN,JLIGN) 187 : 1402 FORMAT(2X,F9.6,2X,F9.6,2X,F9.6) 188 : 1401 CONTINUE 188 : CALL ERREUR(-91) 189 : DO 1404 I = 1,IDIM 190 : ILIGN = ( I - 1 ) * IDIM + 1 191 : JLIGN = ILIGN + IDIM - 1 192 : WRITE(IOIMP,1405) ( MLREE2.PROG(J) , J = ILIGN,JLIGN) 193 : 1405 FORMAT(9X,E12.5,2X,E12.5,2X,E12.5) 194 : 1404 CONTINUE 194 : CALL ERREUR(-92) 195 : 1406 FORMAT(35X,A24) 196 : DO 1407 I = 1,IDIM 197 : ILIGN = ( I - 1 ) * IDIM + 1 198 : JLIGN = ILIGN + IDIM - 1 199 : WRITE(IOIMP,1408) ( MLREE3.PROG(J) , J = ILIGN,JLIGN) 200 : 1408 FORMAT(23X,E12.5,2X,E12.5,2X,E12.5) 201 : 1407 CONTINUE 202 : SEGDES MLREE1,MLREE2,MLREE3 203 : I = I + 1 204 : GOTO 333 205 : 444 CONTINUE 206 : GOTO 1350 207 : 1312 CONTINUE 207 : CALL ECROBJ('TABLE ',II) 207 : CALL INDETA 207 : CALL LIROBJ('TABLE ',LISTIND,1,IRETOU) 208 : I = 1 209 : 555 CONTINUE 210 : IGEO1 = 0 210 : CALL ACCTAB(LISTIND,'ENTIER ',I ,XVA,CHAR,LOGIN,IOBIN, 211 : * 'MAILLAGE',IVAL,XVA,CHAR,LOGRE,IGEO1) 212 : IF(IGEO1.EQ.0) GOTO 666 212 : CALL ACCTAB(II,'MAILLAGE',IVA,XVA,CHAR,LOGIN,IGEO1, 213 : * 'TABLE ',IVA,XVA,CHAR,LOGIN,ITAB1) 213 : CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MTRAN,LOGIN,IOBIN, 214 : * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC1) 214 : CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MTRAP,LOGIN,IOBIN, 215 : * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC2) 215 : CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MTRAS,LOGIN,IOBIN, 216 : * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC3) 217 : MLREE1 = IVEC1 218 : MLREE2 = IVEC2 219 : MLREE3 = IVEC3 220 : SEGACT MLREE1,MLREE2,MLREE3 220 : CALL ERREUR(-93) 221 : 1409 FORMAT(/,6X,A22) 222 : WRITE(IOIMP,1410) (MLREE1.PROG(J) , J = 1,IDIM) 223 : 1410 FORMAT(2X,E12.5,2X,E12.5,2X,E12.5) 223 : CALL ERREUR(-94) 224 : 1411 FORMAT(18X,A22) 225 : WRITE(IOIMP,1412) ( MLREE2.PROG(J) , J = ILIGN,JLIGN) 226 : 1412 FORMAT(9X,E12.5,2X,E12.5,2X,E12.5) 226 : CALL ERREUR(-95) 227 : WRITE(IOIMP,1414) ( MLREE3.PROG(J) , J = ILIGN,JLIGN) 228 : 1414 FORMAT(23X,E12.5,2X,E12.5,2X,E12.5) 229 : SEGDES MLREE1,MLREE2,MLREE3 230 : I = I + 1 231 : GOTO 555 232 : 666 CONTINUE 233 : GOTO 1350 234 : 1314 CONTINUE 234 : CALL ERREUR(-96) 234 : CALL PRVECT(II,jentet) 235 : GOTO 1350 236 : 1350 CONTINUE 237 : IF(INNN.EQ.NNN) SEGDES MSOLEN 238 : 1302 CONTINUE 239 : 1301 CONTINUE 240 : SEGDES MSOLRE 241 : GOTO 2000 242 : C 243 : C 244 : 2000 CONTINUE 245 : SEGDES MSOLUT 246 : RETURN 247 : END 248 : 249 : 250 :
© Cast3M 2003 - All rights reserved.
Disclaimer