Télécharger la plaquette Cast3M


fr en

Télécharger ecsolu.eso

Retour à la liste

Numérotation des lignes : 

ecsolu

  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 PPARAM
  20. -INC CCOPTIO
  21. -INC SMELEME
  22. -INC SMSOLUT
  23. -INC SMLREEL
  24.       DATA MOSINU/'SINUS   ','COSINUS '/
  25.       DATA MROTA/'ROTATION D ENSEMBLE'/
  26.       DATA MROTP/'VITESSE DE ROTATION'/
  27.       DATA MROTS/'ACCELERATION DE ROTATION'/
  28.       DATA MTRAN/'TRANSLATION D ENSEMBLE'/
  29.       DATA MTRAP/'VITESSE DE TRANSLATION'/
  30.       DATA MTRAS/'ACCELERATION DE TRANSLATION'/
  31. C
  32.       MSOLUT=IRET
  33.       SEGACT MSOLUT
  34.       INTERR(1)=MSOLUT
  35.       NSOLUT=MSOLIS(/1)
  36.       IF(NSOLUT.EQ.0) THEN
  37.         CALL ERREUR(-71)
  38.          RETURN
  39.       ENDIF
  40.       IF(ITYSOL.NE.'MODE    ') GOTO 1
  41.       ITY=1
  42.       MELEME=MSOLIS(3)
  43.       SEGACT MELEME
  44.       NNN=NUM(/2)
  45.       SEGDES MELEME
  46.       INTERR(2)=NNN
  47.       CALL ERREUR(-72)
  48.       GOTO 30
  49.    1  IF(ITYSOL.NE.'SOLUSTAT'.AND.ITYSOL.NE.'PSEUMODE')GOTO 2
  50.       ITY=2
  51.       MELEME=MSOLIS(3)
  52.       SEGACT MELEME
  53.       NNN=NUM(/2)
  54.       SEGDES MELEME
  55.       INTERR(2)=NNN
  56.       IF(ITYSOL.EQ.'SOLUSTAT') CALL ERREUR(-73)
  57.       IF(ITYSOL.EQ.'PSEUMODE') CALL ERREUR(-74)
  58.       GOTO 30
  59.    2  IF(ITYSOL.NE.'DYNAMIQU')GOTO 3
  60.       ITY=3
  61.       MSOLRE=MSOLIS(1)
  62.       SEGACT MSOLRE
  63.       NNN=SOLRE(/1)
  64.       INTERR(2)=NNN
  65.       CALL ERREUR(-75)
  66.       GOTO 30
  67.  3    CONTINUE
  68.  30   CONTINUE
  69. C
  70. C
  71.       GOTO (1100,1200,1300),ITY
  72. C
  73. C  ************ MODES ******************************************
  74.  1100 CONTINUE
  75.       IBO=MSOLUT
  76.       CALL ECMODE(IBO)
  77.       MSOLUT=IBO
  78.       SEGACT MSOLUT
  79.       DO 1101 INNN=1,NNN
  80.       INTERR(1)=INNN
  81.       CALL ERREUR(-76)
  82.       DO 1102 IS=4,NSOLUT
  83.       IF(MSOLIS(IS).EQ.0) GOTO 1102
  84.       MSOLEN=MSOLIS(IS)
  85.       IF(INNN.EQ.1) SEGACT MSOLEN
  86.       II=ISOLEN(INNN)
  87.       IF(II.EQ.0) GOTO 1150
  88.       GOTO(1150,1150,1150,1106,1103,1104,1105,1150,1150,1150),IS
  89.  1106 CONTINUE
  90.       MMODE=II
  91.       SEGACT MMODE
  92.       REAERR(1)=FMMODD(1)
  93.       REAERR(2)=FMMODD(2)
  94.       REAERR(3)=FMMODD(3)
  95.       REAERR(4)=FMMODD(4)
  96.       REAERR(5)=FMMODD(5)
  97.       INTERR(1)=IMMODD(1)
  98.       IF(IMMODD(3).NE.0) INTERR(2)=IMMODD(2)
  99.       IF(IMMODD(3).EQ.0) THEN
  100.          CALL ERREUR(-77)
  101.       ELSE
  102.          IF(IMMODD(2).NE.0) THEN
  103.           MOTERR(1:8)=MOSINU(IMMODD(3))
  104.          ELSE
  105.           MOTERR(1:8)= ' '
  106.          ENDIF
  107.          CALL ERREUR(-78)
  108.       ENDIF
  109.       SEGDES MMODE
  110.       GOTO 1150
  111.  1103 CONTINUE
  112.       CALL ERREUR(-79)
  113.       CALL ECCHPO(II,jentet)
  114.       GOTO 1150
  115.  1104 CONTINUE
  116.       CALL ERREUR(-80)
  117. *     CALL PRCHEL(II,jentet)
  118.       GOTO 1150
  119.  1105 CONTINUE
  120.       CALL ERREUR(-81)
  121. *     CALL PRCHEL(II,jentet)
  122.       GOTO 1150
  123.  1150 CONTINUE
  124.       IF(INNN.EQ.NNN) SEGDES MSOLEN
  125.  1102 CONTINUE
  126.  1101 CONTINUE
  127.       GOTO 2000
  128. C
  129. C
  130. C *************************** SOLUTIONS STATIQUES **********************
  131.  1200 CONTINUE
  132.       DO 1201 INNN=1,NNN
  133.       INTERR(1)=INNN
  134.       IF(ITYSOL.EQ.'SOLUSTAT')  CALL ERREUR(-82)
  135.       IF(ITYSOL.EQ.'PSEUMODE')  CALL ERREUR(-83)
  136.       IF(MSOLIS(10).EQ.0) GOTO 1206
  137.       MSOLEN=MSOLIS(10)
  138.       IF(INNN.EQ.1) SEGACT MSOLEN
  139.       II=ISOLEN(INNN)
  140.       IF(INNN.EQ.NNN) SEGDES MSOLEN
  141.       IF(II.EQ.0) GOTO 1206
  142.       INTERR(1)=II
  143.       CALL ERREUR(-84)
  144.  1206 NSOLU1=NSOLUT-1
  145.       DO 1202 IS=4,NSOLU1
  146.       IF(MSOLIS(IS).EQ.0) GOTO 1202
  147.       MSOLEN=MSOLIS(IS)
  148.       IF(INNN.EQ.1) SEGACT MSOLEN
  149.       II=ISOLEN(INNN)
  150.       IF(II.EQ.0) GOTO 1250
  151.       GOTO(1250,1250,1250,1250,1203,1204,1205,1250,1250),IS
  152.  1203 CONTINUE
  153.       CALL ERREUR(-79)
  154.       CALL ECCHPO(II,jentet)
  155.       GOTO 1250
  156.  1204 CONTINUE
  157.       CALL ERREUR(-80)
  158. *     CALL PRCHEL(II,jentet)
  159.       GOTO 1250
  160.  1205 CONTINUE
  161.       CALL ERREUR(-81)
  162. *     CALL PRCHEL(II,jentet)
  163.       GOTO 1250
  164.  1250 CONTINUE
  165.       IF(INNN.EQ.NNN) SEGDES MSOLEN
  166.  1202 CONTINUE
  167.  1201 CONTINUE
  168.       GOTO 2000
  169. C
  170. C *************************** DYNAMIQUE ********************************
  171.  1300 CONTINUE
  172.       DO 1301 INNN=1,NNN
  173.       REAERR(1)=SOLRE(INNN)
  174.       CALL ERREUR(-85)
  175.       DO 1302 IS=5,NSOLUT
  176.       IF(MSOLIS(IS).EQ.0) GOTO 1302
  177.       MSOLEN=MSOLIS(IS)
  178.       IF(INNN.EQ.1) SEGACT MSOLEN
  179.       II=ISOLEN(INNN)
  180.       IF(II.EQ.0) GOTO 1350
  181.       GOTO (1350,1350,1350,1350,1305,1306,1307,1308,1309,1310,
  182.      *1311,1312,1350,1314),IS
  183.  1305 CONTINUE
  184.       CALL ERREUR(-79)
  185.       CALL ECCHPO(II,jentet)
  186.       GOTO 1350
  187.  1306 CONTINUE
  188.       CALL ERREUR(-80)
  189. *     CALL PRCHEL(II,jentet)
  190.       GOTO 1350
  191.  1307 CONTINUE
  192.       CALL ERREUR(-81)
  193. *     CALL PRCHEL(II,jentet)
  194.       GOTO 1350
  195.  1308 CONTINUE
  196.       CALL ERREUR(-86)
  197.       CALL ECCHPO(II,jentet)
  198.       GOTO 1350
  199.  1309 CONTINUE
  200.       CALL ERREUR(-87)
  201.       CALL ECCHPO(II,jentet)
  202.       GOTO 1350
  203.  1310 CONTINUE
  204.       CALL ERREUR(-88)
  205.       CALL ECCHPO(II,jentet)
  206.       GOTO 1350
  207.  1311 CONTINUE
  208.       CALL ERREUR(-89)
  209.       CALL ECROBJ('TABLE   ',II)
  210.       CALL INDETA
  211.       CALL LIROBJ('TABLE   ',LISTIND,1,IRETOU)
  212.       I = 1
  213. 333   CONTINUE
  214.       IGEO1 = 0
  215.       CALL ACCTAB(LISTIND,'ENTIER  ',I   ,XVA,CHAR,LOGIN,IOBIN,
  216.      *                    'MAILLAGE',IVAL,XVA,CHAR,LOGRE,IGEO1)
  217.       IF(IGEO1.EQ.0) GOTO 444
  218.         CALL ACCTAB(II,'MAILLAGE',IVA,XVA,CHAR,LOGIN,IGEO1,
  219.      *                 'TABLE   ',IVA,XVA,CHAR,LOGIN,ITAB1)
  220.         CALL ACCTAB(ITAB1,'MOT     ',IVA,XVA,MROTA,LOGIN,IOBIN,
  221.      *                   'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC1)
  222.         CALL ACCTAB(ITAB1,'MOT     ',IVA,XVA,MROTP,LOGIN,IOBIN,
  223.      *                   'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC2)
  224.         CALL ACCTAB(ITAB1,'MOT     ',IVA,XVA,MROTS,LOGIN,IOBIN,
  225.      *                   'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC3)
  226.         CALL ERREUR(-90)
  227.         MLREE1 = IVEC1
  228.         MLREE2 = IVEC2
  229.         MLREE3 = IVEC3
  230.         SEGACT MLREE1,MLREE2,MLREE3
  231.         DO 1401 I = 1,IDIM
  232.         ILIGN = ( I - 1 ) * IDIM + 1
  233.         JLIGN = ILIGN + IDIM - 1
  234.         WRITE(IOIMP,1402) ( MLREE1.PROG(J) , J = ILIGN,JLIGN)
  235. 1402    FORMAT(2X,F9.6,2X,F9.6,2X,F9.6)
  236. 1401    CONTINUE
  237.         CALL ERREUR(-91)
  238.         DO 1404 I = 1,IDIM
  239.         ILIGN = ( I - 1 ) * IDIM + 1
  240.         JLIGN = ILIGN + IDIM - 1
  241.         WRITE(IOIMP,1405) ( MLREE2.PROG(J) , J = ILIGN,JLIGN)
  242. 1405    FORMAT(9X,E12.5,2X,E12.5,2X,E12.5)
  243. 1404    CONTINUE
  244.         CALL ERREUR(-92)
  245. 1406    FORMAT(35X,A24)
  246.         DO 1407 I = 1,IDIM
  247.         ILIGN = ( I - 1 ) * IDIM + 1
  248.         JLIGN = ILIGN + IDIM - 1
  249.         WRITE(IOIMP,1408) ( MLREE3.PROG(J) , J = ILIGN,JLIGN)
  250. 1408    FORMAT(23X,E12.5,2X,E12.5,2X,E12.5)
  251. 1407    CONTINUE
  252.         SEGDES MLREE1,MLREE2,MLREE3
  253.       I = I + 1
  254.       GOTO 333
  255. 444   CONTINUE
  256.       GOTO 1350
  257. 1312  CONTINUE
  258.       CALL ECROBJ('TABLE   ',II)
  259.       CALL INDETA
  260.       CALL LIROBJ('TABLE   ',LISTIND,1,IRETOU)
  261.       I = 1
  262. 555   CONTINUE
  263.       IGEO1 = 0
  264.       CALL ACCTAB(LISTIND,'ENTIER  ',I   ,XVA,CHAR,LOGIN,IOBIN,
  265.      *                    'MAILLAGE',IVAL,XVA,CHAR,LOGRE,IGEO1)
  266.       IF(IGEO1.EQ.0) GOTO 666
  267.         CALL ACCTAB(II,'MAILLAGE',IVA,XVA,CHAR,LOGIN,IGEO1,
  268.      *                 'TABLE   ',IVA,XVA,CHAR,LOGIN,ITAB1)
  269.         CALL ACCTAB(ITAB1,'MOT     ',IVA,XVA,MTRAN,LOGIN,IOBIN,
  270.      *                   'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC1)
  271.         CALL ACCTAB(ITAB1,'MOT     ',IVA,XVA,MTRAP,LOGIN,IOBIN,
  272.      *                   'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC2)
  273.         CALL ACCTAB(ITAB1,'MOT     ',IVA,XVA,MTRAS,LOGIN,IOBIN,
  274.      *                   'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC3)
  275.         MLREE1 = IVEC1
  276.         MLREE2 = IVEC2
  277.         MLREE3 = IVEC3
  278.         SEGACT MLREE1,MLREE2,MLREE3
  279.         CALL ERREUR(-93)
  280. 1409    FORMAT(/,6X,A22)
  281.         WRITE(IOIMP,1410) (MLREE1.PROG(J) , J = 1,IDIM)
  282. 1410    FORMAT(2X,E12.5,2X,E12.5,2X,E12.5)
  283.         CALL ERREUR(-94)
  284. 1411    FORMAT(18X,A22)
  285.         WRITE(IOIMP,1412) ( MLREE2.PROG(J) , J = ILIGN,JLIGN)
  286. 1412    FORMAT(9X,E12.5,2X,E12.5,2X,E12.5)
  287.         CALL ERREUR(-95)
  288.         WRITE(IOIMP,1414) ( MLREE3.PROG(J) , J = ILIGN,JLIGN)
  289. 1414    FORMAT(23X,E12.5,2X,E12.5,2X,E12.5)
  290.         SEGDES MLREE1,MLREE2,MLREE3
  291.       I = I + 1
  292.       GOTO 555
  293. 666   CONTINUE
  294.       GOTO 1350
  295.  1314 CONTINUE
  296.       CALL ERREUR(-96)
  297.       CALL PRVECT(II,jentet)
  298.       GOTO 1350
  299.  1350 CONTINUE
  300.       IF(INNN.EQ.NNN) SEGDES MSOLEN
  301.  1302 CONTINUE
  302.  1301 CONTINUE
  303.       SEGDES MSOLRE
  304.       GOTO 2000
  305. C
  306. C
  307.  2000 CONTINUE
  308.       SEGDES MSOLUT
  309.       RETURN
  310.       END
  311.  
  312.  
  313.  
  314.  

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