Télécharger la plaquette Cast3M


fr en

Télécharger tire.eso

Retour à la liste

Numérotation des lignes : 

tire

  1. C TIRE      SOURCE    SP204843  23/06/05    21:15:03     11671          
  2.  
  3.       SUBROUTINE TIRE
  4.  
  5. C=======================================================================
  6. C   OPERATEUR TIRE
  7. C
  8. C       OBJOL = TIRE MSOLUT TYPE   ( ROBO ) ( INSTANTS ) ;
  9. C               ----        ----
  10. C       ou
  11. C       OBJOL = TIRE MCHARG  FLOTTANT  |  ( 'TABL' )  ;
  12. C                                      |  (  MOT   )
  13. C
  14. C         OBJOL    : objet de type .........
  15. C         MSOLUT   : objet SOLUTION
  16. C         TYPE     : MOT CLE:TYPE DE LA VARIABLE(DEPL,VITE,ACCE,LIAI,
  17. C                                                            POIN ..)
  18. C         MCHARG   : objet CHARGEMENT
  19. C         MOT      : nom du CHARGEMENT a instancier
  20. C         FLOTTANT : temps pour lequel on desire le chargement.
  21. C
  22. C           dans le cas d'un objet SOLUTION de type DYNAMIQUE issu d'une
  23. C           resolution par PLEX :
  24. C            1- on peut obtenir les matrices ROTATION et leurs derivees
  25. C           en posant TYPE = ROTA  ( pour les TRANSLATIONS TYPE = ROTA )
  26. C            2- si on desire effectuer une RECOmbinaison des VITESSES et
  27. C           des ACCELERATIONS specifier le mot-clef ROBO apres TYPE
  28. C
  29. C         INSTANTS: procedure facultative pour choisir les cas de sortie
  30. C                   MOT suivi d'une VALEUR
  31. C          TEMP T     : FLOTTANT  temps a sortir
  32. C          CAS  ICAS  : ENTIER    cas a sortir
  33. C          RANG IRG   : ENTIER    rang de l'objet a sortir
  34. C          NUME INUME : ENTIER    numero du mode a sortir
  35. C          RIEN       : on prend le dernier
  36. C
  37. C         Dans le cas de l'objet chargement le mot clef TABL permet
  38. C           de ranger les differents chargements instancies dans une
  39. C           table pointant vers un CHPOINT (ou MCHAML) et d'indice
  40. C           le nom du chargement. Si on donne un objet de type MOT
  41. C           a l'operateur il calcule le champ instancie correspondant
  42. C           uniquement aux chargements portant ce nom.Si aucun mot
  43. C           n'est donne il instancie le chargement et renvoie un
  44. C           objet de type CHPOINT ou MCHAML.
  45. C           Pour des chargements mobiles l'operateur calcule le
  46. C           champ effectif au temps voulu
  47. C--------------------------------------------------------------------
  48. C  CREATION    : 16/10/85
  49. C  PROGRAMMEUR : FARVACQUE
  50. C                PUIS CHARVET POUR INTRODUCTION DE L'OPTION ROBO ( NON
  51. C                ENCORE TESTE SUR CRAY )
  52. C  APPELLE: LIRE LIRMOT CHRCHA ECRIRE TITMOD TYPFIL ERREUR(235 234 135)
  53. C           LIRCHA LIRENT LIREE LIROBJ INTER1 MOCHPO DTCHPO ADCHPO PLACE
  54. C  EXTENSION CHARGEMENT MOBILES 02/98  KICH
  55. C
  56. C=======================================================================
  57.       IMPLICIT INTEGER(I-N)
  58.       IMPLICIT REAL*8 (A-H,O-Z)
  59.  
  60.  
  61. -INC PPARAM
  62. -INC CCOPTIO
  63. -INC CCREEL
  64.  
  65. -INC SMSOLUT
  66. -INC SMELEME
  67. -INC SMCHPOI
  68. -INC SMLCHPO
  69. -INC SMCHARG
  70. -INC SMLREEL
  71. -INC SMTABLE
  72. -INC SMEVOLL
  73. -INC SMLOBJE
  74. -INC SMCOORD
  75.  
  76.       PARAMETER (LMOOPT=4,LFREQ=6,LGDEP=2)
  77.       CHARACTER*4 MOOPT(LMOOPT)
  78.       CHARACTER*8 MTYP1,CHATY2
  79.       CHARACTER*4 MOGDEP(LGDEP)
  80.       CHARACTER*4 MOROBO(1)
  81.       CHARACTER*4 MOFREQ(LFREQ)
  82.       CHARACTER *72 ITEX
  83.       CHARACTER*8 TAPIND,TAPOBJ,TAPOB1,TAPOB2
  84.       CHARACTER*4 CHARIN,CHARRE, MTYPR
  85.       LOGICAL LOGIN,LOGRE
  86.       REAL*8 XVALIN,XVALRE
  87.       CHARACTER CTYP*8,MCHA*4,MOT1*4
  88.       INTEGER LCHAR,MIN1,MAX1
  89.       DATA MOFREQ/'FREQ','MGEN','QX  ','QY  ','QZ  ','POIN'/
  90.       DATA MOOPT/'TEMP','CAS ','RANG','NUME'/
  91.       DATA MOGDEP/'ROTA','TRAN'/
  92.       DATA MOROBO/'ROBO'/
  93.       DATA PRECI/1.E-3/
  94.       ITEX = '  '
  95.       ICHA2 = 0
  96.       ICHA3 = 0
  97.       IGDEP = 0
  98.  
  99.       IVALIN= 0
  100.       XVALIN= 0.D0
  101.       LOGIN =.FALSE.
  102.       IOBIN = 0
  103.  
  104.       IVALRE= 0
  105.       XVALRE= 0
  106.  
  107. *----------------------------------------------------------------------
  108. *                  CAS OU ON CHERCHE A TIRER UN CHARGEMENT
  109. *----------------------------------------------------------------------
  110.  
  111. *----- la nature du chpo de sortie est conditionnée par celle qui -----
  112. *-------- sort de l'objet chargement si il y des incoherence ----------
  113. *--------- adchpo et muchpo rendront une nature indeterminée ----------
  114.  
  115.       IRETT = 0
  116.       CALL LIROBJ('CHARGEME',ICHAR,0,IRETOU)
  117.       IF(IERR.NE.0) RETURN
  118.       IF(IRETOU.EQ.0) GOTO 200
  119.  
  120.       CALL LIRCHA(MOT1,0,LCHAR)
  121.       IF (IERR.NE.0) RETURN
  122.       IF (LCHAR.EQ.0) THEN
  123.         MOT1 = '    '
  124.       ENDIF
  125.  
  126.       CALL LIRREE(XXX,1,IRETOU)
  127.       IF (IERR.NE.0) RETURN
  128.       T1 = XXX
  129.  
  130.  
  131.       MCHARG=ICHAR
  132.       CALL ACTOBJ('CHARGEME',MCHARG,1)
  133. C     SEGACT MCHARG
  134.       NCHAR=KCHARG(/1)
  135.  
  136. *----------------------------------------------------------------------
  137. *------- Cas ou on range le chargement instancie dans une TABLE ------
  138. *----------------------------------------------------------------------
  139.  
  140.       IF (MOT1.EQ.'TABL') THEN
  141.         M = 0
  142.         SEGINI MTABLE
  143.         ITA1 = MTABLE
  144. **        SEGDES MTABLE
  145.  
  146. *-------------- boucle sur les chargements élémentaires ---------------
  147.  
  148.         DO 501 IC=1,NCHAR
  149.           ICHARG=KCHARG(IC)
  150. C          SEGACT ICHARG
  151.           IPO1 = ICHPO1
  152.           IPO2 = ICHPO2
  153.  
  154. *--------- on ne considère que les objets de sous type force -----------
  155.  
  156.           IF(CHANAT(IC).EQ.'DEPLACEM') THEN
  157.             MOTERR(1:8)='CHARGEME'
  158.             MOTERR(9:16)='DEPLACEM'
  159.             CALL ERREUR(131)
  160.             GOTO 599
  161.           ENDIF
  162.  
  163. *------------ On ne considere que les chargements nommes ---------------
  164.  
  165.           IF (CHANOM(IC).EQ.'    ') THEN
  166.             CALL ERREUR(697)
  167.             GOTO 599
  168.           ENDIF
  169.  
  170. *--- cas des chargements elementaires CHPOINT (ou MCHAML) + EVOL -------
  171.  
  172.           IF((CHATYP.EQ.'CHPOINT ').OR.(CHATYP.EQ.'MCHAML  ')) THEN
  173.             MLREEL=ICHPO2
  174. C           Cas particulier du chargement constant : on retourne le champ
  175. C           sans aucune interpolation
  176.             IF (ICHPO2.EQ.0) THEN
  177.               IRET=ICHPO1
  178.               TAPOBJ=CHATYP
  179. C           Cas general : interpolation dans l'evolution
  180.             ELSE
  181.               SEGACT MLREEL
  182.               NF=PROG(/1)
  183.  
  184. *------- Le temps %r1 sort de la table du %i1ème chargement -----------
  185.  
  186. C SP : on s'autorise a sortir de l'intervale de definition de l'evolution.
  187. C      L'interpolation de l'amplitude est geree par INTER1.
  188. C              T2 = T1 + ABS(T1*0.000001D0)
  189. C              T3 = T1 - ABS(T1*0.000001D0)
  190. C              IF(PROG(1).GT.T2.OR.PROG(NF).LT.T3) THEN
  191. C                INTERR(1)=IC
  192. C                REAERR(1)=T1
  193. C                CALL ERREUR(342)
  194. C                GOTO 599
  195. C              ENDIF
  196.  
  197. C------------- calcul du deplacement eventuel du champ ----------
  198.               IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  199.      &            CHAMOB(IC).EQ.'TRAJ') THEN
  200.                 MTYPR = CHAMOB(IC)
  201.                 IPOENT = IPO1
  202.                 CHATY2 = CHATYP
  203.                 IPOENU = ICHPO4
  204.                 IPOENV = ICHPO5
  205.                 IPOENW = ICHPO6
  206.                 IPOENX = ICHPO7
  207.                 CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  208.      $                      IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  209.                 IF (IERR.NE.0) RETURN
  210.                 IPO1 = IPOSOR
  211.               ENDIF
  212.  
  213. C----- interpole la valeur de l'evolution FT1 au temps T1
  214.               ICHATX=ICHPO2
  215.               ICHAFX=ICHPO3
  216.               CALL INTER1(ICHATX,ICHAFX,T1,FT1)
  217.  
  218.               IRET   = 0
  219.  
  220. C----- Cas du chargement de nom TRAJ : interpolation d'un point
  221.               IF (CHANOM(IC).EQ.'TRAJ') THEN
  222.                 CALL IPLCUR(IPO1,FT1,IRET)
  223.                 IF (IERR.NE.0) RETURN
  224.                 TAPOBJ = 'POINT   '
  225.  
  226. C----- Autres cas :  multiplication du CHPOINT ou du MCHAML -----------
  227.               ELSE
  228.                 IOPERA = 2
  229.                 IARGU  = 2
  230.                 I11    = 0
  231.                 IF(CHATYP.EQ.'CHPOINT ') THEN
  232.                   TAPOBJ = 'CHPOINT '
  233.                   CALL ACTOBJ('CHPOINT ',IPO1,1)
  234.                   CALL OPCHP1(IPO1,IOPERA,IARGU,I11,FT1,IRET,IRETOU)
  235.                   IF (IRETOU.EQ.0) THEN
  236.                     CALL ERREUR(26)
  237.                     RETURN
  238.                   ENDIF
  239.                 ELSE
  240.                   TAPOBJ = 'MCHAML  '
  241.                   CALL ACTOBJ('MCHAML ',IPO1,1)
  242.                   CALL OPCHE1(IPO1,IOPERA,IARGU,I11,FT1,IRET,IRETOU)
  243.                   IF (IRETOU.EQ.0) THEN
  244.                     CALL ERREUR(26)
  245.                     RETURN
  246.                   ENDIF
  247.                 ENDIF
  248.               ENDIF
  249.             ENDIF
  250. C
  251. C----- On met le resultat IRET dans la table :
  252.             IF(IRET.EQ.0) GOTO 598
  253.             CHARIN = CHANOM(IC)
  254.             IOBRE = IRET
  255.             TAPIND = 'MOT     '
  256.             CALL ECCTAB(ITA1,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  257.      $                       TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  258.  
  259.  
  260. C----------------------------------------------------------------------
  261. C Cas des chargements elementaires TABLE1-TABLE2
  262. C----------------------------------------------------------------------
  263.  
  264.           ELSEIF (CHATYP.EQ.'TABLE   ') THEN
  265.             IVALI1 = 0
  266.             IVALI2 = 1
  267.             MTAB1=IPO1
  268.             SEGACT MTAB1
  269.             JMA1=MTAB1.MLOTAB
  270.             DO 505 JJ = 1,JMA1
  271.               XVALR1=MTAB1.RMTABV(IVALI1+1)
  272.               TAPOB1=MTAB1.MTABTV(IVALI1+1)
  273.               IF(JMA1.EQ.1) THEN
  274.                 XVALR2 = T1
  275.               ELSE
  276.                 XVALR2=MTAB1.RMTABV(IVALI2+1)
  277.                 TAPOB2=MTAB1.MTABTV(IVALI2+1)
  278.               ENDIF
  279.               IF(IVALI1.EQ.0) THEN
  280.                 IF (T1.LE.XVALR1) THEN
  281.                   DREL = 0.D0
  282.                   GOTO 507
  283.                 ENDIF
  284.               ENDIF
  285.               IF(IVALI2.EQ.(JMA1-1)) THEN
  286.                 IF (T1.GE.XVALR2) THEN
  287.                   DREL = 1.D0
  288.                   GOTO 507
  289.                 ENDIF
  290.               ENDIF
  291.               IF((XVALR1.LE.T1).AND.(T1.LE.XVALR2)) GOTO 506
  292.  5059         CONTINUE
  293.               IVALI1 = IVALI1 + 1
  294.               IVALI2 = IVALI2 + 1
  295.  505        CONTINUE
  296.             SEGDES MTAB1
  297.  
  298. *------- Le temps %r1 sort de la table du %i1ème chargement ----------
  299.  
  300.             INTERR(1)=IC
  301.             REAERR(1)=T1
  302.             CALL ERREUR(342)
  303.             GOTO 599
  304.  
  305.  506        CONTINUE
  306.  
  307. *------------ la premiere table ne pointe pas vers des reels ----------
  308.  
  309.             IF((TAPOB1.NE.TAPOB2).OR.(TAPOB1.NE.'FLOTTANT')) THEN
  310.               CALL ERREUR(692)
  311.               GOTO 599
  312.             ENDIF
  313.             DREL = (T1 - XVALR1)/(XVALR2 - XVALR1)
  314.  507        CONTINUE
  315.             TAPOB1 = ' '
  316.             TAPOB2 = ' '
  317.             TAPIND = 'ENTIER  '
  318.             MTAB2=IPO2
  319.             SEGACT MTAB2
  320.             TAPOB1=MTAB2.MTABTV(IVALI1+1)
  321.             TAPOB2=MTAB2.MTABTV(IVALI2+1)
  322.             IOBR1=MTAB2.MTABIV(IVALI1+1)
  323.             IOBR2=MTAB2.MTABIV(IVALI2+1)
  324.             SEGDES MTAB2
  325. *------ la deuxieme table ne pointe pas vers des champs de meme type -----
  326.  
  327.             IF(TAPOB1.NE.TAPOB2) THEN
  328.               CALL ERREUR(693)
  329.               GOTO 599
  330.             ENDIF
  331.  
  332. C------------- Cas du CHPOINT :
  333.             IF(TAPOB1.EQ.'CHPOINT ') THEN
  334.               CALL ECROBJ('CHPOINT ',IOBR1)
  335.               CALL ECROBJ('CHPOINT ',IOBR2)
  336.               CALL ECRREE(1.D0 - DREL)
  337.               CALL ECRREE(DREL)
  338.               CALL COLI
  339.               CALL LIROBJ('CHPOINT ',IRET,1,IRETOU)
  340.               IF(IRETOU.EQ.0) GOTO 599
  341. C------------- calcul du deplacement eventuel du champ ----------
  342.               IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  343.      &            CHAMOB(IC).EQ.'TRAJ') THEN
  344.                 MTYPR = CHAMOB(IC)
  345.                 IPOENT = IRET
  346.                 CHATY2 = TAPOB1
  347.                 IPOENU = ICHPO4
  348.                 IPOENV = ICHPO5
  349.                 IPOENW = ICHPO6
  350.                 IPOENX = ICHPO7
  351.                 CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  352.      $               IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  353.                 IF (IERR.NE.0) RETURN
  354.                 IRET = IPOSOR
  355.               ENDIF
  356.               CHARIN = CHANOM(IC)
  357.               TAPOBJ = 'CHPOINT '
  358.               IOBRE = IRET
  359.               TAPIND = 'MOT     '
  360.               CALL ECCTAB(ITA1,TAPIND,IVALIN,XVALIN,CHARIN,
  361.      $             LOGIN,IOBIN,TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  362.  
  363. C------------- Cas du MCHAML :
  364.             ELSEIF (TAPOB1.EQ.'MCHAML  ') THEN
  365.               IF (CHANOM(IC).EQ.'MATE') THEN
  366.                 IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  367.                   IRET = IOBR2
  368.                 ELSE
  369.                   IRET = IOBR1
  370.                 ENDIF
  371.               ELSE
  372.                 CALL ECROBJ('MCHAML  ',IOBR1)
  373.                 CALL ECROBJ('MCHAML',IOBR2)
  374.                 CALL ECRREE(1.D0 - DREL)
  375.                 CALL ECRREE(DREL)
  376.                 CALL COLI
  377.                 CALL LIROBJ('MCHAML  ',IRET,1,IRETOU)
  378.                 IF(IRETOU.EQ.0) GOTO 599
  379. C------------- calcul du deplacement eventuel du champ ----------
  380.                 IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  381.      &              CHAMOB(IC).EQ.'TRAJ') THEN
  382.                   MTYPR = CHAMOB(IC)
  383.                   IPOENT = IRET
  384.                   CHATY2 = TAPOB1
  385.                   IPOENU = ICHPO4
  386.                   IPOENV = ICHPO5
  387.                   IPOENW = ICHPO6
  388.                   IPOENX = ICHPO7
  389.                   CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  390.      $                 IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  391.                   IF (IERR.NE.0) RETURN
  392.                   IRET = IPOSOR
  393.                 ENDIF
  394.               ENDIF
  395.               CHARIN = CHANOM(IC)
  396.               TAPOBJ = 'MCHAML  '
  397.               IOBRE = IRET
  398.               TAPIND = 'MOT     '
  399.               CALL ECCTAB(ITA1,TAPIND,IVALIN,XVALIN,CHARIN,
  400.      $             LOGIN,IOBIN,TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  401.  
  402. C------------- Cas du MODELE :
  403.             ELSEIF (TAPOB1.EQ.'MMODEL  ') THEN
  404.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  405.                 IRET = IOBR2
  406.               ELSE
  407.                 IRET = IOBR1
  408.               ENDIF
  409.  
  410. C------------- Cas du MAILLAGE :
  411.             ELSEIF (TAPOB1.EQ.'MAILLAGE') THEN
  412.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  413.                 IRET = IOBR2
  414.               ELSE
  415.                 IRET = IOBR1
  416.               ENDIF
  417.  
  418. C------------- Cas de la RIGIDITE :
  419.             ELSEIF (TAPOB1.EQ.'RIGIDITE') THEN
  420.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  421.                 IRET = IOBR2
  422.               ELSE
  423.                 IRET = IOBR1
  424.               ENDIF
  425.  
  426. C------------ Cas du POINT :
  427.             ELSEIF (TAPOB1.EQ.'POINT   ') THEN
  428.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  429.                 IRET = IOBR2
  430.               ELSE IF (ABS(DREL-0.D0).LE.XZPREC) THEN
  431.                 IRET = IOBR1
  432.               ELSE
  433.                 SEGACT,MCOORD
  434. C     write(6,*) 'IOBR1, IOBR2,DREL=',IOBR1,IOBR2,DREL
  435.                 NBPTS = NBPTS+1
  436.                 SEGADJ,MCOORD
  437.                 IDIMP1 = IDIM + 1
  438.                 XP1 = XCOOR((IOBR1-1)*IDIMP1+1)
  439.                 YP1 = XCOOR((IOBR1-1)*IDIMP1+2)
  440.                 ZP1 = XCOOR((IOBR1-1)*IDIMP1+3)
  441.                 XP2 = XCOOR((IOBR2-1)*IDIMP1+1)
  442.                 YP2 = XCOOR((IOBR2-1)*IDIMP1+2)
  443.                 ZP2 = XCOOR((IOBR2-1)*IDIMP1+3)
  444.                 XCOOR((NBPTS-1)*IDIMP1+1) = DREL*XP2+(1.D0-DREL)*XP1
  445.                 XCOOR((NBPTS-1)*IDIMP1+2) = DREL*YP2+(1.D0-DREL)*YP1
  446.                 XCOOR((NBPTS-1)*IDIMP1+3) = DREL*ZP2+(1.D0-DREL)*ZP1
  447.                 SEGDES,MCOORD
  448.               ENDIF
  449.  
  450. *-- la 2e table ne pointe pas vers un CHPOINT, MCHAML, MMODLE ou un MAILLAGE ----
  451.             ELSE
  452.               CALL ERREUR(694)
  453.               GOTO 599
  454.             ENDIF
  455.  
  456.  
  457. C----------------------------------------------------------------------
  458. C Cas des chargements elementaires LREE1-LOBJ1
  459. C----------------------------------------------------------------------
  460.  
  461.           ELSEIF (CHATYP.EQ.'LISTOBJE') THEN
  462.  
  463. C---------- Recherche intervalle de temps contenant T1
  464.             IVALI1 = 0
  465.             IVALI2 = 1
  466.             MLREEL = IPO2
  467.             SEGACT, MLREEL
  468.             MLOBJE = IPO1
  469.             SEGACT, MLOBJE
  470.             JMA1 = PROG(/1)
  471.             DO 405 JJ = 1,JMA1
  472.               XVALR1 = PROG(IVALI1+1)
  473.               IF(JMA1.EQ.1) THEN
  474.                 XVALR2 = T1
  475.               ELSE
  476.                 XVALR2 = PROG(IVALI2+1)
  477.               ENDIF
  478.               IF(IVALI1.EQ.0) THEN
  479.                 IF (T1.LE.XVALR1) THEN
  480.                   DREL = 0.D0
  481.                   GOTO 407
  482.                 ENDIF
  483.               ENDIF
  484.               IF(IVALI2.EQ.(JMA1-1)) THEN
  485.                 IF (T1.GE.XVALR2) THEN
  486.                   DREL = 1.D0
  487.                   GOTO 407
  488.                 ENDIF
  489.               ENDIF
  490.               IF((XVALR1.LE.T1).AND.(T1.LE.XVALR2)) GOTO 406
  491.               IVALI1 = IVALI1 + 1
  492.               IVALI2 = IVALI2 + 1
  493.  405        CONTINUE
  494.  
  495. C---------- SP : sans doute sans objet aujourd'hui (extrapolation permise)
  496. *---------- Le temps %r1 sort de la table du %i1eme chargement
  497.             INTERR(1)=IC
  498.             REAERR(1)=T1
  499.             CALL ERREUR(342)
  500.             GOTO 599
  501.  
  502. C---------- On a trouve les piquets de temps encadrants T1
  503.  406        CONTINUE
  504.             DREL = (T1 - XVALR1)/(XVALR2 - XVALR1)
  505.  
  506.  407        CONTINUE
  507.             IOBR1  = LISOBJ(IVALI1+1)
  508.             IOBR2  = LISOBJ(IVALI2+1)
  509.             MTYP1  = TYPOBJ
  510.  
  511. C---------- Cas du CHPOINT :
  512.             IF (MTYP1.EQ.'CHPOINT ') THEN
  513.               CALL ECROBJ('CHPOINT ',IOBR1)
  514.               CALL ECROBJ('CHPOINT ',IOBR2)
  515.               CALL ECRREE(1.D0 - DREL)
  516.               CALL ECRREE(DREL)
  517.               CALL COLI
  518.               CALL LIROBJ('CHPOINT ',IRET,1,IRETOU)
  519.               IF (IRETOU.EQ.0) GOTO 599
  520. C------------- calcul du deplacement eventuel du champ ----------
  521.               IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  522.      &            CHAMOB(IC).EQ.'TRAJ') THEN
  523.                 MTYPR = CHAMOB(IC)
  524.                 IPOENT = IRET
  525.                 CHATY2 = MTYP1
  526.                 IPOENU = ICHPO4
  527.                 IPOENV = ICHPO5
  528.                 IPOENW = ICHPO6
  529.                 IPOENX = ICHPO7
  530.                 CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  531.      $               IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  532.                 IF (IERR.NE.0) RETURN
  533.                 IRET = IPOSOR
  534.               ENDIF
  535.               CHARIN = CHANOM(IC)
  536.               TAPOBJ = 'CHPOINT '
  537.               IOBRE = IRET
  538.               TAPIND = 'MOT     '
  539.               CALL ECCTAB(ITA1,TAPIND,IVALIN,XVALIN,CHARIN,
  540.      $             LOGIN,IOBIN,TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  541.  
  542. C------------- Cas du MCHAML :
  543.             ELSEIF (MTYP1.EQ.'MCHAML  ') THEN
  544.               IF (CHANOM(IC).EQ.'MATE') THEN
  545.                 IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  546.                   IRET = IOBR2
  547.                 ELSE
  548.                   IRET = IOBR1
  549.                 ENDIF
  550.               ELSE
  551.                 CALL ECROBJ('MCHAML  ',IOBR1)
  552.                 CALL ECROBJ('MCHAML',IOBR2)
  553.                 CALL ECRREE(1.D0 - DREL)
  554.                 CALL ECRREE(DREL)
  555.                 CALL COLI
  556.                 CALL LIROBJ('MCHAML  ',IRET,1,IRETOU)
  557.                 IF (IRETOU.EQ.0) GOTO 599
  558. C------------- calcul du deplacement eventuel du champ ----------
  559.                 IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  560.      &              CHAMOB(IC).EQ.'TRAJ') THEN
  561.                   MTYPR = CHAMOB(IC)
  562.                   IPOENT = IRET
  563.                   CHATY2 = MTYP1
  564.                   IPOENU = ICHPO4
  565.                   IPOENV = ICHPO5
  566.                   IPOENW = ICHPO6
  567.                   IPOENX = ICHPO7
  568.                   CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  569.      $                 IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  570.                   IF (IERR.NE.0) RETURN
  571.                   IRET = IPOSOR
  572.                 ENDIF
  573.               ENDIF
  574.               CHARIN = CHANOM(IC)
  575.               TAPOBJ = 'MCHAML  '
  576.               IOBRE = IRET
  577.               TAPIND = 'MOT     '
  578.               CALL ECCTAB(ITA1,TAPIND,IVALIN,XVALIN,CHARIN,
  579.      $             LOGIN,IOBIN,TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  580.  
  581. C------------- Cas du MODELE :
  582.             ELSEIF (MTYP1.EQ.'MMODEL  ') THEN
  583.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  584.                 IRET = IOBR2
  585.               ELSE
  586.                 IRET = IOBR1
  587.               ENDIF
  588.  
  589. C------------- Cas du MAILLAGE :
  590.             ELSEIF (MTYP1.EQ.'MAILLAGE') THEN
  591.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  592.                 IRET = IOBR2
  593.               ELSE
  594.                 IRET = IOBR1
  595.               ENDIF
  596.  
  597. C------------- Cas de la RIGIDITE :
  598.             ELSEIF (MTYP1.EQ.'RIGIDITE') THEN
  599.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  600.                 IRET = IOBR2
  601.               ELSE
  602.                 IRET = IOBR1
  603.               ENDIF
  604.  
  605. C------------- Cas du POINT :
  606.             ELSEIF (MTYP1.EQ.'POINT   ') THEN
  607.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  608.                 IRET = IOBR2
  609.               ELSE IF (ABS(DREL-0.D0).LE.XZPREC) THEN
  610.                 IRET = IOBR1
  611.               ELSE
  612.                 SEGACT,MCOORD
  613. C     write(6,*) 'IOBR1, IOBR2,DREL=',IOBR1,IOBR2,DREL
  614.                 NBPTS = NBPTS+1
  615.                 SEGADJ,MCOORD
  616.                 IDIMP1 = IDIM + 1
  617.                 XP1 = XCOOR((IOBR1-1)*IDIMP1+1)
  618.                 YP1 = XCOOR((IOBR1-1)*IDIMP1+2)
  619.                 ZP1 = XCOOR((IOBR1-1)*IDIMP1+3)
  620.                 XP2 = XCOOR((IOBR2-1)*IDIMP1+1)
  621.                 YP2 = XCOOR((IOBR2-1)*IDIMP1+2)
  622.                 ZP2 = XCOOR((IOBR2-1)*IDIMP1+3)
  623.                 XCOOR((NBPTS-1)*IDIMP1+1) = DREL*XP2+(1.D0-DREL)*XP1
  624.                 XCOOR((NBPTS-1)*IDIMP1+2) = DREL*YP2+(1.D0-DREL)*YP1
  625.                 XCOOR((NBPTS-1)*IDIMP1+3) = DREL*ZP2+(1.D0-DREL)*ZP1
  626.                 SEGDES,MCOORD
  627.               ENDIF
  628.  
  629. C--------- le LISTOBJE ne contient pas de CHPOINT, MCHAML, MMODLE ou MAILLAGE
  630.             ELSE
  631.               CALL ERREUR(694)
  632.               GOTO 599
  633.             ENDIF
  634.  
  635.           ELSE
  636. C-------- Pas de type connu trouve
  637.             CALL ERREUR(695)
  638.             GOTO 599
  639.           ENDIF
  640.  501    CONTINUE
  641.         CALL ECROBJ('TABLE   ',ITA1)
  642.         RETURN
  643.  598    IF(IC.NE.0) THEN
  644.           DO 555 J = 1, IC
  645.             IRETT = MTABIV(J)
  646.             CALL DTCHPO(IRETT)
  647.  555      CONTINUE
  648.         ENDIF
  649.  599    CONTINUE
  650.         SEGSUP MTABLE
  651.         RETURN
  652.  
  653.  
  654.  
  655.       ELSE
  656.  
  657. *-----------------------------------------------------------------------
  658. *- cas ou on veut instancier un seul chargement elementaire de nom MOT -
  659. *-------------------------------------------------------------------------
  660. * cas ou on veut instancier tout le chargement et le ranger dans un seul champ
  661. *-------------------------------------------------------------------------
  662.  
  663.         ISU = 0
  664.  
  665. *-------------- boucle sur les chargements élémentaires ---------------
  666.  
  667.         DO 502 IC = 1, NCHAR
  668.  
  669.           IF (MOT1.NE.'    ') THEN
  670.             IF (mcharg.CHANOM(IC).NE.MOT1) GOTO 502
  671.           ENDIF
  672.  
  673. *--------- on ne considère que les objets de sous type force -----------
  674.  
  675.           IF(CHANAT(IC).EQ.'DEPLACEM') THEN
  676.             MOTERR(1:8)='CHARGEME'
  677.             MOTERR(9:16)='DEPLACEM'
  678.             CALL ERREUR(131)
  679.             GOTO 690
  680.           ENDIF
  681.  
  682.           ICHARG=KCHARG(IC)
  683. C          SEGACT ICHARG
  684.           IPO1 = ICHPO1
  685.           IPO2 = ICHPO2
  686.  
  687. *--- cas des chargements elementaires CHPOINT (ou MCHAML) + EVOL -------
  688.  
  689.           IF((CHATYP.EQ.'CHPOINT ').OR.(CHATYP.EQ.'MCHAML  ')) THEN
  690. C           Cas particulier du chargement constant : on retourne le champ
  691. C           sans aucune interpolation
  692.             IF (ICHPO2.EQ.0) THEN
  693.               IRET=ICHPO1
  694.               TAPOBJ=CHATYP
  695. C           Cas general : interpolation dans l'evolution
  696.             ELSE
  697.               MLREEL=ICHPO2
  698.               SEGACT MLREEL
  699.               NF=PROG(/1)
  700.  
  701. *------- Le temps %r1 sort de la table du %i1ème chargement -------------
  702.  
  703. C SP : on s'autorise a sortir de l'intervale de definition de l'evolution.
  704. C      L'interpolation de l'amplitude est geree par INTER1.
  705. C              T2 = T1 + ABS(T1*0.000001D0)
  706. C              T3 = T1 - ABS(T1*0.000001D0)
  707. C              IF(PROG(1).GT.T2.OR.PROG(NF).LT.T3) THEN
  708. C                 INTERR(1)=IC
  709. C                 REAERR(1)=T1
  710. C                 CALL ERREUR(342)
  711. C                 GOTO 690
  712. C              ENDIF
  713.  
  714. C------------- calcul du deplacement eventuel du champ ----------
  715.               IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  716.      &            CHAMOB(IC).EQ.'TRAJ') THEN
  717.                 MTYPR = CHAMOB(IC)
  718.                 IPOENT = IPO1
  719.                 CHATY2 = CHATYP
  720.                 IPOENU = ICHPO4
  721.                 IPOENV = ICHPO5
  722.                 IPOENW = ICHPO6
  723.                 IPOENX = ICHPO7
  724.                 CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  725.      $               IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  726.                 IF(IERR.NE.0) RETURN
  727.                 IPO1 = IPOSOR
  728.               ENDIF
  729.  
  730. C----- interpole la valeur de l'evolution FT1 au temps T1
  731.               ICHATX=ICHPO2
  732.               ICHAFX=ICHPO3
  733.               CALL INTER1(ICHATX,ICHAFX,T1,FT1)
  734. C
  735. C----- Cas du chargement de nom TRAJ :
  736.               IF (CHANOM(IC).EQ.'TRAJ') THEN
  737.                 IF (MOT1.EQ.'TRAJ'.OR.NCHAR.EQ.1) THEN
  738. C     write(6,*) 'TIRE : chargement de nom TRAJ' 
  739.                   CALL IPLCUR(IPO1,FT1,IPOIN1)
  740.                   IF (IERR.NE.0) RETURN
  741.                   CALL ECROBJ('POINT   ',IPOIN1)
  742.                   RETURN
  743.                 ELSE
  744. C               Si d'autres chargements : incompatible
  745.                   CALL ERREUR(695)
  746.                   GOTO 690
  747.                 ENDIF
  748.               ENDIF
  749.  
  750. C----- Autres cas : realise la multiplication du CHPOINT ou du MCHAML -----------
  751.               IOPERA = 2
  752.               IARGU  = 2
  753.               I11    = 0
  754.               IRET   = 0
  755.               IF(CHATYP.EQ.'CHPOINT ') THEN
  756.                 CALL ACTOBJ('CHPOINT ',IPO1,1)
  757.                 CALL OPCHP1(IPO1,IOPERA,IARGU,I11,FT1,IRET,IRETOU)
  758.                 IF(IRETOU .EQ. 0)THEN
  759.                   CALL ERREUR(26)
  760.                   RETURN
  761.                 ENDIF
  762.               ELSE
  763.                 CALL ACTOBJ('MCHAML  ',IPO1,1)
  764.                 CALL OPCHE1(IPO1,IOPERA,IARGU,I11,FT1,IRET,IRETOU)
  765.                 IF(IRETOU .EQ. 0)THEN
  766.                   CALL ERREUR(26)
  767.                   RETURN
  768.                 ENDIF
  769.               ENDIF
  770.             ENDIF
  771.  
  772.             IF(IRET.EQ.0) GOTO 690
  773.             IF(ISU.EQ.0) THEN
  774.               IRETT = IRET
  775.               ISU = 1
  776.               CHATY2 = CHATYP
  777.             ELSE
  778.  
  779. *------------- Chargements elementaires incompatibles ---------------
  780.  
  781.               IF(CHATYP.NE.CHATY2) THEN
  782.                 CALL ERREUR(695)
  783.                 GOTO 690
  784.               ELSE
  785.                 IF(CHATYP.EQ.'CHPOINT ') THEN
  786.                   CALL FUCHPO(IRETT,IRET,IRETOU)
  787. C                 CALL DTCHPO(IRET)
  788.                   IF(IRETOU.EQ.0) THEN
  789.                     IF(IRETT.NE.0) THEN
  790.                       CALL DTCHPO(IRETT)
  791.                     ENDIF
  792.                     GOTO 690
  793.                   ENDIF
  794. C                 CALL DTCHPO(IRETT)
  795.                   IRETT=IRETOU
  796.                 ELSEIF (CHATYP.EQ.'MCHAML  ') THEN
  797.                   CALL ADCHEL(IRETT,IRET,IRETOU,1)
  798.                   IF (IERR.NE.0) RETURN
  799.                   IRETT=IRETOU
  800.                 ENDIF
  801.                 CHATY2 = CHATYP
  802.               ENDIF
  803.             ENDIF
  804.  
  805. C----------------------------------------------------------------------
  806. C Cas du chargement elementaire TABLE1-TABLE2
  807. C----------------------------------------------------------------------
  808.  
  809.           ELSEIF (CHATYP.EQ.'TABLE   ') THEN
  810.             IVALI1 = 0
  811.             IVALI2 = 1
  812.             mtab1=ipo1
  813.             segact mtab1
  814.             jma1=mtab1.mlotab
  815.             DO 605 JJ = 1,JMA1
  816.               TAPOB1 =MTAB1. MTABTV(IVALI1+1)
  817.               TAPOB2 =MTAB1. MTABTV(IVALI2+1)
  818.               XVALR1=MTAB1.RMTABV(IVALI1+1)
  819.               IF (JMA1.EQ.1) THEN
  820.                 XVALR2 = T1
  821.               ELSE
  822.                 XVALR2=MTAB1.RMTABV(IVALI2+1)
  823.               ENDIF
  824.               IF (IVALI1.EQ.0) THEN
  825.                 IF (T1.LE.XVALR1) THEN
  826.                   DREL = 0.D0
  827.                   GOTO 607
  828.                 ENDIF
  829.               ENDIF
  830.               IF (IVALI2.EQ.(JMA1-1)) THEN
  831.                 IF (T1.GE.XVALR2) THEN
  832.                   DREL = 1.D0
  833.                   GOTO 607
  834.                 ENDIF
  835.               ENDIF
  836.               IF((XVALR1.LE.T1).AND.(T1.LE.XVALR2)) GOTO 606
  837.  6059         CONTINUE
  838.               IVALI1 = IVALI1 + 1
  839.               IVALI2 = IVALI2 + 1
  840.  605        CONTINUE
  841.  
  842. *------- Le temps %r1 sort de la table du %i1ème chargement -------------
  843.  
  844.             INTERR(1)=IC
  845.             REAERR(1)=T1
  846.             CALL ERREUR(342)
  847.             GOTO 690
  848.  
  849.  606        CONTINUE
  850.  
  851. *---------- la premiere table ne pointe pas vers des reels ----------
  852.  
  853.             IF((TAPOB1.NE.TAPOB2).OR.(TAPOB1.NE.'FLOTTANT')) THEN
  854.               CALL ERREUR(692)
  855.               GOTO 690
  856.             ENDIF
  857.             DREL = (T1 - XVALR1)/(XVALR2 - XVALR1)
  858.  607        CONTINUE
  859.             SEGDES MTAB1
  860.             MTAB2=IPO2
  861.             SEGACT MTAB2
  862.             TAPOB1 =MTAB2. MTABTV(IVALI1+1)
  863.             TAPOB2 =MTAB2.  MTABTV(IVALI2+1)
  864.             IOBR1 = MTAB2. MTABIV(IVALI1+1)
  865.             IF (JMA1.EQ.1) THEN
  866.               IRET = IOBR1
  867.               GOTO 668
  868.             ENDIF
  869.             IOBR2=MTAB2. MTABIV(IVALI2+1)
  870.             SEGDES MTAB2
  871.  
  872. *------ la deuxieme table ne pointe pas vers de champs de meme type ----
  873.  
  874.             IF(TAPOB1.NE.TAPOB2) THEN
  875.              write(6,*) ' ivali1 ' , ivali1 , ' ivali2 ' , ivali2
  876.              write(6,*) ' tapob1 ' , tapob1,' tapob2 ',tapob2
  877.               CALL ERREUR(693)
  878.               GOTO 690
  879.             ENDIF
  880.  
  881.             IF(TAPOB1.EQ.'CHPOINT ') THEN
  882.               CALL ECROBJ('CHPOINT ',IOBR1)
  883.               CALL ECROBJ('CHPOINT ',IOBR2)
  884.               CALL ECRREE(1.D0 - DREL)
  885.               CALL ECRREE(DREL)
  886.               CALL COLI
  887.               CALL LIROBJ('CHPOINT ',IRET,1,IRETOU)
  888.               IF(IRETOU.EQ.0) GOTO 690
  889. C------------- calcul du deplacement eventuel du champ ----------
  890.               IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  891.      &            CHAMOB(IC).EQ.'TRAJ') THEN
  892.                 MTYPR = CHAMOB(IC)
  893.                 IPOENT = IRET
  894.                 CHATY2 = TAPOB1
  895.                 IPOENU = ICHPO4
  896.                 IPOENV = ICHPO5
  897.                 IPOENW = ICHPO6
  898.                 IPOENX = ICHPO7
  899.                 CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  900.      $               IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  901.                 IF(IERR.NE.0) RETURN
  902.                 IRET = IPOSOR
  903.               ENDIF
  904.  
  905.             ELSEIF (TAPOB1.EQ.'MCHAML  ') THEN
  906.               IF (CHANOM(IC).EQ.'MATE') THEN
  907.                 IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  908.                   IRET = IOBR2
  909.                 ELSE
  910.                   IRET = IOBR1
  911.                 ENDIF
  912.               ELSE
  913.                 CALL ECROBJ('MCHAML  ',IOBR1)
  914.                 CALL ECROBJ('MCHAML  ',IOBR2)
  915.                 CALL ECRREE(1.D0 - DREL)
  916.                 CALL ECRREE(DREL)
  917.                 CALL COLI
  918.                 CALL LIROBJ('MCHAML  ',IRET,1,IRETOU)
  919.                 IF(IRETOU.EQ.0) GOTO 690
  920. C------------- calcul du deplacement eventuel du champ ----------
  921.                 IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  922.      &              CHAMOB(IC).EQ.'TRAJ') THEN
  923.                   MTYPR = CHAMOB(IC)
  924.                   IPOENT = IRET
  925.                   CHATY2 = TAPOB1
  926.                   IPOENU = ICHPO4
  927.                   IPOENV = ICHPO5
  928.                   IPOENW = ICHPO6
  929.                   IPOENX = ICHPO7
  930.                   CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  931.      $                 IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  932.                   IF(IERR.NE.0) RETURN
  933.                   IRET = IPOSOR
  934.                 ENDIF
  935.               ENDIF
  936.  
  937. C------------- Cas du MODELE :
  938.             ELSEIF (TAPOB1.EQ.'MMODEL  ') THEN
  939.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  940.                 IRET = IOBR2
  941.               ELSE
  942.                 IRET = IOBR1
  943.               ENDIF
  944.  
  945. C------------- Cas du MAILLAGE :
  946.             ELSEIF (TAPOB1.EQ.'MAILLAGE') THEN
  947.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  948.                 IRET = IOBR2
  949.               ELSE
  950.                 IRET = IOBR1
  951.               ENDIF
  952.  
  953. C------------- Cas de la RIGIDITE :
  954.             ELSEIF (TAPOB1.EQ.'RIGIDITE') THEN
  955.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  956.                 IRET = IOBR2
  957.               ELSE
  958.                 IRET = IOBR1
  959.               ENDIF
  960.  
  961. C------------ Cas du POINT :
  962.             ELSEIF (TAPOB1.EQ.'POINT   ') THEN
  963.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  964.                 NBPTS = IOBR2
  965.               ELSE IF (ABS(DREL-0.D0).LE.XZPREC) THEN
  966.                 NBPTS = IOBR1
  967.               ELSE
  968.                 SEGACT,MCOORD
  969. C     write(6,*) 'IOBR1, IOBR2,DREL=',IOBR1,IOBR2,DREL
  970.                 NBPTS = NBPTS+1
  971.                 SEGADJ,MCOORD
  972.                 IDIMP1 = IDIM + 1
  973.                 XP1 = XCOOR((IOBR1-1)*IDIMP1+1)
  974.                 YP1 = XCOOR((IOBR1-1)*IDIMP1+2)
  975.                 ZP1 = XCOOR((IOBR1-1)*IDIMP1+3)
  976.                 XP2 = XCOOR((IOBR2-1)*IDIMP1+1)
  977.                 YP2 = XCOOR((IOBR2-1)*IDIMP1+2)
  978.                 ZP2 = XCOOR((IOBR2-1)*IDIMP1+3)
  979.                 XCOOR((NBPTS-1)*IDIMP1+1) = DREL*XP2+(1.D0-DREL)*XP1
  980.                 XCOOR((NBPTS-1)*IDIMP1+2) = DREL*YP2+(1.D0-DREL)*YP1
  981.                 XCOOR((NBPTS-1)*IDIMP1+3) = DREL*ZP2+(1.D0-DREL)*ZP1
  982.                 SEGDES,MCOORD
  983.               ENDIF
  984. *-- la 2e table ne pointe pas vers un CHPOINT, MCHAML, MMODLE ou un MAILLAGE ----
  985.             ELSE
  986.               CALL ERREUR(694)
  987.               GOTO 690
  988.             ENDIF
  989.  
  990.  668        CONTINUE
  991.             IF (ISU.EQ.0) THEN
  992.               IRETT = IRET
  993.               ISU = 1
  994.               CHATY2 = TAPOB1
  995.             ELSE
  996.  
  997. *------------- Chargements elementaires incompatibles ---------------
  998.  
  999.               IF(TAPOB1.NE.CHATY2) THEN
  1000.                 CALL ERREUR(695)
  1001.                 GOTO 690
  1002.               ELSE
  1003.                 IF(TAPOB1.EQ.'CHPOINT ') THEN
  1004.                   CALL FUCHPO(IRETT,IRET,IRETOU)
  1005. C                 CALL DTCHPO(IRET)
  1006.                   IF(IRETOU.EQ.0) THEN
  1007.                     IF(IRETT.NE.0) THEN
  1008.                       CALL DTCHPO(IRETT)
  1009.                     ENDIF
  1010.                     GOTO 690
  1011.                   ENDIF
  1012. C                 CALL DTCHPO(IRETT)
  1013.                   IRETT=IRETOU
  1014.                 ELSEIF (TAPOB1.EQ.'MCHAML  ') THEN
  1015.                   CALL ADCHEL(IRETT,IRET,IRETOU,1)
  1016.                   IF (IERR.NE.0) RETURN
  1017.                   IRETT=IRETOU
  1018.                 ELSEIF (TAPOB1.EQ.'MMODEL  ') THEN
  1019.                   CALL FUSMOD(IRETT,IRET,IRETOU)
  1020.                   IF (IERR.NE.0) RETURN
  1021.                   IRETT=IRETOU
  1022.                 ELSEIF (TAPOB1.EQ.'MAILLAGE  ') THEN
  1023.                   CALL FUSE(IRETT,IRET,IRETOU,.false.)
  1024.                   IF (IERR.NE.0) RETURN
  1025.                   IRETT=IRETOU
  1026.                 ELSEIF (TAPOB1.EQ.'RIGIDITE') THEN
  1027.                   CALL FUSRIG(IRETT,IRET,IRETOU)
  1028.                   IF (IERR.NE.0) RETURN
  1029.                   IRETT=IRETOU
  1030.                 ENDIF
  1031.                 CHATY2 = TAPOB1
  1032.               ENDIF
  1033.             ENDIF
  1034.  
  1035. C----------------------------------------------------------------------
  1036. C Cas des chargements elementaires LREE1-LOBJ1
  1037. C----------------------------------------------------------------------
  1038.  
  1039.           ELSEIF (CHATYP.EQ.'LISTOBJE') THEN
  1040.  
  1041. C---------- Recherche intervalle de temps contenant T1
  1042.             IVALI1 = 0
  1043.             IVALI2 = 1
  1044.             MLREEL = IPO2
  1045.             SEGACT, MLREEL
  1046.             MLOBJE = IPO1
  1047.             SEGACT, MLOBJE
  1048.             JMA1 = PROG(/1)
  1049.             DO 305 JJ = 1,JMA1
  1050.               XVALR1 = PROG(IVALI1+1)
  1051.               IF(JMA1.EQ.1) THEN
  1052.                 XVALR2 = T1
  1053.               ELSE
  1054.                 XVALR2 = PROG(IVALI2+1)
  1055.               ENDIF
  1056.               IF(IVALI1.EQ.0) THEN
  1057.                 IF (T1.LE.XVALR1) THEN
  1058.                   DREL = 0.D0
  1059.                   GOTO 307
  1060.                 ENDIF
  1061.               ENDIF
  1062.               IF(IVALI2.EQ.(JMA1-1)) THEN
  1063.                 IF (T1.GE.XVALR2) THEN
  1064.                   DREL = 1.D0
  1065.                   GOTO 307
  1066.                 ENDIF
  1067.               ENDIF
  1068.               IF((XVALR1.LE.T1).AND.(T1.LE.XVALR2)) GOTO 306
  1069.               IVALI1 = IVALI1 + 1
  1070.               IVALI2 = IVALI2 + 1
  1071.  305        CONTINUE
  1072.  
  1073. C---------- SP : sans doute sans objet aujourd'hui (extrapolation permise)
  1074. *---------- Le temps %r1 sort de la table du %i1eme chargement
  1075.             INTERR(1)=IC
  1076.             REAERR(1)=T1
  1077.             CALL ERREUR(342)
  1078.             GOTO 690
  1079.  
  1080. C---------- On a trouve les piquets de temps encadrants T1
  1081.  306        CONTINUE
  1082.             DREL = (T1 - XVALR1)/(XVALR2 - XVALR1)
  1083.  
  1084. C---------- Interpolation du chargement a T1
  1085.  307        CONTINUE
  1086.             IOBR1  = LISOBJ(IVALI1+1)
  1087.             IF (JMA1.EQ.1) THEN
  1088.               IRET = IOBR1
  1089.               GOTO 669
  1090.             ENDIF
  1091.             IOBR2  = LISOBJ(IVALI2+1)
  1092.             MTYP1  = TYPOBJ
  1093.  
  1094. C---------- Cas du CHPOINT :
  1095.             IF (MTYP1.EQ.'CHPOINT ') THEN
  1096.               CALL ECROBJ('CHPOINT ',IOBR1)
  1097.               CALL ECROBJ('CHPOINT ',IOBR2)
  1098.               CALL ECRREE(1.D0 - DREL)
  1099.               CALL ECRREE(DREL)
  1100.               CALL COLI
  1101.               CALL LIROBJ('CHPOINT ',IRET,1,IRETOU)
  1102.               IF (IRETOU.EQ.0) GOTO 690
  1103. C------------- calcul du deplacement eventuel du champ ----------
  1104.               IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  1105.      &            CHAMOB(IC).EQ.'TRAJ') THEN
  1106.                 MTYPR = CHAMOB(IC)
  1107.                 IPOENT = IRET
  1108.                 CHATY2 = MTYP1
  1109.                 IPOENU = ICHPO4
  1110.                 IPOENV = ICHPO5
  1111.                 IPOENW = ICHPO6
  1112.                 IPOENX = ICHPO7
  1113.                 CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  1114.      $               IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  1115.                 IF (IERR.NE.0) RETURN
  1116.                 IRET = IPOSOR
  1117.               ENDIF
  1118.  
  1119. C------------- Cas du MCHAML :
  1120.             ELSEIF (MTYP1.EQ.'MCHAML  ') THEN
  1121.               IF (CHANOM(IC).EQ.'MATE') THEN
  1122.                 IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  1123.                   IRET = IOBR2
  1124.                 ELSE
  1125.                   IRET = IOBR1
  1126.                 ENDIF
  1127.               ELSE
  1128.                 CALL ECROBJ('MCHAML  ',IOBR1)
  1129.                 CALL ECROBJ('MCHAML',IOBR2)
  1130.                 CALL ECRREE(1.D0 - DREL)
  1131.                 CALL ECRREE(DREL)
  1132.                 CALL COLI
  1133.                 CALL LIROBJ('MCHAML  ',IRET,1,IRETOU)
  1134.                 IF (IRETOU.EQ.0) GOTO 690
  1135. C------------- calcul du deplacement eventuel du champ ----------
  1136.                 IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  1137.      &              CHAMOB(IC).EQ.'TRAJ') THEN
  1138.                   MTYPR = CHAMOB(IC)
  1139.                   IPOENT = IRET
  1140.                   CHATY2 = MTYP1
  1141.                   IPOENU = ICHPO4
  1142.                   IPOENV = ICHPO5
  1143.                   IPOENW = ICHPO6
  1144.                   IPOENX = ICHPO7
  1145.                   CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  1146.      $                 IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  1147.                   IF (IERR.NE.0) RETURN
  1148.                   IRET = IPOSOR
  1149.                 ENDIF
  1150.               ENDIF
  1151.  
  1152. C------------- Cas du MODELE :
  1153.             ELSEIF (MTYP1.EQ.'MMODEL  ') THEN
  1154.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  1155.                 IRET = IOBR2
  1156.               ELSE
  1157.                 IRET = IOBR1
  1158.               ENDIF
  1159.  
  1160. C------------- Cas du MAILLAGE :
  1161.             ELSEIF (MTYP1.EQ.'MAILLAGE') THEN
  1162.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  1163.                 IRET = IOBR2
  1164.               ELSE
  1165.                 IRET = IOBR1
  1166.               ENDIF
  1167.  
  1168. C------------- Cas de la RIGIDITE :
  1169.             ELSEIF (MTYP1.EQ.'RIGIDITE') THEN
  1170.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  1171.                 IRET = IOBR2
  1172.               ELSE
  1173.                 IRET = IOBR1
  1174.               ENDIF
  1175.  
  1176. C------------- Cas du POINT :
  1177.             ELSEIF (MTYP1.EQ.'POINT   ') THEN
  1178.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  1179.                 NBPTS = IOBR2
  1180.               ELSE IF (ABS(DREL-0.D0).LE.XZPREC) THEN
  1181.                 NBPTS = IOBR1
  1182.               ELSE
  1183.                 SEGACT,MCOORD*MOD
  1184. C     write(6,*) 'NBPTS,IOBR1, IOBR2,DREL=',NBPTS,IOBR1,IOBR2,DREL
  1185.                 NBPTS = NBPTS+1
  1186.                 SEGADJ,MCOORD
  1187.                 IDIMP1 = IDIM + 1
  1188.                 XP1 = XCOOR((IOBR1-1)*IDIMP1+1)
  1189.                 YP1 = XCOOR((IOBR1-1)*IDIMP1+2)
  1190.                 ZP1 = XCOOR((IOBR1-1)*IDIMP1+3)
  1191.                 XP2 = XCOOR((IOBR2-1)*IDIMP1+1)
  1192.                 YP2 = XCOOR((IOBR2-1)*IDIMP1+2)
  1193.                 ZP2 = XCOOR((IOBR2-1)*IDIMP1+3)
  1194.                 XCOOR((NBPTS-1)*IDIMP1+1) = DREL*XP2+(1.D0-DREL)*XP1
  1195.                 XCOOR((NBPTS-1)*IDIMP1+2) = DREL*YP2+(1.D0-DREL)*YP1
  1196.                 XCOOR((NBPTS-1)*IDIMP1+3) = DREL*ZP2+(1.D0-DREL)*ZP1
  1197.                 SEGDES,MCOORD
  1198.               ENDIF
  1199.  
  1200. C--------- le LISTOBJE ne contient pas de CHPOINT, MCHAML, MMODLE ou MAILLAGE
  1201.             ELSE
  1202.               CALL ERREUR(694)
  1203.               GOTO 690
  1204.             ENDIF
  1205.  
  1206.  669        CONTINUE
  1207.             IF (ISU.EQ.0) THEN
  1208.               IRETT = IRET
  1209.               ISU = 1
  1210.               CHATY2 = MTYP1
  1211.             ELSE
  1212.  
  1213. *------------- Chargements elementaires incompatibles ---------------
  1214.  
  1215.               IF(MTYP1.NE.CHATY2) THEN
  1216.                 CALL ERREUR(695)
  1217.                 GOTO 690
  1218.               ELSE
  1219.                 IF(MTYP1.EQ.'CHPOINT ') THEN
  1220.                   CALL FUCHPO(IRETT,IRET,IRETOU)
  1221.                   IF(IRETOU.EQ.0) THEN
  1222.                     IF(IRETT.NE.0) THEN
  1223.                       CALL DTCHPO(IRETT)
  1224.                     ENDIF
  1225.                     GOTO 690
  1226.                   ENDIF
  1227. C                 CALL DTCHPO(IRETT)
  1228.                   IRETT=IRETOU
  1229.                 ELSEIF (MTYP1.EQ.'MCHAML  ') THEN
  1230.                   CALL ADCHEL(IRETT,IRET,IRETOU,1)
  1231.                   IF (IERR.NE.0) RETURN
  1232.                   IRETT=IRETOU
  1233.                 ELSEIF (MTYP1.EQ.'MMODEL  ') THEN
  1234.                   CALL FUSMOD(IRETT,IRET,IRETOU)
  1235.                   IF (IERR.NE.0) RETURN
  1236.                   IRETT=IRETOU
  1237.                 ELSEIF (MTYP1.EQ.'MAILLAGE  ') THEN
  1238.                   CALL FUSE(IRETT,IRET,IRETOU,.false.)
  1239.                   IF (IERR.NE.0) RETURN
  1240.                   IRETT=IRETOU
  1241.                 ELSEIF (MTYP1.EQ.'RIGIDITE') THEN
  1242.                   CALL FUSRIG(IRETT,IRET,IRETOU)
  1243.                   IF (IERR.NE.0) RETURN
  1244.                   IRETT=IRETOU
  1245.                 ENDIF
  1246.                 CHATY2 = MTYP1
  1247.               ENDIF
  1248.             ENDIF
  1249.  
  1250.           ELSE
  1251. C---------- Fin ELSEIF sur CHATYP : pas de type connu trouve
  1252.             CALL ERREUR(695)
  1253.             GOTO 690
  1254.           ENDIF
  1255.  
  1256.  502    CONTINUE
  1257.  
  1258.         IF(IRETT.EQ.0) THEN
  1259.           IF (MOT1.NE.'    ') THEN
  1260.             MOTERR(1:4) = MOT1
  1261.             CALL ERREUR(685)
  1262.           ELSE
  1263.             CALL ERREUR(696)
  1264.           ENDIF
  1265.           RETURN
  1266.         ENDIF
  1267.  
  1268.         IF (CHATY2.EQ.'CHPOINT ') THEN
  1269.           CALL ACTOBJ('CHPOINT ',IRETT,1)
  1270.           CALL ECROBJ('CHPOINT ',IRETT)
  1271.         ELSEIF (CHATY2.EQ.'MCHAML  ') THEN
  1272.           CALL ACTOBJ('MCHAML  ',IRETT,1)
  1273.           CALL ECROBJ('MCHAML  ',IRETT)
  1274.         ELSEIF (CHATY2.EQ.'MMODEL  ') THEN
  1275.           CALL ACTOBJ('MMODEL  ',IRETT,1)
  1276.           CALL ECROBJ('MMODEL  ',IRETT)
  1277.         ELSEIF (CHATY2.EQ.'MAILLAGE') THEN
  1278.           CALL ACTOBJ('MAILLAGE',IRETT,1)
  1279.           CALL ECROBJ('MAILLAGE',IRETT)
  1280.         ELSEIF (CHATY2.EQ.'RIGIDITE') THEN
  1281.           CALL ACTOBJ('RIGIDITE',IRETT,1)
  1282.           CALL ECROBJ('RIGIDITE',IRETT)
  1283.         ELSEIF (CHATY2.EQ.'POINT   ') THEN
  1284.           CALL ECROBJ('POINT   ',NBPTS)
  1285.         ELSE
  1286.           CALL ERREUR(694)
  1287.         ENDIF
  1288.         RETURN
  1289.  690    CONTINUE
  1290.         RETURN
  1291.       ENDIF
  1292.  
  1293.  
  1294. C----------------------------
  1295. C  CAS DE L'OBJET SOLUTION
  1296. C-----------------------------
  1297.  
  1298.  200  CONTINUE
  1299.       ISOLIT=0
  1300.       CALL LIRCHA(MCHA,0,IRETOU)
  1301.       IF(IRETOU.EQ.0) GO TO 300
  1302. C
  1303.       CALL LIROBJ('SOLUTION ',KSOLU,1,IRETOU)
  1304.       IF(IERR.NE.0) GOTO 5000
  1305.       MSOLUT=KSOLU
  1306. C
  1307. C *** ON VA CHERCHER LE CHAMP DE TYPE MCHA  DANS LE MSOLUT
  1308.       SEGACT MSOLUT
  1309. C
  1310. C *** LECTURE DE FN,MN,QX,QY OU QZ ?
  1311.       CALL PLACE(MOFREQ,LFREQ,IPLAC,MCHA)
  1312.       IF(IPLAC.NE.0) THEN
  1313.          ICHA=4
  1314.          GOTO 50
  1315.       ENDIF
  1316. C *** OPTION GRAND DEPLACEMENT ?
  1317.       CALL PLACE (MOGDEP,LGDEP,IGDEP,MCHA)
  1318.       IF(IGDEP .NE. 0) THEN
  1319.          ICHA = 10 + IGDEP
  1320.          GOTO 50
  1321.       ENDIF
  1322. C *** LECTURE DES DEPLACEMENTS,DES CONTRAINTES ...
  1323.       MOTERR(1:8)=ITYSOL
  1324.       CALL CHRCHA(MCHA,MOTERR(1:8),ICHA,ISOLIT)
  1325.       IF(ICHA.EQ.0) THEN
  1326.          MOTERR(1:8)='SOLUTION'
  1327.          MOTERR(9:26)=ITYSOL
  1328.          MOTERR(30:38)=MCHA
  1329.          CALL ERREUR(235)
  1330. C        ERREUR DANS LE TYPE DE CHAMP
  1331.          GOTO 5000
  1332.       ENDIF
  1333. C                  TYPE = VITE   +  ROBO
  1334. C
  1335.       IF(ICHA.EQ.8) THEN
  1336.          CALL LIRMOT ( MOROBO,1,IROBO,0 )
  1337.          IF( IROBO.NE.0 ) THEN
  1338.             ICHA2 = ICHA
  1339.             ICHA = 5
  1340.          ENDIF
  1341.       ENDIF
  1342. C                  TYPE = ACCE   +  ROBO
  1343. C
  1344.       IF(ICHA.EQ.9) THEN
  1345.          CALL LIRMOT ( MOROBO,1,IROBO,0 )
  1346.          IF( IROBO.NE.0 ) THEN
  1347.             ICHA3 = ICHA
  1348.             ICHA2 = ICHA - 1
  1349.             ICHA = 5
  1350.          ENDIF
  1351.       ENDIF
  1352. C=============================
  1353.    50 MSOLEN=MSOLIS(ICHA)
  1354.       IF(MSOLEN.EQ.0) THEN
  1355.          MOTERR(1:8)='SOLUTION'
  1356.          MOTERR(9:26)=ITYSOL
  1357.          MOTERR(30:38)=MCHA
  1358.          CALL ERREUR(235)
  1359.          GOTO 5000
  1360.       ENDIF
  1361.       ISOLIT=MSOLIT(ICHA)
  1362.       SEGACT MSOLEN
  1363.       LTE=ISOLEN(/1)
  1364. C
  1365. C  **** CALCUL DE IRG LE RANG DE L'OBJET CHERCHE
  1366. C
  1367.       IRG=0
  1368.       CALL LIRMOT(MOOPT,LMOOPT,IMOT,0)
  1369. C  ------------------------------ON PREND LA DERNIERE VALEUR---------
  1370.       IF(IMOT.NE.0) GOTO 700
  1371.         IRG=LTE
  1372.         GOTO 152
  1373. C
  1374. C  --------------------------------- RECHERCHE D'UN TEMPS-----------
  1375.   700 IF(IMOT.NE.1)GOTO 701
  1376.       MSOLRE=MSOLIS(1)
  1377.       IF(MSOLRE.EQ.0) GOTO 140
  1378.       SEGACT MSOLRE
  1379.       CALL LIRREE (XXX,1,IRETOU)
  1380.       IF(IERR.NE.0) GOTO 5000
  1381.       T1=XXX
  1382.       IF(T1.EQ.0.) THEN
  1383.           IF(SOLRE(1).EQ.0.) THEN
  1384.             IRG=1
  1385.             SEGDES MSOLRE
  1386.             GOTO 152
  1387.           ENDIF
  1388.           GOTO 140
  1389.       ENDIF
  1390.       DO 153 J=1,LTE
  1391.       T2=SOLRE(J)
  1392.       TR=ABS((T2-T1)/T1)
  1393.       IF(TR.LT.PRECI) THEN
  1394.            IRG=J
  1395.            SEGDES MSOLRE
  1396.            GOTO 152
  1397.       ENDIF
  1398.       IF(T2.GT.T1) GOTO 140
  1399.   153 CONTINUE
  1400.   140 CONTINUE
  1401.       SEGDES MSOLRE
  1402.       MOTERR(9:16)='FLOTTANT'
  1403.       GOTO 145
  1404. C -------------------------------------RECHERCHE D'UN CAS-----------
  1405.  701  CONTINUE
  1406.       IF(IMOT.NE.2)GOTO 702
  1407.       MSOLE1=MSOLIS(2)
  1408.       IF(MSOLE1.EQ.0) GOTO 141
  1409.       SEGACT MSOLE1
  1410.       CALL LIRENT(L1,1,IRETOU)
  1411.       IF(IERR.NE.0) GOTO 5000
  1412.       DO 154 J=1,LTE
  1413.       IF(L1.EQ.MSOLE1.ISOLEN(J))THEN
  1414.           IRG=J
  1415.           SEGDES MSOLE1
  1416.           GOTO 152
  1417.       ENDIF
  1418.  154  CONTINUE
  1419.  141  CONTINUE
  1420.       SEGDES MSOLE1
  1421.       MOTERR(9:16)='ENTIER  '
  1422.       GOTO 145
  1423. C -------------------------------------- RECHERCHE D'UN RANG-----------
  1424.  702  IF(IMOT.NE.3) GOTO 703
  1425.       CALL LIRENT(IRG,1,IRETOU)
  1426.       IF(IERR.NE.0) GOTO 5000
  1427.       IF(IRG.GT.LTE.OR.IRG.LT.1) THEN
  1428.          MOTERR(1:8) = ITYSOL
  1429.          CALL ERREUR(203)
  1430.          GOTO 5000
  1431.       ENDIF
  1432.       GOTO  152
  1433. C ---------------------------------------RECHERCHE D UN NUMERO DE MODE--
  1434.  703  IF(IMOT.NE.4) GOTO 5000
  1435.       CALL LIRENT(INUME,1,IRETOU)
  1436.       IF(IERR.NE.0) GOTO 5000
  1437.       IRG=INUME
  1438. C
  1439. C
  1440. C
  1441. C
  1442. C
  1443.       GOTO 152
  1444. C --------------------------------ERREUR-------------------------
  1445.  145  CONTINUE
  1446.       MOTERR(1:8)='SOLUTION'
  1447.       CALL ERREUR(135)
  1448.       GOTO 5000
  1449. C ------------------------------------------------------------------
  1450.  152  CONTINUE
  1451.       IRET = ISOLEN(IRG)
  1452.       SEGDES MSOLEN
  1453.       IF ( IRET.EQ.0 ) THEN
  1454.          MOTERR(1:8) = ITYSOL
  1455.          MOTERR(9:12)= MCHA
  1456.          INTERR(1) = IRG
  1457.          CALL ERREUR(234)
  1458.          GOTO 5000
  1459.       ENDIF
  1460. C                  TYPE = ACCE   +  ROBO
  1461. C                         VITE
  1462.       IF ( ICHA2.NE.0 ) THEN
  1463.          MSOLEN = MSOLIS(ICHA2)
  1464.          IF(MSOLEN.EQ.0) THEN
  1465.             MOTERR(1:8)='SOLUTION'
  1466.             MOTERR(9:26)=ITYSOL
  1467.             MOTERR(30:38)=MCHA
  1468.             CALL ERREUR(235)
  1469.             GOTO 5000
  1470.          ENDIF
  1471.          ISOLI2 = MSOLIT(ICHA2)
  1472.          IF ( ISOLI2.NE.ISOLIT ) GOTO 5000
  1473.          SEGACT MSOLEN
  1474.          IRET2 = ISOLEN(IRG)
  1475.          SEGDES MSOLEN
  1476.          IF ( IRET2.EQ.0 ) THEN
  1477.             MOTERR(1:8) = ITYSOL
  1478.             MOTERR(9:12) = MCHA
  1479.             INTERR(1) = IRG
  1480.             CALL ERREUR(234)
  1481.             GOTO 5000
  1482.          ENDIF
  1483.       ENDIF
  1484. C                  TYPE = ACCE   +  ROBO
  1485. C
  1486.       IF ( ICHA3.NE.0 ) THEN
  1487.          MSOLEN = MSOLIS(ICHA3)
  1488.          IF(MSOLEN.EQ.0) THEN
  1489.             MOTERR(1:8)='SOLUTION'
  1490.             MOTERR(9:26)=ITYSOL
  1491.             MOTERR(30:38)=MCHA
  1492.             CALL ERREUR(235)
  1493.             GOTO 5000
  1494.          ENDIF
  1495.          ISOLI3 = MSOLIT(ICHA3)
  1496.          IF ( ISOLI3.NE.ISOLIT ) GOTO 5000
  1497.          SEGACT MSOLEN
  1498.          IRET3 = ISOLEN(IRG)
  1499.          SEGDES MSOLEN
  1500.          IF ( IRET3.EQ.0 ) THEN
  1501.             MOTERR(1:8) = ITYSOL
  1502.             MOTERR(9:12) = MCHA
  1503.             INTERR(1) = IRG
  1504.             CALL ERREUR(234)
  1505.             GOTO 5000
  1506.          ENDIF
  1507.       ENDIF
  1508. C
  1509. C **** FREQUENCE* /MGEN /QX /QY /QZ   / POIN  **************************
  1510. C POIN
  1511.       IF ( IPLAC.EQ.6)   THEN
  1512.         IF(ITYSOL.NE.'DYNAMIQU') THEN
  1513.            MELEME = MSOLIS(3)
  1514.            SEGACT MELEME
  1515.            IPOINN = NUM(1,IRG)
  1516. *          CALL ECRENT(IPOINN)
  1517.            SEGDES MELEME
  1518.            CALL ECROBJ ('POINT',IPOINN)
  1519.            GOTO 5000
  1520.         ELSE
  1521.             MOTERR(1:8)='SOLUTION'
  1522.             MOTERR(9:12) = ITYSOL
  1523.             INTERR(1) = IRG
  1524.             CALL ERREUR(131)
  1525.             GOTO 5000
  1526.         ENDIF
  1527.       ENDIF
  1528.       IF ( ICHA.EQ.4 ) THEN
  1529.          MMODE = IRET
  1530.          SEGACT MMODE
  1531.          RET = FMMODD(IPLAC)
  1532.          SEGDES MMODE
  1533.          CALL ECRREE(RET)
  1534.          GOTO 5000
  1535.       ENDIF
  1536. C
  1537. C *** LE MSOLUT EST UN MODE  ---------------------------------------
  1538. C
  1539.       IF ( ITYSOL.NE.'MODE    ') GOTO 800
  1540.       MSOLEN = MSOLIS(4)
  1541.       SEGACT MSOLEN
  1542.       MMODE = ISOLEN(IRG)
  1543.       SEGDES MSOLEN
  1544.       CALL TITMOD(MMODE,ITEX)
  1545.       GOTO 899
  1546. C
  1547.   800 CONTINUE
  1548.       IF ( IMOT.NE.1 ) GOTO 801
  1549.       WRITE(ITEX(1:24),FMT='(A4,8X,1PE12.5)') MCHA,T1
  1550.       ITEX(5:12) = '      T='
  1551.       GOTO 899
  1552.   801 CONTINUE
  1553.   899 CONTINUE
  1554. C
  1555. C *** LA SORTIE PORTE SUR DES CHPOINTS---------------------------
  1556. C
  1557.       IF ( ISOLIT.NE.2 ) GOTO 600
  1558.       IF ( ICHA2.EQ.0 ) THEN
  1559.          IF (ITEX.NE.'  ') THEN
  1560.             MCHPOI = IRET
  1561.             SEGACT MCHPOI*MOD
  1562.             MOCHDE = ITEX
  1563.          ENDIF
  1564.          GOTO 699
  1565.       ENDIF
  1566. C                  TYPE = VITE   +  ROBO
  1567. C
  1568.       IF ( ICHA3.EQ.0 ) THEN
  1569.          N1 = 2
  1570.          SEGINI MLCHPO
  1571.          ICHPOI(1) = IRET
  1572.          ICHPOI(2) = IRET2
  1573.          IF (ITEX.NE.'  ') THEN
  1574.             MCHPOI = IRET
  1575.             SEGACT MCHPOI*MOD
  1576.             MOCHDE = ITEX
  1577.          ENDIF
  1578.          ISOLIT = 34
  1579.          IRET = MLCHPO
  1580.          GOTO 699
  1581.       ENDIF
  1582. C                  TYPE = ACCE   +  ROBO
  1583. C
  1584.       N1 = 3
  1585.       SEGINI MLCHPO
  1586.       ICHPOI(1) = IRET
  1587.       ICHPOI(2) = IRET2
  1588.       ICHPOI(3) = IRET3
  1589.       IF (ITEX.NE.'  ') THEN
  1590.          MCHPOI = IRET
  1591.          SEGACT MCHPOI*MOD
  1592.          MOCHDE = ITEX
  1593.       ENDIF
  1594.       ISOLIT = 34
  1595.       IRET = MLCHPO
  1596.       GOTO 699
  1597. C
  1598.   600 CONTINUE
  1599.       IF ( ISOLIT.NE.5 ) GOTO 601
  1600.       WRITE(IOIMP,*) 'TIRE :CAS ISOLIT=5 N EST PLUS BRANCHE'
  1601. C
  1602.   601 CONTINUE
  1603.   699 CONTINUE
  1604.       CTYP = '        '
  1605.       CALL TYPFIL (CTYP,ISOLIT)
  1606.       CALL ACTOBJ (CTYP,IRET,1)
  1607.       CALL ECROBJ (CTYP,IRET)
  1608.  5000 CONTINUE
  1609.       RETURN
  1610. C
  1611. C    PAS D OPERANDE CORRECTE TROUVE
  1612. C
  1613.  300  CALL QUETYP(MOTERR(1:8),0,IRETOU)
  1614.       IF(IRETOU.NE.0) THEN
  1615.          CALL ERREUR (39)
  1616.       ELSE
  1617.          CALL ERREUR(533)
  1618.       ENDIF
  1619.       RETURN
  1620.  
  1621.       END
  1622.  
  1623.  
  1624.  
  1625.  
  1626.  
  1627.  
  1628.  
  1629.  
  1630.  
  1631.  
  1632.  
  1633.  
  1634.  
  1635.  
  1636.  
  1637.  

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