C ECSOLU SOURCE PV 11/03/08 21:15:31 6888 SUBROUTINE ECSOLU(IRET,jentet) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*8 MOSINU(2) CHARACTER*19 MROTA , MROTP CHARACTER*24 MROTS CHARACTER*22 MTRAN , MTRAP CHARACTER*27 MTRAS CHARACTER*1 CHAR LOGICAL LOGIN, LOGRE C======================================================================= C ECRITURE D UN OBJET SOLUTION . C ITY : 1 MODE 2 SOLUSTAT 3 DYNAMIQU C C ECRIT PAR FARVACQUE C APPELLE ECCHPO,PRCHEL C======================================================================= -INC PPARAM -INC CCOPTIO -INC SMELEME -INC SMSOLUT -INC SMLREEL DATA MOSINU/'SINUS ','COSINUS '/ DATA MROTA/'ROTATION D ENSEMBLE'/ DATA MROTP/'VITESSE DE ROTATION'/ DATA MROTS/'ACCELERATION DE ROTATION'/ DATA MTRAN/'TRANSLATION D ENSEMBLE'/ DATA MTRAP/'VITESSE DE TRANSLATION'/ DATA MTRAS/'ACCELERATION DE TRANSLATION'/ C MSOLUT=IRET SEGACT MSOLUT INTERR(1)=MSOLUT NSOLUT=MSOLIS(/1) IF(NSOLUT.EQ.0) THEN CALL ERREUR(-71) RETURN ENDIF IF(ITYSOL.NE.'MODE ') GOTO 1 ITY=1 MELEME=MSOLIS(3) SEGACT MELEME NNN=NUM(/2) SEGDES MELEME INTERR(2)=NNN CALL ERREUR(-72) GOTO 30 1 IF(ITYSOL.NE.'SOLUSTAT'.AND.ITYSOL.NE.'PSEUMODE')GOTO 2 ITY=2 MELEME=MSOLIS(3) SEGACT MELEME NNN=NUM(/2) SEGDES MELEME INTERR(2)=NNN IF(ITYSOL.EQ.'SOLUSTAT') CALL ERREUR(-73) IF(ITYSOL.EQ.'PSEUMODE') CALL ERREUR(-74) GOTO 30 2 IF(ITYSOL.NE.'DYNAMIQU')GOTO 3 ITY=3 MSOLRE=MSOLIS(1) SEGACT MSOLRE NNN=SOLRE(/1) INTERR(2)=NNN CALL ERREUR(-75) GOTO 30 3 CONTINUE 30 CONTINUE C C GOTO (1100,1200,1300),ITY C C ************ MODES ****************************************** 1100 CONTINUE IBO=MSOLUT CALL ECMODE(IBO) MSOLUT=IBO SEGACT MSOLUT DO 1101 INNN=1,NNN INTERR(1)=INNN CALL ERREUR(-76) DO 1102 IS=4,NSOLUT IF(MSOLIS(IS).EQ.0) GOTO 1102 MSOLEN=MSOLIS(IS) IF(INNN.EQ.1) SEGACT MSOLEN II=ISOLEN(INNN) IF(II.EQ.0) GOTO 1150 GOTO(1150,1150,1150,1106,1103,1104,1105,1150,1150,1150),IS 1106 CONTINUE MMODE=II SEGACT MMODE REAERR(1)=FMMODD(1) REAERR(2)=FMMODD(2) REAERR(3)=FMMODD(3) REAERR(4)=FMMODD(4) REAERR(5)=FMMODD(5) INTERR(1)=IMMODD(1) IF(IMMODD(3).NE.0) INTERR(2)=IMMODD(2) IF(IMMODD(3).EQ.0) THEN CALL ERREUR(-77) ELSE IF(IMMODD(2).NE.0) THEN MOTERR(1:8)=MOSINU(IMMODD(3)) ELSE MOTERR(1:8)= ' ' ENDIF CALL ERREUR(-78) ENDIF SEGDES MMODE GOTO 1150 1103 CONTINUE CALL ERREUR(-79) CALL ECCHPO(II,jentet) GOTO 1150 1104 CONTINUE CALL ERREUR(-80) * CALL PRCHEL(II,jentet) GOTO 1150 1105 CONTINUE CALL ERREUR(-81) * CALL PRCHEL(II,jentet) GOTO 1150 1150 CONTINUE IF(INNN.EQ.NNN) SEGDES MSOLEN 1102 CONTINUE 1101 CONTINUE GOTO 2000 C C C *************************** SOLUTIONS STATIQUES ********************** 1200 CONTINUE DO 1201 INNN=1,NNN INTERR(1)=INNN IF(ITYSOL.EQ.'SOLUSTAT') CALL ERREUR(-82) IF(ITYSOL.EQ.'PSEUMODE') CALL ERREUR(-83) IF(MSOLIS(10).EQ.0) GOTO 1206 MSOLEN=MSOLIS(10) IF(INNN.EQ.1) SEGACT MSOLEN II=ISOLEN(INNN) IF(INNN.EQ.NNN) SEGDES MSOLEN IF(II.EQ.0) GOTO 1206 INTERR(1)=II CALL ERREUR(-84) 1206 NSOLU1=NSOLUT-1 DO 1202 IS=4,NSOLU1 IF(MSOLIS(IS).EQ.0) GOTO 1202 MSOLEN=MSOLIS(IS) IF(INNN.EQ.1) SEGACT MSOLEN II=ISOLEN(INNN) IF(II.EQ.0) GOTO 1250 GOTO(1250,1250,1250,1250,1203,1204,1205,1250,1250),IS 1203 CONTINUE CALL ERREUR(-79) CALL ECCHPO(II,jentet) GOTO 1250 1204 CONTINUE CALL ERREUR(-80) * CALL PRCHEL(II,jentet) GOTO 1250 1205 CONTINUE CALL ERREUR(-81) * CALL PRCHEL(II,jentet) GOTO 1250 1250 CONTINUE IF(INNN.EQ.NNN) SEGDES MSOLEN 1202 CONTINUE 1201 CONTINUE GOTO 2000 C C *************************** DYNAMIQUE ******************************** 1300 CONTINUE DO 1301 INNN=1,NNN REAERR(1)=SOLRE(INNN) CALL ERREUR(-85) DO 1302 IS=5,NSOLUT IF(MSOLIS(IS).EQ.0) GOTO 1302 MSOLEN=MSOLIS(IS) IF(INNN.EQ.1) SEGACT MSOLEN II=ISOLEN(INNN) IF(II.EQ.0) GOTO 1350 GOTO (1350,1350,1350,1350,1305,1306,1307,1308,1309,1310, *1311,1312,1350,1314),IS 1305 CONTINUE CALL ERREUR(-79) CALL ECCHPO(II,jentet) GOTO 1350 1306 CONTINUE CALL ERREUR(-80) * CALL PRCHEL(II,jentet) GOTO 1350 1307 CONTINUE CALL ERREUR(-81) * CALL PRCHEL(II,jentet) GOTO 1350 1308 CONTINUE CALL ERREUR(-86) CALL ECCHPO(II,jentet) GOTO 1350 1309 CONTINUE CALL ERREUR(-87) CALL ECCHPO(II,jentet) GOTO 1350 1310 CONTINUE CALL ERREUR(-88) CALL ECCHPO(II,jentet) GOTO 1350 1311 CONTINUE CALL ERREUR(-89) CALL ECROBJ('TABLE ',II) CALL INDETA CALL LIROBJ('TABLE ',LISTIND,1,IRETOU) I = 1 333 CONTINUE IGEO1 = 0 CALL ACCTAB(LISTIND,'ENTIER ',I ,XVA,CHAR,LOGIN,IOBIN, * 'MAILLAGE',IVAL,XVA,CHAR,LOGRE,IGEO1) IF(IGEO1.EQ.0) GOTO 444 CALL ACCTAB(II,'MAILLAGE',IVA,XVA,CHAR,LOGIN,IGEO1, * 'TABLE ',IVA,XVA,CHAR,LOGIN,ITAB1) CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MROTA,LOGIN,IOBIN, * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC1) CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MROTP,LOGIN,IOBIN, * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC2) CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MROTS,LOGIN,IOBIN, * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC3) CALL ERREUR(-90) MLREE1 = IVEC1 MLREE2 = IVEC2 MLREE3 = IVEC3 SEGACT MLREE1,MLREE2,MLREE3 DO 1401 I = 1,IDIM ILIGN = ( I - 1 ) * IDIM + 1 JLIGN = ILIGN + IDIM - 1 WRITE(IOIMP,1402) ( MLREE1.PROG(J) , J = ILIGN,JLIGN) 1402 FORMAT(2X,F9.6,2X,F9.6,2X,F9.6) 1401 CONTINUE CALL ERREUR(-91) DO 1404 I = 1,IDIM ILIGN = ( I - 1 ) * IDIM + 1 JLIGN = ILIGN + IDIM - 1 WRITE(IOIMP,1405) ( MLREE2.PROG(J) , J = ILIGN,JLIGN) 1405 FORMAT(9X,E12.5,2X,E12.5,2X,E12.5) 1404 CONTINUE CALL ERREUR(-92) 1406 FORMAT(35X,A24) DO 1407 I = 1,IDIM ILIGN = ( I - 1 ) * IDIM + 1 JLIGN = ILIGN + IDIM - 1 WRITE(IOIMP,1408) ( MLREE3.PROG(J) , J = ILIGN,JLIGN) 1408 FORMAT(23X,E12.5,2X,E12.5,2X,E12.5) 1407 CONTINUE SEGDES MLREE1,MLREE2,MLREE3 I = I + 1 GOTO 333 444 CONTINUE GOTO 1350 1312 CONTINUE CALL ECROBJ('TABLE ',II) CALL INDETA CALL LIROBJ('TABLE ',LISTIND,1,IRETOU) I = 1 555 CONTINUE IGEO1 = 0 CALL ACCTAB(LISTIND,'ENTIER ',I ,XVA,CHAR,LOGIN,IOBIN, * 'MAILLAGE',IVAL,XVA,CHAR,LOGRE,IGEO1) IF(IGEO1.EQ.0) GOTO 666 CALL ACCTAB(II,'MAILLAGE',IVA,XVA,CHAR,LOGIN,IGEO1, * 'TABLE ',IVA,XVA,CHAR,LOGIN,ITAB1) CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MTRAN,LOGIN,IOBIN, * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC1) CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MTRAP,LOGIN,IOBIN, * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC2) CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MTRAS,LOGIN,IOBIN, * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC3) MLREE1 = IVEC1 MLREE2 = IVEC2 MLREE3 = IVEC3 SEGACT MLREE1,MLREE2,MLREE3 CALL ERREUR(-93) 1409 FORMAT(/,6X,A22) WRITE(IOIMP,1410) (MLREE1.PROG(J) , J = 1,IDIM) 1410 FORMAT(2X,E12.5,2X,E12.5,2X,E12.5) CALL ERREUR(-94) 1411 FORMAT(18X,A22) WRITE(IOIMP,1412) ( MLREE2.PROG(J) , J = ILIGN,JLIGN) 1412 FORMAT(9X,E12.5,2X,E12.5,2X,E12.5) CALL ERREUR(-95) WRITE(IOIMP,1414) ( MLREE3.PROG(J) , J = ILIGN,JLIGN) 1414 FORMAT(23X,E12.5,2X,E12.5,2X,E12.5) SEGDES MLREE1,MLREE2,MLREE3 I = I + 1 GOTO 555 666 CONTINUE GOTO 1350 1314 CONTINUE CALL ERREUR(-96) CALL PRVECT(II,jentet) GOTO 1350 1350 CONTINUE IF(INNN.EQ.NNN) SEGDES MSOLEN 1302 CONTINUE 1301 CONTINUE SEGDES MSOLRE GOTO 2000 C C 2000 CONTINUE SEGDES MSOLUT RETURN END